马虎浏览完一遍 SICP ，设计一个玩具Lisp方言，用C++实现一个玩具解释器，勿笑

马虎浏览完一遍 SICP ，设计一个玩具Lisp方言，用C++实现一个玩具解释器，勿笑

看归看了，但习题没做，学习效果打了折扣。

基于根搜索的垃圾收集：
        内存申请还是用的 C++ new，垃圾收集只负责在适当的时候 delete 。

变量为动态作用域。

语法也受到 Common Lisp 的影响。


目前支持：

        ""      字符串            ""     "ab"
        #       字符              #c     #?
        '       QUOTE（将其后符号视为符号，而非变量或其它。仅仅是其后的一个（暂时如此））
        ;       单行注释          ; 这是注释
        13      整数              12  +12  -3  0  +0  -0
        if      if 语句           (if c x)    (if c x y)
        var     变量定义          (var x)     (var x 100)
        begin   执行语句序列
        func    函数定义          (func f(参数) (语句)(语句)(语句) )
                函数可嵌套定义
        lambda                    ((lambda (x) (* x x)) 7)  ==> 49  (var fa (lambda () ()))
        (set! x y)                x = y
        (pair x y)
        (first x)
        (rest x)
        (set-first! x z)
        (set-rest!  x z)
        (list a b c d)
        (+ ... )                   (+ 100 x y)  ==> 100 + x + y
        (- ... )                   (- x) ==> -x           (- x y)  ==> x - y
        (* ... )                   (* x y z)
        (/ ... )                   (/ x y z)
        (get-char)
        (put-char)
        (get-string)
        (put-string)
        (get-line)
        (put-line)
        (string->integer)
        (integer->string)
        (< ...)
        (> ...)
        (= ...)
        (<= ...)
        (>= ...)
        (!= ...)
        nil?
        pair?
        integer?
        bool?
        char?
        lambda?
        func?

 

  1 ; TestZ.txt
  2 ;
  3 ; Copyright (C)  2012 , coreBugZJ, all rights reserved.
  4 ;
  5 ; 测试用文件 A
  6 ; ANSI GB2312 编码
  7 ; 
  8 ; 测试基本功能
  9 ; 
 10
 11
 12
 13 (begin
 14         ; test output  -----------------------------------------
 15         (var test - output  " test output " )
 16         (put - line test - output)
 17         (put - string  test - output)
 18         (put - line test - output)
 19         (put - string   "    " )
 20         (put - char  #c)
 21         (put - line  "" )
 22         (var ch #c)
 23         (put - char  ch)
 24         (var sp  "   " )
 25         (put - line sp)
 26
 27         ; test  string   -----------------------------------------
 28         (var test - string   " test string " )
 29         (put - line test - string )
 30
 31         (var sp  "      " )
 32         (var sa  " abc " )
 33         (var sb)
 34         (put - string  sa)
 35         (put - string  sp)
 36         (put - line sa)
 37
 38         ( set !  sb sa)
 39         (put - string  sb)
 40         (put - string  sp)
 41         (put - line sb)
 42
 43         ( set !  sb  " def " )
 44         (put - string  sb)
 45         (put - string  sp)
 46         (put - line sb)
 47
 48                 ; test empty  string   ---------------------------
 49         (var test - empty - string   " test empty string " )
 50         (var es  "" )
 51         (put - string  test - empty - string )
 52         (put - string  es)
 53         (put - line test - empty - string )
 54
 55         ; test integer  ----------------------------------------
 56         (var test - integer  " test integer " )
 57         (put - line test - integer)
 58
 59         (var ia)
 60         (var ib  100 )
 61         (var ic  - 13 )
 62         (var id  + 23 )
 63         (var ie  + 0 )
 64         (var  if   - 0 )
 65         (var ig ( -  ( +  id ib ic) ( +  ib ic)))
 66         (var str (integer -> string  ig))
 67         (put - line str)
 68         (var ih ( -  id))
 69         ( set !  str (integer -> string  ih))
 70         (put - line str)
 71         ( set !  ig ( *  id ib ( /  ib id)))
 72         ( set !  str (integer -> string  ig))
 73         (put - line str)
 74
 75         ; test integer  <->   string   -----------------------------
 76         (var test - integer <-> string   " test-integer<->string " )
 77         (put - line test - integer <-> string )
 78
 79         (var i  1234 )
 80         (var s  " 4321 " )
 81         (put - line (integer -> string  i))
 82         (put - line (integer -> string  ( string -> integer s)))
 83
 84         ; test  char   -------------------------------------------
 85         (var test - char   " test char " )
 86         (put - line test - char )
 87
 88         (var ca #a)
 89         (var cb)
 90         (put - char  ca)
 91         ( set !  cb ca)
 92         (put - char  cb)
 93         (var eline  "   " )
 94         (put - line eline)
 95
 96         ; test input  ------------------------------------------
 97         (var test - input  " test input " )
 98         (put - line test - input)
 99
100         (var input - prompt  " input a char " )
101         (put - line input - prompt)
102         (var ch ( get - char )) ; 重复定义，不判重
103         (put - char  ch)
104         (var sp  "    " )
105         (put - line sp)
106
107         ( set !  input - prompt  " input a string " )
108         (put - line input - prompt)
109         (var str ( get - string ))
110         (put - line str)
111
112         ; test func  -------------------------------------------
113         (var test - func  " test func " )
114         (put - line test - func)
115
116         (func square(x) ( *  x x))
117         (var y  11 )
118         (var z (square y))
119         (put - line (integer -> string  z))
120
121         (func square - sum(x y)
122                 ( +  (square x) (square y)))
123         (put - line (integer -> string  (square - sum  3   7 )))
124
125         (func fu(x y)
126                 (func half(x) ( /  x  2 ))
127                 (func  double (x) ( +  x x))
128                 ( +  (half x) ( double  y))
129         )
130         (var x  26 )
131         (put - line (integer -> string  (fu x  11 )))
132
133         (var y ((lambda (x) ( *  x x x))  3 ))
134         (func put - integer(i) (put - string  (integer -> string  i)))
135         (func  new - line() (var sp  "" ) (put - line sp))
136
137         (put - integer y) ;  27
138         ( new - line)
139
140         (put - line  " abc " )
141         (put - line  "" )
142         (put - line  " def " )
143         (put - string   "    " )
144         (put - char  #c)
145         ( new - line)
146         (put - integer  - 13 )
147         ( new - line)
148         (put - integer ( +   12   7 ))
149         (put - line  "" )
150         (func  new - line() (put - line  "" ))
151         ( new - line)
152         (put - char  #$)
153
154 ) ; end
155

 1 ; TestCompareZ.txt
 2 ;
 3 ; Copyright (C)  2012 , coreBugZJ, all rights reserved.
 4 ;
 5 ; 测试用文件 B
 6 ; ANSI GB2312 编码
 7 ; 
 8 ; 测试 基本比较函数
 9
10 (begin
11         ;  char   --------------------------------------
12         (var c1 #a)
13         (var c2 #z)
14         (var c3 #u)
15
16         (var c - min ( if  ( <  c1 c2) c1 c2))
17         ( set !  c - min ( if  ( <  c3 c - min) c3 c - min))
18         (put - char  c - min) ; a
19         (put - line)
20
21         (var c - max ( if  ( >  c1 c2) c1 c2))
22         ( set !  c - max ( if  ( >  c3 c - max) c3 c - max))
23         (put - char  c - max) ; z
24         (put - line)
25
26         ; integer  -----------------------------------
27         (func put - integer(i)
28                 (put - string  (integer -> string  i))
29         )
30
31         (var i1  1 )
32         (var i2  3 )
33         (var i3  7 )
34
35         (var i - min ( if  ( <  i1 i2) i1 i2))
36         ( set !  i - min ( if  ( <  i3 i - min) i3 i - min))
37         (put - integer i - min) ;  1
38         (put - line)
39
40         (var i - max ( if  ( >  i1 i2) i1 i2))
41         ( set !  i - max ( if  ( >  i3 i - max) i3 i - max))
42         (put - integer i - max) ;  7
43         (put - line)
44
45         (var i ( if  ( =  i1 i - min) i1 i2))
46         (put - integer i) ;  1
47         (put - line)
48
49 )
50

 1 ; TestScopeZ.txt
 2 ;
 3 ; Copyright (C)  2012 , coreBugZJ, all rights reserved.
 4 ;
 5 ; 测试用文件 C
 6 ; ANSI GB2312 编码
 7 ; 
 8 ; 综合测试 作用域，lambda，函数，环境模型
 9
10
11
12 ;  case   3
13 (begin
14         (func fs(fs_x)
15                 (lambda (lam_y)
16                         ( set !  fs_x ( -  fs_x lam_y))
17                         (put - line (integer -> string  fs_x))
18                 )
19         )
20         (var fa (fs  71 ))
21         (fa  3 ) ;  68
22         (fa  7 ) ;  61
23
24         (var fb (fs  100 ))
25         (fb  10 ) ;  90
26         (fa  3 )  ;  58
27         (fb  19 ) ;  71
28
29
30
31 )
32
33
34
35
36
37 ;  case   2  ok
38 (begin
39         (var fs (lambda (x) ( +  x x)))
40         (put - line (integer -> string  (fs  3 )))
41 )
42
43
44
45 ;  case   1  ok
46 (begin
47         (func put - integer(i)
48                 (put - line (integer -> string  i))
49         )
50
51         (func fa(x) ( +  x x))
52         (put - integer (fa  7 ))
53
54         (lambda (y) ( -  y y))
55         (put - integer ((lambda (z) ( *  z z))  10 ))
56
57 ) ; end
58

 1 ; TestPairZ.txt
 2 ;
 3 ; Copyright (C)  2012 , coreBugZJ, all rights reserved.
 4 ;
 5 ; 测试用文件 D
 6 ; ANSI GB2312 编码
 7 ; 
 8 ; 测试 pair 系列基本函数
 9
10
11 (begin
12         (put - string  (list #x #a #b #c #d))
13         (put - line (list)) ; xabcd
14         (put - string  (pair #x (pair #y nil)))
15         (put - line) ; xy
16
17         (var pa (pair  100   200 ))
18         (put - line (integer -> string  (first pa))) ;  100
19         (put - line (integer -> string  (rest  pa))) ;  200
20
21
22         (func length(lis)
23                 ( if  (nil ?  lis)
24                          0
25                         ( +   1  (length (rest lis)))
26                 )
27         )
28
29         (func put - integer(i)
30                 (put - line (integer -> string  i))
31         )
32
33         (var la (pair  1  (pair  2  nil)))
34         (put - line (integer -> string  (length la))) ;  2
35
36         (var lb (list  1   2   3   4   5 ))
37         (put - line (integer -> string  (length lb))) ;  5
38
39
40         (put - integer (first la)) ;  1
41         ( set !  la (rest la))
42         (put - integer (first la)) ;  2
43         ( set - first !  la  6 )
44         (put - integer (first la)) ;  6
45         ( set - rest !  la  7 )
46         ( set !  la (rest la))
47         (put - integer la) ;  7
48
49         (var vn)
50         (put - integer ( if  ( =  nil vn)  1000   2000 ))
51
52 )
53

 1 ; TestGcZ.txt
 2 ;
 3 ; Copyright (C)  2012 , coreBugZJ, all rights reserved.
 4 ;
 5 ; 测试用文件 E
 6 ; ANSI GB2312 编码
 7 ; 
 8 ; 测试垃圾收集
 9
10
11
12 (begin
13         (func   new (n)
14                 ( if  ( =   0  n)
15                         nil
16                         (pair n ( new  ( -  n  1 )))
17                 )
18         )
19
20         (var  ref )
21
22         (func test - gc(n)
23                 ( if  ( =   0  n)
24                         nil
25                         (begin
26                                 ( set !   ref  ( new   2 ))
27                                 (test - gc ( -  n  1 ))
28                         )
29                 )
30         )
31
32         (test - gc  2 )
33
34 )
35

 1 ; TestErrorZ.txt
 2 ;
 3 ; Copyright (C)  2012 , coreBugZJ, all rights reserved.
 4 ;
 5 ; 测试用文件 F
 6 ; ANSI GB2312 编码
 7 ; 
 8 ; 测试错误定位
 9
10
11 (begin
12         (var a  " a " )
13         (var b  3 )
14         (var c $)          ; error lin = 14  col = 16
15         ( if  ( =  a b) a b)   ; error lin = 15  col = 13
16 )
17