Implement 4.1
parent
3f2a8d1503
commit
11cbf7647f
|
@ -1,4 +1,25 @@
|
|||
(load "util.scm")
|
||||
(load "misc/evaluator.scm")
|
||||
|
||||
(display "\nex-4.1\n")
|
||||
(display "\nex-4.1 - list-of-values\n")
|
||||
|
||||
(define (list-of-values-left-to-right exps env)
|
||||
(if (no-operands? exps)
|
||||
'()
|
||||
(let ((first (eval (first-operand exps) env)))
|
||||
(let ((rest ((list-of-values (rest-operands exps) env))))
|
||||
(cons first rest)))))
|
||||
|
||||
(define (list-of-values-right-to-left exps env)
|
||||
(if (no-operands? exps)
|
||||
'()
|
||||
(let ((rest ((list-of-values (rest-operands exps) env))))
|
||||
(let ((first (eval (first-operand exps) env)))
|
||||
(cons first rest)))))
|
||||
|
||||
(display "[done]\n")
|
||||
|
||||
(display "\nex-4.2\n")
|
||||
|
||||
(display "\nex-4.3\n")
|
||||
|
||||
|
|
|
@ -0,0 +1,136 @@
|
|||
(define (eval exp env)
|
||||
(cond ((self-evaluating? exp) exp)
|
||||
((variable? exp) (lookup-variable-value exp env))
|
||||
((quoted? exp) (text-of-quotation exp))
|
||||
((assignment? exp) (eval-assignment exp env))
|
||||
((definition? exp) (eval-definition exp env))
|
||||
((if? exp) (eval-if exp env))
|
||||
((lambda? exp)
|
||||
(make-procedure (lambda-parameters exp)
|
||||
(lambda-body exp)
|
||||
env))
|
||||
((begin? exp)
|
||||
(eval-sequence (begin-actions exp) env))
|
||||
((cond? exp) (eval (cond->if exp) env))
|
||||
((application? exp)
|
||||
(apply (eval (operator exp) env)
|
||||
(list-of-values (operands exp) env)))
|
||||
(else
|
||||
(error "Unknown expression type -- EVAL" exp))))
|
||||
|
||||
(define (apply procedure arguments)
|
||||
(cond ((primitive-procedure? procedure)
|
||||
(apply-primitive-procedure procedure arguments))
|
||||
((compound-procedure? procedure)
|
||||
(eval-sequence
|
||||
(procedure-body procedure)
|
||||
(extend-environment
|
||||
(procedure-parameters procedure)
|
||||
arguments
|
||||
(procedure-environment procedure))))
|
||||
(else
|
||||
(error
|
||||
"Unknown procedure type -- APPLY" procedure))))
|
||||
|
||||
(define (list-of-values exps env)
|
||||
(if (no-operands? exps)
|
||||
'()
|
||||
(cons (eval (first-operand exps) env)
|
||||
(list-of-values (rest-operands exps) env))))
|
||||
|
||||
(define (eval-if exp env)
|
||||
(if (true? (eval (if-predicate exp) env))
|
||||
(eval (if-consequent exp) env)
|
||||
(eval (if-alternative exp) env)))
|
||||
|
||||
(define (eval-sequence exps env)
|
||||
(cond ((last-exp? exps) (eval (first-exp exps) env))
|
||||
(else (eval (first-exp exps) env)
|
||||
(eval-sequence (rest-exps exps) env))))
|
||||
|
||||
(define (eval-assignment exp env)
|
||||
(set-variable-value! (assignment-variable exp)
|
||||
(eval (assignment-value exp) env)
|
||||
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)
|
||||
(else false)))
|
||||
|
||||
(define (variable? exp) (symbol? exp))
|
||||
|
||||
(define (quoted? exp)
|
||||
(tagged-list? exp 'quote))
|
||||
|
||||
(define (text-of-quotation exp) (cadr exp))
|
||||
|
||||
(define (tagged-list? exp tag)
|
||||
(if (pair? exp)
|
||||
(eq? (car exp) tag)
|
||||
false))
|
||||
|
||||
(define (assignment? exp)
|
||||
(tagged-list? exp 'set!))
|
||||
(define (assignment-variable exp) (cadr exp))
|
||||
(define (assignment-value exp) (caddr exp))
|
||||
|
||||
(define (definition? exp)
|
||||
(tagged-list? exp 'define))
|
||||
|
||||
(define (definition-variable exp)
|
||||
(if (symbol? (cadr exp))
|
||||
(cadr exp)
|
||||
(caadr exp)))
|
||||
|
||||
(define (definition-value exp)
|
||||
(if (symbol? (cadr exp))
|
||||
(caddr exp)
|
||||
(make-lambda (cdadr exp) ; formal parameters
|
||||
(cddr exp)))) ; body
|
||||
|
||||
(define (lambda? exp) (tagged-list? exp 'lambda))
|
||||
(define (lambda-parameters exp) (cadr exp))
|
||||
(define (lambda-body exp) (cddr exp))
|
||||
|
||||
|
||||
(define (make-lambda parameters body)
|
||||
(cons 'lambda (cons parameters body)))
|
||||
|
||||
(define (if? exp) (tagged-list? exp 'if))
|
||||
(define (if-predicate exp) (cadr exp))
|
||||
(define (if-consequent exp) (caddr exp))
|
||||
(define (if-alternative exp)
|
||||
(if (not (null? (cdddr exp)))
|
||||
(cadddr exp)
|
||||
'false))
|
||||
|
||||
(define (make-if predicate consequent alternative)
|
||||
(list 'if predicate consequent alternative))
|
||||
|
||||
(define (begin? exp) (tagged-list? exp 'begin))
|
||||
(define (begin-actions exp) (cdr exp))
|
||||
(define (last-exp? seq) (null? (cdr seq)))
|
||||
(define (first-exp seq) (car seq))
|
||||
(define (rest-exps seq) (cdr seq))
|
||||
|
||||
(define (sequence->exp seq)
|
||||
(cond ((null? seq) seq)
|
||||
((last-exp? seq) (first-exp seq))
|
||||
(else (make-begin seq))))
|
||||
(define (make-begin seq) (cons 'begin seq))
|
||||
|
||||
(define (application? exp) (pair? exp))
|
||||
(define (operator exp) (car exp))
|
||||
(define (operands exp) (cdr exp))
|
||||
(define (no-operands? ops) (null? ops))
|
||||
(define (first-operand ops) (car ops))
|
||||
(define (rest-operands ops) (cdr ops))
|
||||
|
Loading…
Reference in New Issue