blob: 621fefc4f9ecfe3c9798210398a5edcbc6f40b40 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
; basic list accessors
(setq cadr (lambda (l) (car (cdr l))))
(setq caddr (lambda (l) (car (cdr (cdr l)))))
(setq list (lexpr (l) l))
; evaluate a list of sexprs
(setq progn (lexpr (l) (last l)))
; simple math operators
(setq 1+ (lambda (x) (+ x 1)))
(setq 1- (lambda (x) (- x 1)))
; define a variable without returning the value
(set 'def (macro (def-param)
(list
'progn
(list
'set
(list
'quote
(car def-param))
(cadr def-param)
)
(list
'quote
(car def-param)
)
)
)
)
; define a set of local
; variables and then evaluate
; a list of sexprs
;
; (let (var-defines) sexprs)
;
; where var-defines are either
;
; (name value)
;
; or
;
; (name)
;
; e.g.
;
; (let ((x 1) (y)) (setq y (+ x 1)) y)
(def let (macro (let-param)
((lambda (vars exprs make-names make-exprs make-nils)
(progn
;
; make the list of names in the let
;
(set 'make-names (lambda (vars)
(cond (vars
(cons (car (car vars))
(make-names (cdr vars))))
)
)
)
;
; the set of expressions is
; the list of set expressions
; pre-pended to the
; expressions to evaluate
;
(set 'make-exprs (lambda (vars exprs)
(progn
(cond (vars (cons
(list set
(list quote
(car (car vars))
)
(cadr (car vars))
)
(make-exprs (cdr vars) exprs)
)
)
(exprs)
)
)
)
)
(set 'exprs (make-exprs vars exprs))
;
; the parameters to the lambda is a list
; of nils of the right length
;
(set 'make-nils (lambda (vars)
(cond (vars (cons nil (make-nils (cdr vars))))
)
)
)
;
; build the lambda.
;
(set 'last-let-value
(cons
(list
'lambda
(make-names vars)
(cond ((cdr exprs) (cons 'progn exprs))
((car exprs))
)
)
(make-nils vars)
)
)
)
)
(car let-param)
(cdr let-param)
()
()
()
)
)
)
|
