From: Tim Vaughan <tgvaughan@gmail.com>
Date: Sun, 23 Apr 2017 12:26:14 +0000 (+1200)
Subject: Debugging MCE.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;ds=sidebyside;h=0dadd5f58d2c204c7f621ccd3c42f75a3fd790a8;hp=f982d9a741201927d246f9ece3456f331668a4ae;p=scheme.forth.jl.git

Debugging MCE.
---

diff --git a/examples/metacirc.scm b/examples/metacirc.scm
index 4778591..94787dd 100644
--- a/examples/metacirc.scm
+++ b/examples/metacirc.scm
@@ -3,6 +3,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define apply-in-underlying-scheme apply)
+(define true #t)
+(define false #f)
 
 ;; 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)
+  (display "Adding binding to 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 "Defining a variable...\n")
   (let ((frame (first-frame env)))
     (define (scan vars vals)
+      (display "Scanning for ") (display var) (display " in ") (display vars) (display "...\n")
       (cond ((null? vars)
+             (begin (display "adding binding\n")
              (add-binding-to-frame! 
-               var val frame))
+               var val frame)))
             ((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))))
 
@@ -314,6 +324,7 @@
             (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))
@@ -353,7 +364,6 @@
 
 (display "driver-loop...\n") 
 
-
 (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
--- a/src/scheme-library.scm
+++ b/src/scheme-library.scm
@@ -271,6 +271,7 @@
   (eq? (cond-predicate clause) 'else))
 
 (define (expand-clauses clauses)
+  (display "Expanding cond clauses...")
   (if (null? clauses)
     (none)
     (let ((first (car clauses))
diff --git a/src/scheme.4th b/src/scheme.4th
index 677dd9d..669665a 100644
--- a/src/scheme.4th
+++ b/src/scheme.4th
@@ -1955,7 +1955,7 @@ variable gc-stack-depth
 ;
 
 :noname
-    \ ." GC! "
+    ." GC! "
 
     gc-unmark