;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "reader.ss" "plai" "lang")
;; ;;
;; Morgan McGuire morgan@cs.williams.edu
(define-type expr
(num (n number?))
(add (lhs expr?) (rhs expr?))
(sub (lhs expr?) (rhs expr?))
;; NEW TODAY:
(with (name symbol?) (named-expr expr?) (body expr?))
(id (name symbol?))
)
; We write a regular Scheme procedure that accepts a Scheme list and converts it
; into a calc expression.
(define (parse e)
(cond
; If the expression is a number literal, make a calc number:
[(number? e) (num e)]
;; NEW TODAY: identifiers (variables)
[(symbol? e) (id e)]
; If the expression looks like ( ... ), choose the type
; based on what is first.
[(list? e)
(case (first e)
; Begins with "+": create an addition expression:
[(+) (add (parse (second e))
(parse (third e)))]
; Begins with "-": create a subtraction expression:
[(-) (sub (parse (second e))
(parse (third e)))]
; NEW TODAY:
; With expression
[(with) (with (first (second e))
(parse (second (second e)))
(parse (third e)))]
)]))
; The calc interpreter including substitution
; Converts expressions to Calc-nums (not Scheme nums, like last week!)
;
; calc-4: expr -> num
(define (calc-4 e)
(cond [(num? e) e]
[(add? e) (let ([lhs (add-lhs e)]
[rhs (add-rhs e)])
;; NEW: put "num"
(num (+ (num-n (calc-4 lhs))
(num-n (calc-4 rhs)))))]
[(sub? e) (let ([lhs (sub-lhs e)]
[rhs (sub-rhs e)])
(num (- (num-n (calc-4 lhs))
(num-n (calc-4 rhs)))))]
; NEW TODAY
[(with? e) (let ([name (with-name e)]
[value (calc-4 (with-named-expr e))]
[body (with-body e)])
; Substitute for in body, then evaluate
(calc-4 (substitute body name value)))]
; No need for a variable case; if we ever evaluate a variable,
; it was free on the whole program, which is an error!
))
; substitute: expr x symbol x num -> expr
(define (substitute body name value)
(type-case expr body
; Number; nothing to substitute
; (why doesn't this return n? because we need an expr!)
[num (n) body]
; Add: create another add and recurse substitution into the
; sub-expressions
[add (lhs rhs) (add (substitute lhs name value)
(substitute rhs name value))]
[sub (lhs rhs) (sub (substitute lhs name value)
(substitute rhs name value))]
; With: stop substituting if this expression captures the
; variable, otherwise recurse
[with (name2 exp2 body2)
(if (eq? name2 name)
; Recurse into exp2 only, because
; this expression captures the name
(with name2
(substitute exp2 name value)
body2)
; Recurse into both exp2 and body2
(with name2
(substitute exp2 name value)
(substitute body2 name value)))]
; Variable:
[id (name2)
(if (eq? name2 name)
; This is what we're replacing
value
; Leave alone
body)]))
;; Example:
;(define source '(+ 1 (- 5 2)))
;(define source '(with (x 5) (+ x x)))
;(define source '(with (x 5) (with (x 6) (+ x x))))
(define source '(with (x 5) (with (x (+ x 2)) (+ x x))))
(define expression (parse source))
(define result (calc-4 expression))
(display "Source: ")
(print source)
(newline)
(display "Expression: ")
(print expression)
(newline)
(display "Result Value: ")
(print result)
(newline)