From f6ec54a8949b38f37179a6032be93546b64cdcba Mon Sep 17 00:00:00 2001 From: Felix Martin Date: Fri, 29 Jan 2021 20:14:36 -0500 Subject: [PATCH] Implement 4.32 --- ex-4_31-34.scm | 61 ++++++++++++++++++++++++++++++++++++++++++++-- misc/evaluator.scm | 1 - 2 files changed, 59 insertions(+), 3 deletions(-) diff --git a/ex-4_31-34.scm b/ex-4_31-34.scm index 6067e4e..5b77c21 100644 --- a/ex-4_31-34.scm +++ b/ex-4_31-34.scm @@ -21,6 +21,12 @@ (list-of-arg-values (rest-operands exps) env)))) +(define (list? exp) + (tagged-list? exp 'list)) + +(define (list-elements exp) + (cdr exp)) + (define (eval exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) @@ -28,6 +34,7 @@ ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) + ((list? exp) (list->cons (list-elements exp))) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) @@ -135,8 +142,58 @@ (assert (eval '(square (id 10)) the-global-environment) 100) (assert (eval 'count the-global-environment) 1)) -(display "\nex-4.32\n") +(display "\nex-4.32 - lazy-streams\n") + +(eval + '(begin + (define (cons (x lazy-memo) (y lazy-memo)) + (lambda (m) (m x y))) + (define (car z) + (z (lambda (p q) p))) + (define (cdr z) + (z (lambda (p q) q))) + (define (list-ref items n) + (if (= n 0) + (car items) + (list-ref (cdr items) (- n 1)))) + (define (map proc items) + (if (null? items) + '() + (cons (proc (car items)) + (map proc (cdr items))))) + (define (scale-list items factor) + (map (lambda (x) (* x factor)) + items)) + (define (add-lists list1 list2) + (cons (+ (car list1) (car list2)) + (add-lists (cdr list1) (cdr list2)))) + (define ones (cons 1 ones)) + (define integers (cons 1 (add-lists ones integers))) + (define fib (cons 1 (cons 1 (add-lists fib (cdr fib))))) + ) + the-global-environment) + +(assert (eval-force '(list-ref fib 10) the-global-environment) 89) +(assert (eval-force '(list-ref ones 100) the-global-environment) 1) + +(display "\nex-4.33\n") + +(define (list->cons elements) + (define (make-cons elements) + (if (null? elements) + 'end + (cons (list 'cons (car elements)) + (make-cons (cdr elements))))) + (make-cons elements)) + +(display (list->cons '(a b c))) + +;(eval +; '(begin +; (car (list a b c)) +; ) +; the-global-environment) + -; (display "\nex-4.33\n") ; (display "\nex-4.34\n") diff --git a/misc/evaluator.scm b/misc/evaluator.scm index ea40f15..4208d15 100644 --- a/misc/evaluator.scm +++ b/misc/evaluator.scm @@ -105,7 +105,6 @@ (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) - (define (make-lambda parameters body) (cons 'lambda (cons parameters body)))