sicp metacircular evaluator (0) - map/car/cdr

sicp 4.1 要寫一個 Metacircular Evaluator, 有個部份在處理 environment。把 car, cdr, +, - 這些 primitive procedure 定義在這環境裡, 是很重要的一步。不過 scheme cons pair 資料結構實在難倒我, 把這些部份獨立出來測試。

t1.scm

 1 (define primitive-procedures
 2   (list (list '- -)
 3         (list '+ +)
 4         (list 'car car)
 5         (list 'cdr cdr)
 6         (list 'cons cons)
 7         (list 'null? null?) 
 8         ))
 9 (display primitive-procedures)
10 (newline)
11 (display (car primitive-procedures))
12 (newline)
13 (display (map car primitive-procedures))
14 (newline)

t1.scm L13 是最主要的部份, 結果是 res L5, 把 symbol -, + , car, cdr, cons, null? 集合成一個 list。

res

1 1 ]=> (load "t1.scm")
2 
3 ;Loading "t1.scm"...((- #[arity-dispatched-procedure 11]) (+ #[arity-dispatched-procedure 12]) (car #[compiled-procedure 19 (list #x1) #xf #x3218d3]) (cdr #[compiled-procedure 14 (list #x2) #xf #x321917]) (cons #[compiled-procedure 16 (list #x3) #xc #x32195c]) (null? #[compiled-procedure 18 (list #x5) #xc #x3219b8]))
4 (- #[arity-dispatched-procedure 11])
5 (- + car cdr cons null?)
6 ;... done
7 ;Unspecified return value
8 
9 1 ]=> 

t2.scm 這個複雜一點, res2 L23 是要達成的效果。

t2.scm

 1 (define primitive-procedures
 2   (list (list '- -)
 3         (list '+ +)
 4         (list 'car car)
 5         ))
 6 
 7 
 8 (define (primitive-procedure-objects)
 9   (map (lambda (proc) (newline) (display proc) (newline) (newline) (display (cdr proc)) (newline)  (newline) (display (cadr proc)) (newline) (list 'primitive (cadr proc)))
10        primitive-procedures))
11 
12 (newline)
13 (display primitive-procedures)
14 (newline)
15 (display (primitive-procedure-objects))
16 (newline)

res2 L4 的 list 由 t2.scm L1~5 構成。L9 的 map 難倒我, proc 可以想成 res2 L4 的 list 裡頭的 list, 就是 L6, L12, L18, 把他們 cdr 後, 就變成 L8, L14, L20, 再 car 後, 就是 L10, L16, L22, 因為 (a) 其實是用 'a, nil 構成的 pair, car 取前面 ('a), cdr 取後面 (nil)。

res2

 1 1 ]=> (load "t2.scm")
 2 
 3 ;Loading "t2.scm"...
 4 ((- #[arity-dispatched-procedure 11]) (+ #[arity-dispatched-procedure 12]) (car #[compiled-procedure 13 (list #x1) #xf #x3218d3]))
 5 
 6 (- #[arity-dispatched-procedure 11])
 7 
 8 (#[arity-dispatched-procedure 11])
 9 
10 #[arity-dispatched-procedure 11]
11 
12 (+ #[arity-dispatched-procedure 12])
13 
14 (#[arity-dispatched-procedure 12])
15 
16 #[arity-dispatched-procedure 12]
17 
18 (car #[compiled-procedure 13 (list #x1) #xf #x3218d3])
19 
20 (#[compiled-procedure 13 (list #x1) #xf #x3218d3])
21 
22 #[compiled-procedure 13 (list #x1) #xf #x3218d3]
23 ((primitive #[arity-dispatched-procedure 11]) (primitive #[arity-dispatched-procedure 12]) (primitive #[compiled-procedure 13 (list #x1) #xf #x3218d3]))
24 ;... done
25 ;Unspecified return value
26 
27 1 ]=>