Debugging MCE.

diff --git a/examples/metacirc.scm b/examples/metacirc.scm
index 4778591..94787dd 100644 (file)
--- a/examples/metacirc.scm
+++ b/examples/metacirc.scm
@@ -3,6 +3,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define apply-in-underlying-scheme apply)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define apply-in-underlying-scheme apply)

+(define true #t)
+(define false #f)

 
 ;; Verbatim code from SICP
 
 
 ;; Verbatim code from SICP
 


@@ -237,6 +239,7 @@
 (define (frame-variables frame) (car frame))
 (define (frame-values frame) (cdr frame))
 (define (add-binding-to-frame! var val frame)
 (define (frame-variables frame) (car frame))
 (define (frame-values frame) (cdr frame))
 (define (add-binding-to-frame! var val frame)

+  (display "Adding binding to frame... ")

   (set-car! frame (cons var (car frame)))
   (set-cdr! frame (cons val (cdr frame))))
 
   (set-car! frame (cons var (car frame)))
   (set-cdr! frame (cons val (cdr frame))))
 


@@ -294,15 +297,22 @@
 (display "define-variable\n")
 
 (define (define-variable! var val env)
 (display "define-variable\n")
 
 (define (define-variable! var val env)

+  (display "Defining a variable...\n")

   (let ((frame (first-frame env)))
     (define (scan vars vals)
   (let ((frame (first-frame env)))
     (define (scan vars vals)

+      (display "Scanning for ") (display var) (display " in ") (display vars) (display "...\n")

       (cond ((null? vars)
       (cond ((null? vars)

+             (begin (display "adding binding\n")

              (add-binding-to-frame! 
              (add-binding-to-frame! 

-               var val frame))
+               var val frame)))

             ((eq? var (car vars))
             ((eq? var (car vars))

-             (set-car! vals val))
-            (else (scan (cdr vars) 
-                        (cdr vals)))))
+             (begin (display "replacing binding\n")
+             (set-car! vals val)))
+            (else
+              (begin
+                (display "iterating\n")
+                (scan (cdr vars) 
+                        (cdr vals))))))

     (scan (frame-variables frame)
           (frame-values frame))))
 
     (scan (frame-variables frame)
           (frame-values frame))))
 


@@ -314,6 +324,7 @@
             (primitive-procedure-names)
             (primitive-procedure-objects)
             the-empty-environment)))
             (primitive-procedure-names)
             (primitive-procedure-objects)
             the-empty-environment)))

+    (display "Setting up the environment..\n")

     (define-variable! 'true true initial-env)
     (define-variable! 'false false initial-env)
     initial-env))
     (define-variable! 'true true initial-env)
     (define-variable! 'false false initial-env)
     initial-env))


@@ -353,7 +364,6 @@
 
 (display "driver-loop...\n") 
 
 
 (display "driver-loop...\n") 
 

-

 (define (driver-loop)
   (prompt-for-input input-prompt)
   (let ((input (read)))
 (define (driver-loop)
   (prompt-for-input input-prompt)
   (let ((input (read)))

diff --git a/src/scheme-library.scm b/src/scheme-library.scm
index cd26932..fb76f3a 100644 (file)
--- a/src/scheme-library.scm
+++ b/src/scheme-library.scm
@@ -271,6 +271,7 @@
   (eq? (cond-predicate clause) 'else))
 
 (define (expand-clauses clauses)
   (eq? (cond-predicate clause) 'else))
 
 (define (expand-clauses clauses)

+  (display "Expanding cond clauses...")

   (if (null? clauses)
     (none)
     (let ((first (car clauses))
   (if (null? clauses)
     (none)
     (let ((first (car clauses))

diff --git a/src/scheme.4th b/src/scheme.4th
index 677dd9d..669665a 100644 (file)
--- a/src/scheme.4th
+++ b/src/scheme.4th
@@ -1955,7 +1955,7 @@ variable gc-stack-depth
 ;
 
 :noname
 ;
 
 :noname

-    \ ." GC! "
+    ." GC! "

 
     gc-unmark
 
 
     gc-unmark