felixm
/
SICP
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Impelement till 4.5

main
Felix Martin 2021-01-17 12:16:20 -05:00
parent d48c389429
commit c958d52f50
2 changed files with 96 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
ex-4_01-xx.scm
View File

@ -51,20 +51,21 @@
env)))
(put 'begin (lambda (exp env) (eval-sequence (begin-actions exp) env)))
(put 'cond (lambda (exp env) (eval (cond->if exp) env)))
(put 'and (lambda (exp env) 'TODO))
(put 'or (lambda (exp env) 'TODO))
(put 'let (lambda (exp env) (eval (let->lambda exp) env)))
(put 'and (lambda (exp env) (eval-and (clauses exp) env)))
(put 'or (lambda (exp env) (eval-or (clauses exp) env)))
(display "[install-eval-package]\n")
'done)
(install-eval-package)
(define (eval exp env)
; (display "(EVAL ") (display exp) (display ")") (newline)
(cond
((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((and (not (null? exp))
(get (car exp)))
((get (car exp)) exp env))
((and (not (null? exp)) (get (car exp)))
((get (car exp)) exp env))
((application? exp)
(apply (eval (operator exp) env)
(list-of-values (operands exp) env)))
@ -72,7 +73,93 @@
(display "[done]\n")
(display "\nex-4.5 - and/or\n")
(display "\nex-4.4 - and/or\n")
(display "\nex-4.6\n")
(define (clauses exp) (cdr exp))
(define (no-clauses? exp) (null? exp))
(define (first-clause exp) (car exp))
(define (rest-clauses exp) (cdr exp))
(define (eval-and exp env)
(if (no-clauses? exp)
#t
(if (true? (eval (first-clause exp) env))
(eval-and (rest-clauses exp) env)
#f)))
(define (eval-or exp env)
(if (no-clauses? exp)
#f
(if (true? (eval (first-clause exp) env))
#t
(eval-or (rest-clauses exp) env))))
(define (true? a) a)
(assert (eval '(or) '()) #f)
(assert (eval '(and) '()) #t)
(assert (eval '(and 0 0 0 #f) '()) #f)
(assert (eval '(or #f #f #t) '()) #t)
(display "\nex-4.5 - modified-cond\n")
; Exercise 4.5. Scheme allows an additional syntax for cond clauses, (<test> =>
; <recipient>).
; If <test> evaluates to a true value, then <recipient> is evaluated. Its value
; must be a procedure of one argument; this procedure is then invoked on the
; value of the <test>, and the result is returned as the value of the cond
; expression. For example
; (cond ((assoc 'b '((a 1) (b 2))) => cadr)
; (else false))
; returns 2. Modify the handling of cond so that it supports this extended syntax.
(define (cond-test exp) (car exp))
(define (cond-recipient exp) (caddr exp))
(define (cond-test-recipient-clause? exp)
(eq? (cadr exp) '=>))
(define (expand-clauses clauses)
(if (null? clauses)
'false ; no else clause
(let ((first (car clauses))
(rest (cdr clauses)))
(cond
((cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF"
clauses)))
((cond-test-recipient-clause? first)
(let ((test-evaluated (eval (cond-test exp) env)))
(if test-evaluated
(eval (list (cond-recipient exp) test-evaluated) env)
(expand-clauses rest))))
(else
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest)))))))
(display "[done]\n")
(display "\nex-4.6 - let-expression\n")
(define (let->lambda exp) 0)
; (let ((<var1> <exp1>) ... (<varn> <expn>))
; <body>)
;
; ((lambda (<var1> ... <varn>)
; <body>)
; <exp1>
;
; <expn>)
; Implement a syntactic transformation let->combination that reduces evaluating
; let expressions to evaluating combinations of the type shown above, and add the
; appropriate clause to eval to handle let expressions
(display "\nex-4.7")

2
misc/evaluator.scm
View File

@ -63,6 +63,8 @@
(define (self-evaluating? exp)
(cond ((number? exp) true)
((string? exp) true)
((eq? exp #t) true)
((eq? exp #f) true)
(else false)))
(define (variable? exp) (symbol? exp))