From 0dadd5f58d2c204c7f621ccd3c42f75a3fd790a8 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Mon, 24 Apr 2017 00:26:14 +1200 Subject: [PATCH] Debugging MCE. --- examples/metacirc.scm | 20 +++++++++++++++----- src/scheme-library.scm | 1 + src/scheme.4th | 2 +- 3 files changed, 17 insertions(+), 6 deletions(-) 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 -- 2.20.1