From: Ramakrishnan Muthukrishnan Date: Sat, 31 Dec 2011 14:21:35 +0000 (+0530) Subject: support for internal definitions X-Git-Url: https://git.rkrishnan.org/about.html?a=commitdiff_plain;h=0a5ee86a54bbe2f6bbf733a870112813168938d9;p=sicp.git support for internal definitions --- diff --git a/src/sicp/metacircular2.rkt b/src/sicp/metacircular2.rkt index 7bc5f02..f08b5a1 100644 --- a/src/sicp/metacircular2.rkt +++ b/src/sicp/metacircular2.rkt @@ -27,7 +27,7 @@ ;; lambda (define (make-lambda parameters body) - (cons 'lambda (cons parameters (list body)))) + (cons 'lambda (cons parameters body))) ;; environment data structures (define (enclosing-environment env) (cdr env)) @@ -89,7 +89,8 @@ (list '+ +) (list '- -) (list '* *) - (list '/ /))) + (list '/ /) + (list '= =))) (define (primitive-procedure-names) (map car primitive-procedures)) @@ -127,10 +128,10 @@ ;; compound procedure (define (make-procedure params body env) - (list 'procedure params body env)) + (list 'procedure params (scan-out-definitions body) env)) (define (procedure-parameters p) (cadr p)) -(define (procedure-body p) (caddr p)) +(define (procedure-body p) (scan-out-definitions (caddr p))) (define (procedure-environment p) (cadddr p)) (define (apply procedure arguments) @@ -168,9 +169,9 @@ ;; let (define (let->combination lexpr) - (match-let* ([`(let ,bindings ,body) lexpr] + (match-let* ([`(let ,bindings ,body ..1) lexpr] [`((,var ,val) ...) bindings]) - `((lambda ,var ,body) ,@val))) + `((lambda ,var ,@body) ,@val))) ;; let* (define (let*->nested-lets lexpr) @@ -179,20 +180,30 @@ `(let (,first-binding) ,(let*->nested-lets `(let* ,rest-bindings ,body)))] [`(let* () ,body) body])) +;; internal definitions +(define (scan-out-definitions body) + (match body + [`((define ,var ,e) ..1 ,rest) + `((let ,(map (lambda (v) (list (car v) ''*unassigned*)) var) + ,@(map (lambda (v e) `(set! ,(car v) (lambda ,(cdr v) ,e))) var e) + ,rest))] + [_ body])) + ;; eval (define (eval exp env) + ;; (display (format "~s~%" exp)) (match exp [(? self-evaluating? exp) exp] [(? variable? exp) (lookup-variable-value exp env)] [`(quote ,x) x] [`(set! ,var ,val) (set-variable-value! var (eval val env) env)] [`(define ,(? (lambda (x) (not (pair? x))) var) ,b) (define-variable! var (eval b env) env)] - [`(define ,(? pair? var) ,b) (define-variable! (car var) (eval (make-lambda (cdr var) b) env) env)] + [`(define ,(? pair? var) ,b ..1) (define-variable! (car var) (eval (make-lambda (cdr var) b) env) env)] [`(if ,pred ,consequent ,alternative) (if (true? (eval pred env)) (eval consequent env) (eval alternative env))] - [`(lambda ,parameters ,body ...) (make-procedure parameters body env)] + [`(lambda ,parameters ,body ..1) (make-procedure parameters body env)] [`(begin ,exp ...) (eval-sequence exp env)] [`(cond ,clauses ...) (eval (cond->if clauses) env)] - [`(let ,bindings ,body) (eval (let->combination exp) env)] + [`(let ,bindings ,body ..1) (eval (let->combination exp) env)] [`(let* ,bindings ,body) (eval (let*->nested-lets exp) env)] [(list f x ...) (apply (eval f env) (list-of-values x env))] [_ (error "unable to evaluate expression -- EVAL " exp)]))