Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

ch4

  • Loading branch information...
commit 5956bce0fd32ab1f71584b6570be3018e39a69ed 1 parent a0acf46
flamingo authored
Showing with 132 additions and 2 deletions.
  1. +19 −1 ch4/ex4-1.scm
  2. +5 −0 ch4/ex4-2.scm
  3. +108 −1 ch4/test_interpreter.scm
20 ch4/ex4-1.scm
View
@@ -1 +1,19 @@
-#lang racket
+#lang racket
+
+;; Example 4.1
+
+;; very not sure
+
+(define (list-of-values-l exps env)
+ (if (no-operands? exps)
+ '()
+ (let* ((first (eval (first-operand exps) env))
+ (rest (list-of-values-l (rest-operands exps) env)))
+ (cons first rest))))
+
+(define (list-of-values-r exps env)
+ (if (no-operands? exps)
+ '()
+ (let* ((rest (list-of-values-r (rest-operands exps) env))
+ (first (eval (first-operand exps) env)))
+ (cons rest first))))
5 ch4/ex4-2.scm
View
@@ -0,0 +1,5 @@
+#lang racket
+
+;; Example 4.2
+
+;; trying to apply (define) func. But define is the special case.
109 ch4/test_interpreter.scm
View
@@ -1,5 +1,12 @@
#lang racket
+;; utils
+
+(define (tagged-list? exp tag)
+ (if (pair? exp)
+ (eq? (car exp) tag)
+ #f))
+
;; Eval
(define (eval exp env)
@@ -63,4 +70,104 @@
(define-variable! (definition-variable exp)
(eval (definition-value exp) env)
env)
- 'ok)
+ 'ok)
+
+;; Syntax
+
+;; self-evaluating - only numbers and strings
+(define (self-evaluating? exp)
+ (cond ((number? exp) #t)
+ ((string? exp) #t)
+ (else #f)))
+
+;; var = symbol
+(define (variable? exp) (symbol? exp))
+
+;; quotation
+(define (quoted? exp)
+ (tagged-list? exp 'quote))
+
+(define (text-of-quotation exp) (cadr exp))
+
+;; assignment
+(define (assignment? exp)
+ (tagged-list? exp 'set!))
+
+(define (assignment-variable exp) (cadr exp))
+(define (assignment-value exp) (caddr exp))
+
+;; definition of vars and procs
+(define (definition? exp)
+ (tagged-list? exp 'define))
+
+(define (definition-variable exp)
+ (if (symbol? (cadr exp))
+ (cadr exp) ;; define variable
+ (caddr exp))) ;; define procedure
+
+(define (definition-value exp)
+ (if (symbol? (cadr exp)
+ (caddr exp) ;; value for variable
+ (make-lambda (cdadr exp) ;; value for procedure
+ (cddr exp)))))
+
+;; lambdas
+(define (lambda? exp) (tagged-list? exp 'lambda))
+(define (lambda-parameters exp) (cadr exp))
+(define (lambda-body exp) (cddr exp))
+(define (make-lambda parameters body)
+ (cons 'lambda (cons parameters body)))
+
+;; if stuff
+(define (if? exp) (tagged-list? exp 'if))
+(define (if-predicate exp) (cadr exp))
+(define (if-consequent exp) (caddr exp))
+(define (if-alternative exp)
+ (if (not (null? (cdddr exp)))
+ (cadddr exp)
+ 'false))
+(define (make-if predicate consequent alternative)
+ (list 'if predicate consequent alternative))
+
+;; begin
+(define (begin? exp) (tagged-list? exp 'begin))
+(define (begin-actions exp) (cdr exp))
+(define (last-exp? seq) (null? (cdr seq)))
+(define (first-exp seq) (car seq))
+(define (rest-exps seq) (cdr seq))
+(define (sequence->exp seq)
+ (cond ((null? seq) seq)
+ ((last-exp? seq) (first-exp seq))
+ (else (make-begin seq))))
+(define (make-begin seq) (cons 'begin seq))
+
+;; procedure invocation
+(define (application? exp) (pair? exp))
+(define (operator exp) (car exp))
+(define (operands exp) (cdr exp))
+(define (no-operands? ops) (null? ops))
+(define (first-operand ops) (car ops))
+(define (rest-operands ops) (cdr ops))
+
+;; compound cond
+(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 (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))))))
Please sign in to comment.
Something went wrong with that request. Please try again.