From 95c18225a541a840bc7ab088531e57dfeb3ca59e Mon Sep 17 00:00:00 2001 From: Felix Martin Date: Mon, 25 Jan 2021 08:42:19 -0500 Subject: [PATCH] Implement till 4.24 --- ex-4_11-xx.scm => ex-4_11-21.scm | 4 - ex-4_22-24.scm | 147 +++++++++++++++++++++++++++++++ ex-4_25-xx.scm | 7 ++ misc/evaluator.scm | 7 +- 4 files changed, 160 insertions(+), 5 deletions(-) rename ex-4_11-xx.scm => ex-4_11-21.scm (99%) create mode 100644 ex-4_22-24.scm create mode 100644 ex-4_25-xx.scm diff --git a/ex-4_11-xx.scm b/ex-4_11-21.scm similarity index 99% rename from ex-4_11-xx.scm rename to ex-4_11-21.scm index 2457505..2500a4f 100644 --- a/ex-4_11-xx.scm +++ b/ex-4_11-21.scm @@ -401,7 +401,3 @@ (assert (f 31) false) (assert (f 42) true) -(display "\nex-4.22\n") - -; (display "\nex-4.23\n") -; (display "\nex-4.24\n") diff --git a/ex-4_22-24.scm b/ex-4_22-24.scm new file mode 100644 index 0000000..68c1495 --- /dev/null +++ b/ex-4_22-24.scm @@ -0,0 +1,147 @@ +(load "misc/evaluator.scm") + +(display "\nex-4.22 - let\n") +(display "[answered]\n") + +; Since we have implemented let as a transformation we can simply analyze the +; transformed expression: ((let? exp) (analyze (let->combination exp))) + +(display "\nex-4.23\n") +(display "[answered]\n") + +; Implementation from book +(define (analyze-sequence exps) + (define (sequentially proc1 proc2) + (lambda (env) (proc1 env) (proc2 env))) + (define (loop first-proc rest-procs) + (if (null? rest-procs) + first-proc + (loop (sequentially first-proc (car rest-procs)) + (cdr rest-procs)))) + (let ((procs (map analyze exps))) + (if (null? procs) + (error "Empty sequence -- ANALYZE")) + (loop (car procs) (cdr procs)))) + +; Alyssa's implementation +(define (analyze-sequence exps) + (define (execute-sequence procs env) + (cond ((null? (cdr procs)) ((car procs) env)) + (else ((car procs) env) + (execute-sequence (cdr procs) env)))) + (let ((procs (map analyze exps))) + (if (null? procs) + (error "Empty sequence -- ANALYZE")) + (lambda (env) (execute-sequence procs env)))) + +; Alyssa's implementation iterates over the sequence at runtime, while the +; implementation from the book returns a fully unrolled procedure. Hence, +; Alyssa's implementation is more expensive because it traverses the list at +; runtime and needs to do the condition checking. + +(display "\nex-4.24\n") + +(let ((start-time (runtime))) + (eval '(define (fib n) (if (< n 2) 1 (+ (fib (- n 1)) (fib (- n 2))))) the-global-environment) + (eval '(fib 20) the-global-environment) + (display "[eval only] (fib 20) ") + (display (- (runtime) start-time)) + (display "s\n")) + +(define (analyze-sequence exps) + (define (sequentially proc1 proc2) + (lambda (env) (proc1 env) (proc2 env))) + (define (loop first-proc rest-procs) + (if (null? rest-procs) + first-proc + (loop (sequentially first-proc (car rest-procs)) + (cdr rest-procs)))) + (let ((procs (map analyze exps))) + (if (null? procs) + (error "Empty sequence -- ANALYZE")) + (loop (car procs) (cdr procs)))) + +(define (eval exp env) + ((analyze exp) env)) + +(define (analyze exp) + (cond ((self-evaluating? exp) + (analyze-self-evaluating exp)) + ((quoted? exp) (analyze-quoted exp)) + ((variable? exp) (analyze-variable exp)) + ((assignment? exp) (analyze-assignment exp)) + ((definition? exp) (analyze-definition exp)) + ((if? exp) (analyze-if exp)) + ((lambda? exp) (analyze-lambda exp)) + ((begin? exp) (analyze-sequence (begin-actions exp))) + ((cond? exp) (analyze (cond->if exp))) + ((application? exp) (analyze-application exp)) + (else + (error "Unknown expression type -- ANALYZE" exp)))) + +(define (analyze-self-evaluating exp) + (lambda (env) exp)) + +(define (analyze-quoted exp) + (let ((qval (text-of-quotation exp))) + (lambda (env) qval))) + +(define (analyze-variable exp) + (lambda (env) (lookup-variable-value exp env))) + +(define (analyze-assignment exp) + (let ((var (assignment-variable exp)) + (vproc (analyze (assignment-value exp)))) + (lambda (env) + (set-variable-value! var (vproc env) env) + 'ok))) + +(define (analyze-definition exp) + (let ((var (definition-variable exp)) + (vproc (analyze (definition-value exp)))) + (lambda (env) + (define-variable! var (vproc env) env) + 'ok))) + +(define (analyze-if exp) + (let ((pproc (analyze (if-predicate exp))) + (cproc (analyze (if-consequent exp))) + (aproc (analyze (if-alternative exp)))) + (lambda (env) + (if (true? (pproc env)) + (cproc env) + (aproc env))))) + +(define (analyze-lambda exp) + (let ((vars (lambda-parameters exp)) + (bproc (analyze-sequence (lambda-body exp)))) + (lambda (env) (make-procedure vars bproc env)))) + +(define (analyze-application exp) + (let ((fproc (analyze (operator exp))) + (aprocs (map analyze (operands exp)))) + (lambda (env) + (execute-application (fproc env) + (map (lambda (aproc) (aproc env)) + aprocs))))) + +(define (execute-application proc args) + (cond ((primitive-procedure? proc) + (apply-primitive-procedure proc args)) + ((compound-procedure? proc) + ((procedure-body proc) + (extend-environment (procedure-parameters proc) + args + (procedure-environment proc)))) + (else + (error + "Unknown procedure type -- EXECUTE-APPLICATION" + proc)))) + +(let ((start-time (runtime))) + (eval '(define (fib n) (if (< n 2) 1 (+ (fib (- n 1)) (fib (- n 2))))) the-global-environment) + (eval '(fib 20) the-global-environment) + (display "[eval and analyze] (fib 20) ") + (display (- (runtime) start-time)) + (display "s\n")) + diff --git a/ex-4_25-xx.scm b/ex-4_25-xx.scm new file mode 100644 index 0000000..e48a053 --- /dev/null +++ b/ex-4_25-xx.scm @@ -0,0 +1,7 @@ +(load "util.scm") +; (load "misc/evaluator.scm") + +(display "\nex-4.25\n") + +(display "\nex-4.26\n") + diff --git a/misc/evaluator.scm b/misc/evaluator.scm index 7a3f7ce..bde87cc 100644 --- a/misc/evaluator.scm +++ b/misc/evaluator.scm @@ -244,6 +244,10 @@ (list 'cons cons) (list 'null? null?) (list 'display display) + (list '= =) + (list '+ +) + (list '- -) + (list '< <) ;; )) @@ -297,4 +301,5 @@ (define the-global-environment (setup-environment)) -; (driver-loop) +;(driver-loop) +