X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scheme.forth.jl.git;a=blobdiff_plain;f=examples%2Fmetacirc.scm;h=94787dd0b13dc0147d2a77ae38bcbeb9f2bd16ac;hp=4778591448a2791dbd2a35f39489cbd10bd5b343;hb=0dadd5f58d2c204c7f621ccd3c42f75a3fd790a8;hpb=f982d9a741201927d246f9ece3456f331668a4ae 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)))