Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

ch4

  • Loading branch information...
commit 47ff76ded505c9e50b6e9deab29816e0be366507 1 parent c70a3a7
@flaming0 authored
View
58 ch4/ex4-5.scm
@@ -2,54 +2,24 @@
;; Example 4.5
-;; TODO
+;; Need testing.
-(define (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) (eval (cond->if exp) env))
- ((application? exp)
- (apply (eval (operator exp) env) ;; apply procedure (proc, args)
- (list-of-values (operands exp) env)))
- (else
- (error "Unknown expression type -- EVAL" exp))))
-
-(define (cond? exp) (tagged-list? exp 'cond))
-(define (cond-clauses exp) (cdr exp))
-(define (cond-else-clause? clause)
- (eq? (cond-predicate clause) 'else))
-(define (cond-predicate clause) (car clause))
-(define (cond-actions clause) (cdr clause))
-(define (cond->if exp)
- (expand-clauses (cond-clauses exp)))
+(define (cond=>clause? exp)
+ (eq? (cadr exp) '=>))
(define (expand-clauses clauses)
(if (null? clauses)
'false
(let ((first (car clauses))
(rest (cdr clauses)))
- (if (cond-else-clause? first)
- (if (null? rest)
- (sequence->exp (cond-actions first))
- (error "Clause else not the last" clauses))
- (make-if (cond-predicate first)
- (sequence->exp (cond-actions first))
- (expand-clauses rest))))))
-
-(define (last-exp? seq) (null? (cdr seq)))
-(define (first-exp seq) (car seq))
-(define (make-begin seq) (cons 'begin seq))
-(define (sequence->exp seq)
- (cond ((null? seq) seq)
- ((last-exp? seq) (first-exp seq))
- (else (make-begin seq))))
+ (cond ((cond=>clause? first)
+ (make-if (car first) ;; (if (test?) (list recipient test) ..)
+ (list (caddr first) (car first))
+ (expand-clauses rest)))
+ ((cond-else-clause? first)
+ (if (null? rest)
+ (sequence->exp (cond-actions first))
+ (error "Clause else not the last" clauses)))
+ (else (make-if (cond-predicate first)
+ (sequence->exp (cond-actions first))
+ (expand-clauses rest)))))))
View
33 ch4/ex4-6.scm
@@ -0,0 +1,33 @@
+#lang racket
+
+;; Example 4.6
+
+;; Need testing.
+
+(define (eval exp env)
+ (cond (...)
+ ((let? exp) (eval (let->combination (cdr exp)) env))
+ (...)))
+
+;; let stuff
+
+(define (let? exp)
+ (tagged-list? exp 'let))
+
+(define (let-body exp) (cdr exp))
+(define (let-vars-and-exps exp) (car exp))
+
+;; should use foldr with cons '() and filter. But.... let's use simple scheme to make simple scheme interpreter
+(define (let-vars exp)
+ (if (null? exp)
+ '()
+ (cons (caar exp) (let-vars (cdr exp)))))
+
+(define (let-exps exp)
+ (if (null? exp)
+ '()
+ (cons (cadar exp) (let-vars (cdr exp)))))
+
+(define (let->combination exp)
+ (cons (make-lambda (let-vars (let-vars-and-exps exp)) (let-body exp))
+ (let-exps (let-vars-and-exps exp))))
View
52 ch4/ex4-7.scm
@@ -0,0 +1,52 @@
+#lang racket
+
+;; Example 4.7
+
+;; Need testing.
+
+(define (eval exp env)
+ (cond (...)
+ ((let*? exp) (eval (let*->nested-lets (cdr exp)) env))
+ (...)))
+
+;; let* stuff
+
+(define (let*? exp)
+ (tagged-list? exp 'let*))
+
+(define (let*-body exp) (cdr exp))
+(define (let*-vars-and-exps exp) (car exp))
+
+(define (let*->nested-lets exp)
+ (define (helper var-exps body)
+ (if (null? (cdr var-exps))
+ (cons 'let (cons var-exps body)) ;; final let
+ (list 'let (list (car var-exps))
+ (helper (cdr var-exps) body))))
+ (helper (let*-vars-and-exps exp) (let*-body exp)))
+
+
+;; random test stuff
+
+(define initial '(let ((a 2)
+ (b 3)
+ (c (foo 42)))
+ (body 2)))
+
+initial
+
+(define vars-exps (cadr initial))
+(define body (cddr initial))
+
+vars-exps
+body
+
+(define last-var-exp (cddr vars-exps))
+(cons 'let (cons last-var-exp body))
+
+(display "***")
+
+(car vars-exps)
+
+(list 'let (list (car vars-exps))
+ (cons 'let (cons last-var-exp body)))
View
5 ch4/ex4-8.scm
@@ -0,0 +1,5 @@
+#lang racket
+
+;; Example 4.8
+
+;; Need testing.
View
27 ch4/ex4-9.scm
@@ -0,0 +1,27 @@
+#lang racket
+
+;; Example 4.9
+
+;; Need testing.
+
+;; (while (exp)
+;; (body)))
+
+(define (eval exp env)
+ (cond (...)
+ ((while? exp) (eval-while exp env))
+ (...)))
+
+(define (while? exp) (tagged-list? exp 'while))
+(define (while-cond exp) (cadr exp))
+(define (while-body exp) (caddr exp))
+
+(define (while->combination exp)
+ (sequence->exp
+ (list (list 'define
+ (list 'loop) ;; (define (loop) (if () (begin (body) (loop)) 'done))
+ (make-if (while-cond exp)
+ (sequence->exp (list (while-body)
+ (list 'loop)))
+ 'done))
+ (list 'loop))))
View
20 ch4/test_interpreter.scm
@@ -170,4 +170,22 @@
(error "Clause else not the last" clauses))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
- (expand-clauses rest))))))
+ (expand-clauses rest))))))
+
+;; data structures
+
+(define (true? x)
+ (not (eq? x false)))
+
+(define (false? x)
+ (eq? x false))
+
+(define (make-procedure parameters body env)
+ (list 'procedure parameters body env))
+
+(define (compound-procedure? p)
+ (tagged-list? p 'procedure))
+
+(define (procedure-parameters p) (cadr p))
+(define (procedure-body p) (caddr p))
+(define (procedure-body p) (cadddr p))

0 comments on commit 47ff76d

Please sign in to comment.
Something went wrong with that request. Please try again.