;; Mandatory SICP Metacircular Evaluator ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; To use, simply (load "metacirc.scm") and run the (driver-loop) command.
+
(define apply-in-underlying-scheme apply)
+(define true #t)
+(define false #f)
;; Verbatim code from SICP
-(display "eval and apply\n")
-
(define (eval exp env)
(cond ((self-evaluating? exp)
exp)
env)
'ok)
+(define (eval-definition exp env)
+ (define-variable!
+ (definition-variable exp)
+ (eval (definition-value exp) env)
+ env)
+ 'ok)
+
(define (self-evaluating? exp)
(cond ((number? exp) true)
((string? exp) true)
(cddr exp)))) ; body
-(display "lambda... \n")
-
(define (lambda? exp)
(tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (rest-operands ops) (cdr ops))
-(display "cond... \n")
-
(define (cond? exp)
(tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(eq? x false))
-(display "make-procedure...\n")
-
-
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
(define (compound-procedure? p)
(define the-empty-environment '())
-(display "make-frame\n")
-
(define (make-frame variables values)
(cons variables values))
(define (frame-variables frame) (car 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)
vars
vals))))
-(display "lookup-variable\n")
-
(define (lookup-variable-value var env)
(define (env-loop env)
(define (scan vars vals)
(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)
(frame-values frame)))))
(env-loop env))
-(display "define-variable\n")
-
(define (define-variable! var val env)
(let ((frame (first-frame env)))
(define (scan vars vals)
var val frame))
((eq? var (car vars))
(set-car! vals val))
- (else (scan (cdr vars)
+ (else
+ (scan (cdr vars)
(cdr vals)))))
(scan (frame-variables frame)
(frame-values frame))))
-(display "setup-environment...\n")
-
(define (setup-environment)
(let ((initial-env
(extend-environment
(define-variable! 'false false initial-env)
initial-env))
+
(define (primitive-procedure? proc)
(tagged-list? proc 'primitive))
(list 'primitive (cadr proc)))
primitive-procedures))
-
-
(define (apply-primitive-procedure proc args)
(apply-in-underlying-scheme
(primitive-implementation proc) args))
(define output-prompt ";;; M-Eval value:")
-(display "driver-loop...\n")
-
-
(define (driver-loop)
(prompt-for-input input-prompt)
(let ((input (read)))
'<procedure-env>))
(display object)))
-(define the-global-environment
- (setup-environment))
+
+(define the-global-environment (setup-environment))
The Lambda Lab / projects / scheme.forth.jl.git / blobdiff