Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add solutions to 5.4.4

  • Loading branch information...
commit 61b82ed720d6b1859fcbbc4610e8feebe329281f 1 parent 7abb9f2
@fastred authored
Showing with 430 additions and 0 deletions.
  1. +19 −0 5_26.scm
  2. +23 −0 5_27.scm
  3. +33 −0 5_28.scm
  4. +50 −0 5_29.scm
  5. +305 −0 5_30.scm
View
19 5_26.scm
@@ -0,0 +1,19 @@
+(load "load-eceval.scm")
+
+(define the-global-environment (setup-environment))
+
+(start eceval)
+
+;My results:
+;(factorial 1)
+;(total-pushes = 64 maximum-depth = 10)
+
+;(factorial 2)
+;(total-pushes = 99 maximum-depth = 10)
+
+;(factorial 3)
+;(total-pushes = 134 maximum-depth = 10)
+
+;a) depth always equals 10
+;b) number of pushes: f(n) = 35n + 29
+
View
23 5_27.scm
@@ -0,0 +1,23 @@
+(load "load-eceval.scm")
+
+(define the-global-environment (setup-environment))
+
+(start eceval)
+
+;My results
+;(factorial 1)
+;(total-pushes = 16 maximum-depth = 8)
+
+;(factorial 2)
+;(total-pushes = 48 maximum-depth = 13)
+
+;(factorial 3)
+;(total-pushes = 80 maximum-depth = 18)
+
+;(factorial 4)
+;(total-pushes = 112 maximum-depth = 23)
+
+ Maximum depth Number of pushes
+Recursive 5n + 3 32n - 16
+Iterative 10 35n + 29
+
View
33 5_28.scm
@@ -0,0 +1,33 @@
+My results:
+Iterative factorial
+
+(factorial 1)
+(total-pushes = 70 maximum-depth = 17)
+
+(factorial 2)
+(total-pushes = 107 maximum-depth = 20)
+
+(factorial 3)
+(total-pushes = 144 maximum-depth = 23)
+
+(factorial 4)
+(total-pushes = 181 maximum-depth = 26)
+
+Recursive factorial
+
+(factorial 1)
+(total-pushes = 18 maximum-depth = 11)
+
+(factorial 2)
+(total-pushes = 52 maximum-depth = 19)
+
+(factorial 3)
+(total-pushes = 86 maximum-depth = 27)
+
+(factorial 4)
+(total-pushes = 120 maximum-depth = 35)
+
+ Maximum depth Number of pushes
+Recursive 8n + 3 34n - 16
+Iterative 3n + 14 37n + 33
+
View
50 5_29.scm
@@ -0,0 +1,50 @@
+My results:
+(fib 1)
+(total-pushes = 16 maximum-depth = 8)
+
+(fib 2)
+(total-pushes = 72 maximum-depth = 13)
+
+(fib 3)
+(total-pushes = 128 maximum-depth = 18)
+
+(fib 4)
+(total-pushes = 240 maximum-depth = 23)
+
+(fib 5)
+(total-pushes = 408 maximum-depth = 28)
+
+
+a) depth is given by f(n) = 5n + 3
+b) assignment says that S(n) = aS(n-1) + bS(n-2) + k
+we have:
+S(3) = aS(2) + bS(1) + k
+S(4) = aS(3) + bS(2) + k
+S(5) = aS(4) + bS(3) + k
+
+After substitution we have:
+128 = 72a + 16b + k
+240 = 128a + 72b + k
+408 = 240a + 128b + k
+
+It's a system of 3 equations with 3 unknowns so it's easily solvable,
+we get:
+a = 1
+k = 40
+b = 1
+Formula for S(b) is as:
+S(n) = S(n-1) + S(n-2) + 40
+
+
+Next part asks us to give formula in a form of S(n) = aFib(n+1) + b
+We have:
+S(3) = aFib(4) + b
+S(4) = aFib(5) + b
+
+after substitution we get
+128 = 3a + b
+240 = 5a + b
+
+We solve it and find that:
+S(n) = 56Fib(n+1) - 40
+
View
305 5_30.scm
@@ -0,0 +1,305 @@
+; In part a) of this exercise book says about evaluation of unbound variables.
+; I've added handling of these errors. I'm not sure what else authors wanted me
+; to do here.
+; TODO part b)
+
+(load "load-eceval.scm")
+
+(define (lookup-variable-value var env)
+ (define (env-loop env)
+ (define (scan vars vals)
+ (cond ((null? vars)
+ (env-loop (enclosing-environment env)))
+ ((eq? var (car vars))
+ (car vals))
+ (else (scan (cdr vars) (cdr vals)))))
+ (if (eq? env the-empty-environment)
+ "***unbound------variable***"
+ (let ((frame (first-frame env)))
+ (scan (frame-variables frame)
+ (frame-values frame)))))
+ (env-loop env))
+
+(define eceval-operations
+ (list
+ ;;primitive Scheme operations
+ (list 'read read)
+
+ ;;operations in syntax.scm
+ (list 'self-evaluating? self-evaluating?)
+ (list 'quoted? quoted?)
+ (list 'text-of-quotation text-of-quotation)
+ (list 'variable? variable?)
+ (list 'assignment? assignment?)
+ (list 'assignment-variable assignment-variable)
+ (list 'assignment-value assignment-value)
+ (list 'definition? definition?)
+ (list 'definition-variable definition-variable)
+ (list 'definition-value definition-value)
+ (list 'lambda? lambda?)
+ (list 'lambda-parameters lambda-parameters)
+ (list 'lambda-body lambda-body)
+ (list 'if? if?)
+ (list 'if-predicate if-predicate)
+ (list 'if-consequent if-consequent)
+ (list 'if-alternative if-alternative)
+ (list 'begin? begin?)
+ (list 'begin-actions begin-actions)
+ (list 'last-exp? last-exp?)
+ (list 'first-exp first-exp)
+ (list 'rest-exps rest-exps)
+ (list 'application? application?)
+ (list 'operator operator)
+ (list 'operands operands)
+ (list 'no-operands? no-operands?)
+ (list 'first-operand first-operand)
+ (list 'rest-operands rest-operands)
+
+ ;;operations in eceval-support.scm
+ (list 'true? true?)
+ (list 'make-procedure make-procedure)
+ (list 'compound-procedure? compound-procedure?)
+ (list 'procedure-parameters procedure-parameters)
+ (list 'procedure-body procedure-body)
+ (list 'procedure-environment procedure-environment)
+ (list 'extend-environment extend-environment)
+ (list 'lookup-variable-value lookup-variable-value)
+ (list 'set-variable-value! set-variable-value!)
+ (list 'define-variable! define-variable!)
+ (list 'primitive-procedure? primitive-procedure?)
+ (list 'apply-primitive-procedure apply-primitive-procedure)
+ (list 'prompt-for-input prompt-for-input)
+ (list 'announce-output announce-output)
+ (list 'user-print user-print)
+ (list 'empty-arglist empty-arglist)
+ (list 'adjoin-arg adjoin-arg)
+ (list 'last-operand? last-operand?)
+ (list 'no-more-exps? no-more-exps?) ;for non-tail-recursive machine
+ (list 'get-global-environment get-global-environment)
+
+ (list 'equal? equal?)
+ ))
+
+(define eceval
+ (make-machine
+ '(exp env val proc argl continue unev)
+ eceval-operations
+ '(
+;;SECTION 5.4.4
+read-eval-print-loop
+ (perform (op initialize-stack))
+ (perform
+ (op prompt-for-input) (const ";;; EC-Eval input:"))
+ (assign exp (op read))
+ (assign env (op get-global-environment))
+ (assign continue (label print-result))
+ (goto (label eval-dispatch))
+print-result
+;;**following instruction optional -- if use it, need monitored stack
+ (perform (op print-stack-statistics))
+ (perform
+ (op announce-output) (const ";;; EC-Eval value:"))
+ (perform (op user-print) (reg val))
+ (goto (label read-eval-print-loop))
+
+unknown-expression-type
+ (assign val (const unknown-expression-type-error))
+ (goto (label signal-error))
+
+unknown-procedure-type
+ (restore continue)
+ (assign val (const unknown-procedure-type-error))
+ (goto (label signal-error))
+
+unbound-variable
+ (assign val (const unbound-variable))
+ (goto (label signal-error))
+
+signal-error
+ (perform (op user-print) (reg val))
+ (goto (label read-eval-print-loop))
+
+;;SECTION 5.4.1
+eval-dispatch
+ (test (op self-evaluating?) (reg exp))
+ (branch (label ev-self-eval))
+ (test (op variable?) (reg exp))
+ (branch (label ev-variable))
+ (test (op quoted?) (reg exp))
+ (branch (label ev-quoted))
+ (test (op assignment?) (reg exp))
+ (branch (label ev-assignment))
+ (test (op definition?) (reg exp))
+ (branch (label ev-definition))
+ (test (op if?) (reg exp))
+ (branch (label ev-if))
+ (test (op lambda?) (reg exp))
+ (branch (label ev-lambda))
+ (test (op begin?) (reg exp))
+ (branch (label ev-begin))
+ (test (op application?) (reg exp))
+ (branch (label ev-application))
+ (goto (label unknown-expression-type))
+
+ev-self-eval
+ (assign val (reg exp))
+ (goto (reg continue))
+ev-variable
+ (assign val (op lookup-variable-value) (reg exp) (reg env))
+ (test (op equal?) (reg val) (const "***unbound------variable***"))
+ (branch (label unbound-variable))
+ (goto (reg continue))
+ev-quoted
+ (assign val (op text-of-quotation) (reg exp))
+ (goto (reg continue))
+ev-lambda
+ (assign unev (op lambda-parameters) (reg exp))
+ (assign exp (op lambda-body) (reg exp))
+ (assign val (op make-procedure)
+ (reg unev) (reg exp) (reg env))
+ (goto (reg continue))
+
+ev-application
+ (save continue)
+ (save env)
+ (assign unev (op operands) (reg exp))
+ (save unev)
+ (assign exp (op operator) (reg exp))
+ (assign continue (label ev-appl-did-operator))
+ (goto (label eval-dispatch))
+ev-appl-did-operator
+ (restore unev)
+ (restore env)
+ (assign argl (op empty-arglist))
+ (assign proc (reg val))
+ (test (op no-operands?) (reg unev))
+ (branch (label apply-dispatch))
+ (save proc)
+ev-appl-operand-loop
+ (save argl)
+ (assign exp (op first-operand) (reg unev))
+ (test (op last-operand?) (reg unev))
+ (branch (label ev-appl-last-arg))
+ (save env)
+ (save unev)
+ (assign continue (label ev-appl-accumulate-arg))
+ (goto (label eval-dispatch))
+ev-appl-accumulate-arg
+ (restore unev)
+ (restore env)
+ (restore argl)
+ (assign argl (op adjoin-arg) (reg val) (reg argl))
+ (assign unev (op rest-operands) (reg unev))
+ (goto (label ev-appl-operand-loop))
+ev-appl-last-arg
+ (assign continue (label ev-appl-accum-last-arg))
+ (goto (label eval-dispatch))
+ev-appl-accum-last-arg
+ (restore argl)
+ (assign argl (op adjoin-arg) (reg val) (reg argl))
+ (restore proc)
+ (goto (label apply-dispatch))
+apply-dispatch
+ (test (op primitive-procedure?) (reg proc))
+ (branch (label primitive-apply))
+ (test (op compound-procedure?) (reg proc))
+ (branch (label compound-apply))
+ (goto (label unknown-procedure-type))
+
+primitive-apply
+ (assign val (op apply-primitive-procedure)
+ (reg proc)
+ (reg argl))
+ (restore continue)
+ (goto (reg continue))
+
+compound-apply
+ (assign unev (op procedure-parameters) (reg proc))
+ (assign env (op procedure-environment) (reg proc))
+ (assign env (op extend-environment)
+ (reg unev) (reg argl) (reg env))
+ (assign unev (op procedure-body) (reg proc))
+ (goto (label ev-sequence))
+
+;;;SECTION 5.4.2
+ev-begin
+ (assign unev (op begin-actions) (reg exp))
+ (save continue)
+ (goto (label ev-sequence))
+
+ev-sequence
+ (assign exp (op first-exp) (reg unev))
+ (test (op last-exp?) (reg unev))
+ (branch (label ev-sequence-last-exp))
+ (save unev)
+ (save env)
+ (assign continue (label ev-sequence-continue))
+ (goto (label eval-dispatch))
+ev-sequence-continue
+ (restore env)
+ (restore unev)
+ (assign unev (op rest-exps) (reg unev))
+ (goto (label ev-sequence))
+ev-sequence-last-exp
+ (restore continue)
+ (goto (label eval-dispatch))
+
+;;;SECTION 5.4.3
+
+ev-if
+ (save exp)
+ (save env)
+ (save continue)
+ (assign continue (label ev-if-decide))
+ (assign exp (op if-predicate) (reg exp))
+ (goto (label eval-dispatch))
+ev-if-decide
+ (restore continue)
+ (restore env)
+ (restore exp)
+ (test (op true?) (reg val))
+ (branch (label ev-if-consequent))
+ev-if-alternative
+ (assign exp (op if-alternative) (reg exp))
+ (goto (label eval-dispatch))
+ev-if-consequent
+ (assign exp (op if-consequent) (reg exp))
+ (goto (label eval-dispatch))
+
+ev-assignment
+ (assign unev (op assignment-variable) (reg exp))
+ (save unev)
+ (assign exp (op assignment-value) (reg exp))
+ (save env)
+ (save continue)
+ (assign continue (label ev-assignment-1))
+ (goto (label eval-dispatch))
+ev-assignment-1
+ (restore continue)
+ (restore env)
+ (restore unev)
+ (perform
+ (op set-variable-value!) (reg unev) (reg val) (reg env))
+ (assign val (const ok))
+ (goto (reg continue))
+
+ev-definition
+ (assign unev (op definition-variable) (reg exp))
+ (save unev)
+ (assign exp (op definition-value) (reg exp))
+ (save env)
+ (save continue)
+ (assign continue (label ev-definition-1))
+ (goto (label eval-dispatch))
+ev-definition-1
+ (restore continue)
+ (restore env)
+ (restore unev)
+ (perform
+ (op define-variable!) (reg unev) (reg val) (reg env))
+ (assign val (const ok))
+ (goto (reg continue))
+ )))
+
+(define the-global-environment (setup-environment))
+(start eceval)
Please sign in to comment.
Something went wrong with that request. Please try again.