X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=examples%2Fmetacirc.scm;h=fe4c965d723b015703c0cd475efc2c481b4e705f;hb=6c019df6b459c86bf5de4fd817db2316038935da;hp=4778591448a2791dbd2a35f39489cbd10bd5b343;hpb=5c256a740ae9bf1f774e202cbdaf66d8e33f37e7;p=scheme.forth.jl.git

diff --git a/examples/metacirc.scm b/examples/metacirc.scm
index 4778591..fe4c965 100644
--- a/examples/metacirc.scm
+++ b/examples/metacirc.scm
@@ -2,12 +2,14 @@
 ;; Mandatory SICP Metacircular Evaluator ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;; To use, simply (load "metacirc.scm") and run the (driver-loop) command.
+
 (define apply-in-underlying-scheme apply)
+(define true #t)
+(define false #f)
 
 ;; Verbatim code from SICP
 
-(display "eval and apply\n")
-
 (define (eval exp env)
   (cond ((self-evaluating? exp) 
          exp)
@@ -86,6 +88,13 @@
     env)
   'ok)
 
+(define (eval-definition exp env)
+  (define-variable! 
+    (definition-variable exp)
+    (eval (definition-value exp) env)
+    env)
+  'ok)
+
 (define (self-evaluating? exp)
   (cond ((number? exp) true)
         ((string? exp) true)
@@ -128,8 +137,6 @@
       (cddr exp)))) ; body
 
 
-(display "lambda... \n")
-
 (define (lambda? exp) 
   (tagged-list? exp 'lambda))
 (define (lambda-parameters exp) (cadr exp))
@@ -176,8 +183,6 @@
 (define (rest-operands ops) (cdr ops))
 
 
-(display "cond... \n")
-
 (define (cond? exp) 
   (tagged-list? exp 'cond))
 (define (cond-clauses exp) (cdr exp))
@@ -214,9 +219,6 @@
   (eq? x false))
 
 
-(display "make-procedure...\n")
-
-
 (define (make-procedure parameters body env)
   (list 'procedure parameters body env))
 (define (compound-procedure? p)
@@ -230,8 +232,6 @@
 (define the-empty-environment '())
 
 
-(display "make-frame\n")
-
 (define (make-frame variables values)
   (cons variables values))
 (define (frame-variables frame) (car frame))
@@ -240,8 +240,6 @@
   (set-car! frame (cons var (car frame)))
   (set-cdr! frame (cons val (cdr frame))))
 
-(display "extend-environment\n")
-
 (define (extend-environment vars vals base-env)
   (if (= (length vars) (length vals))
     (cons (make-frame vars vals) base-env)
@@ -253,8 +251,6 @@
              vars 
              vals))))
 
-(display "lookup-variable\n")
-
 (define (lookup-variable-value var env)
   (define (env-loop env)
     (define (scan vars vals)
@@ -272,8 +268,6 @@
               (frame-values frame)))))
   (env-loop env))
 
-(display "set-variable\n")
-
 (define (set-variable-value! var val env)
   (define (env-loop env)
     (define (scan vars vals)
@@ -291,8 +285,6 @@
               (frame-values frame)))))
   (env-loop env))
 
-(display "define-variable\n")
-
 (define (define-variable! var val env)
   (let ((frame (first-frame env)))
     (define (scan vars vals)
@@ -301,13 +293,12 @@
                var val frame))
             ((eq? var (car vars))
              (set-car! vals val))
-            (else (scan (cdr vars) 
+            (else
+                (scan (cdr vars) 
                         (cdr vals)))))
     (scan (frame-variables frame)
           (frame-values frame))))
 
-(display "setup-environment...\n")
-
 (define (setup-environment)
   (let ((initial-env
           (extend-environment 
@@ -318,6 +309,7 @@
     (define-variable! 'false false initial-env)
     initial-env))
 
+
 (define (primitive-procedure? proc)
   (tagged-list? proc 'primitive))
 
@@ -341,8 +333,6 @@
          (list 'primitive (cadr proc)))
        primitive-procedures))
 
-
-
 (define (apply-primitive-procedure proc args)
     (apply-in-underlying-scheme
          (primitive-implementation proc) args))
@@ -351,9 +341,6 @@
 (define output-prompt ";;; M-Eval value:")
 
 
-(display "driver-loop...\n") 
-
-
 (define (driver-loop)
   (prompt-for-input input-prompt)
   (let ((input (read)))
@@ -380,5 +367,5 @@
             '<procedure-env>))
     (display object)))
 
-(define the-global-environment 
-  (setup-environment))
+
+(define the-global-environment (setup-environment))