Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
ch4
  • Loading branch information
slobodin committed Aug 28, 2012
1 parent c70a3a7 commit 47ff76d
Show file tree
Hide file tree
Showing 6 changed files with 150 additions and 45 deletions.
58 changes: 14 additions & 44 deletions ch4/ex4-5.scm
Expand Up @@ -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)))))))
33 changes: 33 additions & 0 deletions 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))))
52 changes: 52 additions & 0 deletions 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)))
5 changes: 5 additions & 0 deletions ch4/ex4-8.scm
@@ -0,0 +1,5 @@
#lang racket

;; Example 4.8

;; Need testing.
27 changes: 27 additions & 0 deletions 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))))
20 changes: 19 additions & 1 deletion ch4/test_interpreter.scm
Expand Up @@ -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.