Permalink
Browse files

''

  • Loading branch information...
1 parent c711d5f commit 2d68cb35cf8afebc08edf5161e4b4c3ab7cd9091 @iamslash iamslash committed Jun 24, 2011
Showing with 70 additions and 175 deletions.
  1. +38 −38 ch04/4.2/ex-4-2-iamslash.ss
  2. +18 −36 ch04/4.2/l-eval-iamslash.rkt
  3. +14 −101 ch04/4.2/m-eval-iamslash.rkt
@@ -222,38 +222,38 @@
'()
(cons (my-eval (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
-;; (define (my-apply procedure arguments)
-;; (cond ((primitive-procedure? procedure)
-;; (apply-primitive-procedure procedure arguments))
-;; ((compound-procedure? procedure)
-;; (eval-sequence
-;; (procedure-body procedure)
-;; (extend-environment
-;; (procedure-parameters procedure)
-;; arguments
-;; (procedure-environment procedure))))
-;; (else
-;; (error
-;; "Unknown procedure type -- APPLY" procedure))))
-;; (define (my-eval exp env)
-;; (cond ((self-evaluating? exp) exp)
-;; ((variable? exp) (lookup-variable-value exp env))
-;; ((quoted? exp) (text-of-quotation exp))
-;; ((assignment? exp) (eval-assignment exp env))
-;; ((definition? exp) (eval-definition exp env))
-;; ((if? exp) (eval-if exp env))
-;; ((lambda? exp)
-;; (make-procedure (lambda-parameters exp)
-;; (lambda-body exp)
-;; env))
-;; ((begin? exp)
-;; (eval-sequence (begin-actions exp) env))
-;; ((cond? exp) (my-eval (cond->if exp) env))
-;; ((application? exp)
-;; (my-apply (my-eval (operator exp) env)
-;; (list-of-values (operands exp) env)))
-;; (else
-;; (error "Unknown expression type -- EVAL" exp))))
+(define (my-apply procedure arguments)
+ (cond ((primitive-procedure? procedure)
+ (apply-primitive-procedure procedure arguments))
+ ((compound-procedure? procedure)
+ (eval-sequence
+ (procedure-body procedure)
+ (extend-environment
+ (procedure-parameters procedure)
+ arguments
+ (procedure-environment procedure))))
+ (else
+ (error
+ "Unknown procedure type -- APPLY" procedure))))
+(define (my-eval exp env)
+ (cond ((self-evaluating? exp) exp)
+ ((variable? exp) (lookup-variable-value exp env))
+ ((quoted? exp) (text-of-quotation exp))
+ ((assignment? exp) (eval-assignment exp env))
+ ((definition? exp) (eval-definition exp env))
+ ((if? exp) (eval-if exp env))
+ ((lambda? exp)
+ (make-procedure (lambda-parameters exp)
+ (lambda-body exp)
+ env))
+ ((begin? exp)
+ (eval-sequence (begin-actions exp) env))
+ ((cond? exp) (my-eval (cond->if exp) env))
+ ((application? exp)
+ (my-apply (my-eval (operator exp) env)
+ (list-of-values (operands exp) env)))
+ (else
+ (error "Unknown expression type -- EVAL" exp))))
(define (setup-environment)
(let ((initial-env
(extend-environment (primitive-procedure-names)
@@ -367,9 +367,9 @@
(eval-sequence (begin-actions exp) env))
((cond? exp) (my-eval (cond->if exp) env))
((application? exp)
- (my-apply (operator exp)
- (operands exp)
- env))
+ (apply (actual-value (operator exp) env)
+ (operands exp)
+ env))
(else
(error "Unknown expression type -- EVAL" exp))))
(define (list-of-arg-values exps env)
@@ -437,14 +437,14 @@
;; ;;; L-Eval input:
;; count
;; ;;; L-Eval value:
-;; 0
-;; ????
+;; 1
+;; w를 정의하는 과정에서 count변화????
;; ;;; L-Eval input:
;; w
;; ;;; L-Eval value:
;; 10
-;; 당연한거 아닌가???
+;; ???
;; ;;; L-Eval input:
;; count
@@ -1,3 +1,12 @@
+;(define (set-car! x v)
+; (cons v (cdr x)))
+;(define (set-cdr! x v)
+; (cons x v))
+(define (error msg proc)
+ (display msg)
+ (newline)
+ (display proc)
+ (newline))
(define apply-in-underlying-scheme apply)
(define true #t)
(define false #f)
@@ -39,6 +48,10 @@
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
+ (list '+ +)
+ (list '- -)
+ (list '* *)
+ (list '/ /)
))
(define (primitive-procedure-names)
(map car
@@ -214,38 +227,7 @@
'()
(cons (my-eval (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
-(define (my-apply procedure arguments)
- (cond ((primitive-procedure? procedure)
- (apply-primitive-procedure procedure arguments))
- ((compound-procedure? procedure)
- (eval-sequence
- (procedure-body procedure)
- (extend-environment
- (procedure-parameters procedure)
- arguments
- (procedure-environment procedure))))
- (else
- (error
- "Unknown procedure type -- APPLY" procedure))))
-(define (my-eval exp env)
- (cond ((self-evaluating? exp) exp)
- ((variable? exp) (lookup-variable-value exp env))
- ((quoted? exp) (text-of-quotation exp))
- ((assignment? exp) (eval-assignment exp env))
- ((definition? exp) (eval-definition exp env))
- ((if? exp) (eval-if exp env))
- ((lambda? exp)
- (make-procedure (lambda-parameters exp)
- (lambda-body exp)
- env))
- ((begin? exp)
- (eval-sequence (begin-actions exp) env))
- ((cond? exp) (my-eval (cond->if exp) env))
- ((application? exp)
- (my-apply (my-eval (operator exp) env)
- (list-of-values (operands exp) env)))
- (else
- (error "Unknown expression type -- EVAL" exp))))
+
(define (setup-environment)
(let ((initial-env
(extend-environment (primitive-procedure-names)
@@ -288,9 +270,9 @@
(eval-sequence (begin-actions exp) env))
((cond? exp) (my-eval (cond->if exp) env))
((application? exp)
- (my-apply (operator exp)
- (operands exp)
- env))
+ (my-apply (actual-value (operator exp) env)
+ (operands exp)
+ env))
(else
(error "Unknown expression type -- EVAL" exp))))
(define (list-of-arg-values exps env)
@@ -344,4 +326,4 @@
result))
((evaluated-thunk? obj)
(thunk-value obj))
- (else obj)))
+ (else obj)))
@@ -1,3 +1,7 @@
+;; (define (set-car! x v)
+;; (cons v (cdr x)))
+;; (define (set-cdr! x v)
+;; (cons x v))
(define apply-in-underlying-scheme apply)
(define true #t)
(define false #f)
@@ -13,16 +17,11 @@
(define output-prompt ";;; M-Eval value:")
(define (driver-loop)
(prompt-for-input input-prompt)
- (define (driver-loop-in)
- (let ((input (read)))
- (display input)))
- (driver-loop-in)
- ;; (let ((input (read)))
- ;; (let ((output (my-eval input the-global-environment)))
- ;; (announce-output output-prompt)
- ;; (user-print output)))
- ;; (driver-loop)
- )
+ (let ((input (read)))
+ (let ((output (my-eval input the-global-environment)))
+ (announce-output output-prompt)
+ (user-print output)))
+ (driver-loop))
(define (prompt-for-input string)
(newline) (newline) (display string) (newline))
@@ -39,6 +38,10 @@
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
+ (list '+ +)
+ (list '- -)
+ (list '* *)
+ (list '/ /)
))
(define (primitive-procedure-names)
(map car
@@ -254,94 +257,4 @@
(define-variable! 'true true initial-env)
(define-variable! 'false false initial-env)
initial-env))
-(define the-global-environment (setup-environment))
-
-(define (actual-value exp env)
- (force-it (my-eval exp env)))
-(define (my-apply procedure arguments env)
- (cond ((primitive-procedure? procedure)
- (apply-primitive-procedure
- procedure
- (list-of-arg-values arguments env))) ; changed
- ((compound-procedure? procedure)
- (eval-sequence
- (procedure-body procedure)
- (extend-environment
- (procedure-parameters procedure)
- (list-of-delayed-args arguments env) ; changed
- (procedure-environment procedure))))
- (else
- (error
- "Unknown procedure type -- APPLY" procedure))))
-(define (my-eval exp env)
- (cond ((self-evaluating? exp) exp)
- ((variable? exp) (lookup-variable-value exp env))
- ((quoted? exp) (text-of-quotation exp))
- ((assignment? exp) (eval-assignment exp env))
- ((definition? exp) (eval-definition exp env))
- ((if? exp) (eval-if exp env))
- ((lambda? exp)
- (make-procedure (lambda-parameters exp)
- (lambda-body exp)
- env))
- ((begin? exp)
- (eval-sequence (begin-actions exp) env))
- ((cond? exp) (my-eval (cond->if exp) env))
- ((application? exp)
- (my-apply (operator exp)
- (operands exp)
- env))
- (else
- (error "Unknown expression type -- EVAL" exp))))
-(define (list-of-arg-values exps env)
- (if (no-operands? exps)
- '()
- (cons (actual-value (first-operand exps) env)
- (list-of-arg-values (rest-operands exps)
- env))))
-(define (list-of-delayed-args exps env)
- (if (no-operands? exps)
- '()
- (cons (delay-it (first-operand exps) env)
- (list-of-delayed-args (rest-operands exps)
- env))))
-(define (eval-if exp env)
- (if (true? (actual-value (if-predicate exp) env))
- (my-eval (if-consequent exp) env)
- (my-eval (if-alternative exp) env)))
-(define input-prompt ";;; L-Eval input:")
-(define output-prompt ";;; L-Eval value:")
-(define (driver-loop)
- (newline)
- (prompt-for-input input-prompt)
- (let ((input (read)))
- (let ((output
- (actual-value input the-global-environment)))
- (announce-output output-prompt)
- (user-print output)))
- (driver-loop))
-(define (force-it obj)
- (if (thunk? obj)
- (actual-value (thunk-exp obj) (thunk-env obj))
- obj))
-(define (delay-it exp env)
- (list 'thunk exp env))
-(define (thunk? obj)
- (tagged-list? obj 'thunk))
-(define (thunk-exp thunk) (cadr thunk))
-(define (thunk-env thunk) (caddr thunk))
-(define (evaluated-thunk? obj)
- (tagged-list? obj 'evaluated-thunk))
-(define (thunk-value evaluated-thunk) (cadr evaluated-thunk))
-(define (force-it obj)
- (cond ((thunk? obj)
- (let ((result (actual-value
- (thunk-exp obj)
- (thunk-env obj))))
- (set-car! obj 'evaluated-thunk)
- (set-car! (cdr obj) result) ; replace exp with its value
- (set-cdr! (cdr obj) '()) ; forget unneeded env
- result))
- ((evaluated-thunk? obj)
- (thunk-value obj))
- (else obj)))
+(define the-global-environment (setup-environment))

0 comments on commit 2d68cb3

Please sign in to comment.