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

Impelement till 4.5

Browse Source
This commit is contained in:
Felix Martin
2021-01-17 12:16:20 -05:00
parent d48c389429
commit c958d52f50
2 changed files with 96 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
ex-4_01-xx.scm
View File

@@ -51,19 +51,20 @@
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)))
((and (not (null? exp)) (get (car exp)))
((get (car exp)) exp env))
((application? exp)
(apply (eval (operator 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))