diff --git a/direct-style-interpreter.scm b/direct-style-interpreter.scm index 7e7b8e1..7afa329 100644 --- a/direct-style-interpreter.scm +++ b/direct-style-interpreter.scm @@ -8,7 +8,7 @@ ;; the procedures that create them as combinators ;; (note: is this true? don't they still use free variables in their definitions?) ;; ((yes, because they are of dynamic scope, therefore not captured)) - + ;; Globals (define undefined-value (make-symbol "undefined")) (define g.init (make-parameter '())) @@ -18,7 +18,6 @@ (define sg.init (make-vector 100)) (define sg.current (make-vector 100)) - ;; Macros (define-syntax with-fresh-globals @@ -82,7 +81,6 @@ (error "Incorrect arity" 'name)))]) (description-extend! 'name `(function ,value a b c)) (make-closure behavior (*env*))))) - ;; Record types (define-record-type @@ -256,7 +254,6 @@ (invoke proc rec)) (error "Wrong arity" 'apply))) (*env*))) - ;; Denotations (define (meaning e r tail?) @@ -275,8 +272,8 @@ (define (meaning-quotation e*) (CONSTANT e*)) -(define (CONSTANT value) - (lambda () value)) +(define (CONSTANT v) + (lambda () v)) (define (meaning-alternative e1 e2 e3 r tail?) (let ([m1 (meaning e1 r #f)] @@ -288,19 +285,16 @@ (lambda () (if (m1) (m2) (m3)))) -(define (meaning-sequence e* r tail?) - (if (null? e*) - (static-error "Illegal syntax (begin)") - (SEQUENCE (meaning-list e* r tail?)))) +(define (meaning-sequence e+ r tail?) + (cond + [(null? e+) (static-error "Illegal syntax (begin)")] + [(null? (cdr e+)) (meaning (car e+) r tail?)] + [else (SEQUENCE (meaning (car e+) r #f) + (meaning-sequence (cdr e+) r tail?))])) -(define (SEQUENCE m+) +(define (SEQUENCE m m+) (lambda () - (let lp ([m* m+]) - (if (null? (cdr m*)) - ((car m*)) - (begin - ((car m*)) - (lp (cdr m*))))))) + (m) (m+))) (define (meaning-reference n r) (match (compute-kind n r) @@ -554,7 +548,6 @@ (m+)) (error "Incorrect arity"))) (make-closure the-function (*env*)))) - ;; Tests (test-begin "direct-style-interpreter") @@ -576,8 +569,8 @@ ;; sequences (test-group "meaning-sequence" (with-fresh-globals - (env-set! '((a b))) - (test-eq 'b + (env-set! '((1 2))) + (test-eq 2 ((meaning-sequence '(a b) '((a b)) #t))))) ;; references (test-group "meaning-reference" @@ -639,7 +632,7 @@ (cont v) v)) #f 0) '(()) #t)))) -#;(test-group "apply" +(test-group "apply" (test-eq 3 ((meaning '(apply + 1 2 '()) '(()) #t))) (test-eq 3 ((meaning '(apply + '(1 2)) '(()) #t)))) (test-end "direct-style-interpreter")