From c958d52f501b252e09e6170513afb53538312e3d Mon Sep 17 00:00:00 2001 From: Felix Martin Date: Sun, 17 Jan 2021 12:16:20 -0500 Subject: [PATCH] Impelement till 4.5 --- ex-4_01-xx.scm | 101 +++++++++++++++++++++++++++++++++++++++++---- misc/evaluator.scm | 2 + 2 files changed, 96 insertions(+), 7 deletions(-) diff --git a/ex-4_01-xx.scm b/ex-4_01-xx.scm index 6c8ee02..b7832ca 100644 --- a/ex-4_01-xx.scm +++ b/ex-4_01-xx.scm @@ -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, ( => +; ). +; If evaluates to a true value, then is evaluated. Its value +; must be a procedure of one argument; this procedure is then invoked on the +; value of the , 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 (( ) ... ( )) +; ) +; +; ((lambda ( ... ) +; ) +; +; +; ) + +; 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") diff --git a/misc/evaluator.scm b/misc/evaluator.scm index f173049..9504f03 100644 --- a/misc/evaluator.scm +++ b/misc/evaluator.scm @@ -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))