The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
72afc95
)
Removed debug code from MCE.
author
Tim Vaughan
<tgvaughan@gmail.com>
Mon, 1 May 2017 06:22:50 +0000
(18:22 +1200)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Mon, 1 May 2017 06:22:50 +0000
(18:22 +1200)
examples/metacirc.scm
patch
|
blob
|
history
diff --git
a/examples/metacirc.scm
b/examples/metacirc.scm
index
170adaa
..
a1ad1dd
100644
(file)
--- a/
examples/metacirc.scm
+++ b/
examples/metacirc.scm
@@
-8,8
+8,6
@@
;; Verbatim code from SICP
;; Verbatim code from SICP
-(display "eval and apply\n")
-
(define (eval exp env)
(cond ((self-evaluating? exp)
exp)
(define (eval exp env)
(cond ((self-evaluating? exp)
exp)
@@
-137,8
+135,6
@@
(cddr exp)))) ; body
(cddr exp)))) ; body
-(display "lambda... \n")
-
(define (lambda? exp)
(tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (lambda? exp)
(tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
@@
-185,8
+181,6
@@
(define (rest-operands ops) (cdr ops))
(define (rest-operands ops) (cdr ops))
-(display "cond... \n")
-
(define (cond? exp)
(tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond? exp)
(tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
@@
-223,9
+217,6
@@
(eq? x false))
(eq? x false))
-(display "make-procedure...\n")
-
-
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
(define (compound-procedure? p)
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
(define (compound-procedure? p)
@@
-239,19
+230,14
@@
(define the-empty-environment '())
(define the-empty-environment '())
-(display "make-frame\n")
-
(define (make-frame variables values)
(cons variables values))
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
(define (make-frame variables values)
(cons variables values))
(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))))
-(display "extend-environment\n")
-
(define (extend-environment vars vals base-env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals) base-env)
(define (extend-environment vars vals base-env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals) base-env)
@@
-263,8
+249,6
@@
vars
vals))))
vars
vals))))
-(display "lookup-variable\n")
-
(define (lookup-variable-value var env)
(define (env-loop env)
(define (scan vars vals)
(define (lookup-variable-value var env)
(define (env-loop env)
(define (scan vars vals)
@@
-282,8
+266,6
@@
(frame-values frame)))))
(env-loop env))
(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)
(define (set-variable-value! var val env)
(define (env-loop env)
(define (scan vars vals)
@@
-301,37
+283,26
@@
(frame-values frame)))))
(env-loop env))
(frame-values frame)))))
(env-loop env))
-(display "define-variable\n")
-
(define (define-variable! var val env)
(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))
- (begin (display "replacing binding\n")
- (set-car! vals val)))
+ (set-car! vals val))
(else
(else
- (begin
- (display "iterating\n")
(scan (cdr vars)
(scan (cdr vars)
- (cdr vals)))))
)
+ (cdr vals)))))
(scan (frame-variables frame)
(frame-values frame))))
(scan (frame-variables frame)
(frame-values frame))))
-(display "setup-environment...\n")
-
(define (setup-environment)
(let ((initial-env
(extend-environment
(primitive-procedure-names)
(primitive-procedure-objects)
the-empty-environment)))
(define (setup-environment)
(let ((initial-env
(extend-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))
@@
-368,8
+339,6
@@
(define output-prompt ";;; M-Eval value:")
(define output-prompt ";;; M-Eval value:")
-(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)))
@@
-399,3
+368,4
@@
(define the-global-environment (setup-environment))
(define the-global-environment (setup-environment))
+(driver-loop)