remove dead examples
svn: r16480
This commit is contained in:
Sam Tobin-Hochstadt
parent
93a504a817
commit
40bc4cb77a
|
|
@ -1,238 +0,0 @@
|
|||
#reader (planet "typed-reader.ss" ("plt" "typed-scheme.plt"))
|
||||
(module hw02 "../../typed-scheme.ss"
|
||||
(require "support.ss")
|
||||
;;; --------------------------------------------------------------------
|
||||
;;; Question 1
|
||||
|
||||
;; list-product : (list-of number) (list-of number) -> number
|
||||
;; computes the dot-product of two lists (as vector representations)
|
||||
;; (Assumes the two inputs are of equal length)
|
||||
(define: (list-product [l1 : (Listof number)] [l2 : (Listof number)]) : number
|
||||
(foldl #{+ :: (number number -> number)} 0 (map #{* :: (number number -> number)} l1 l2)))
|
||||
|
||||
;; tests
|
||||
(test (list-product '(1 2 3) '(4 5 6)) => 32)
|
||||
(test (list-product '() '()) => 0)
|
||||
|
||||
|
||||
;;; --------------------------------------------------------------------
|
||||
;;; Question 2
|
||||
|
||||
#|
|
||||
|
||||
<AE> ::= <AE> + <fac>
|
||||
| <AE> - <fac>
|
||||
| <fac>
|
||||
|
||||
<fac> ::= <fac> * <atom>
|
||||
| <fac> / <atom>
|
||||
| <atom>
|
||||
|
||||
<atom> ::= <number>
|
||||
| + <atom>
|
||||
| - <atom>
|
||||
| ( <AE> )
|
||||
|
||||
In the rules for <atom>, note that any number of unary +/-
|
||||
operators can be used, and that the resulting grammar is not
|
||||
ambiguous since they are put in yet another level below <fac> (they
|
||||
have higher precedence than the binary operators).
|
||||
|
||||
|#
|
||||
|
||||
|
||||
;;; --------------------------------------------------------------------
|
||||
;;; Question 3
|
||||
|
||||
;; [3a]
|
||||
(define-type BINTREE
|
||||
[Node (l BINTREE) (r BINTREE)]
|
||||
[Leaf (n number)])
|
||||
|
||||
;; used for tests:
|
||||
(define: 1234-tree : BINTREE
|
||||
(Node (Node (Leaf 1) (Leaf 2))
|
||||
(Node (Leaf 3) (Leaf 4))))
|
||||
(define: 528-tree : BINTREE (Node (Leaf 5) (Node (Leaf 2) (Leaf 8))))
|
||||
#;(provide (all-defined))
|
||||
#| [3b] BNF:
|
||||
|
||||
<BINTREE> ::= <Node> | <Leaf>
|
||||
|
||||
<Node> ::= (Node <BINTREE> <BINTREE>)
|
||||
|
||||
<Leaf> ::= (Leaf <num>)
|
||||
|
||||
|#
|
||||
|
||||
;; [3c]
|
||||
|
||||
;; tree-reduce : BINTREE (num num -> num) -> num
|
||||
;; Reduces a BINTREE to a number by descending recursively and combining
|
||||
;; results with `op'.
|
||||
(define: (tree-reduce [tree : BINTREE] [op : (number number -> number)]) : number
|
||||
(cases tree
|
||||
[(Node l r) (op (tree-reduce l op) (tree-reduce r op))]
|
||||
[(Leaf n) n]))
|
||||
;; tests:
|
||||
(test 10 <= (tree-reduce 1234-tree +))
|
||||
(test 10 <= (tree-reduce (Leaf 10) +))
|
||||
(test 24 <= (tree-reduce 1234-tree *))
|
||||
|
||||
;; tree-min : BINTREE -> num
|
||||
;; Finds the minimum number in a BINTREE.
|
||||
(define: (tree-min [tree : BINTREE]) : number
|
||||
(tree-reduce tree min))
|
||||
;; tests:
|
||||
(test 1 <= (tree-min 1234-tree))
|
||||
(test 1 <= (tree-min (Leaf 1)))
|
||||
|
||||
;; tree-min : BINTREE -> num
|
||||
;; Finds the maximum number in a BINTREE.
|
||||
(define: (tree-max [tree : BINTREE]) : number
|
||||
(tree-reduce tree max))
|
||||
;; tests:
|
||||
(test 4 <= (tree-max 1234-tree))
|
||||
(test 1 <= (tree-max (Leaf 1)))
|
||||
|
||||
;; tree-sorted? : BINTREE -> bool
|
||||
;; Tests whether the tree is sorted or not.
|
||||
(define: (tree-sorted? [tree : BINTREE]) : boolean
|
||||
(cases tree
|
||||
[(Node l r) (and (tree-sorted? l)
|
||||
(tree-sorted? r)
|
||||
(<= (tree-max l) (tree-min r)))]
|
||||
[(Leaf n) #t]))
|
||||
;; tests:
|
||||
(test (tree-sorted? 1234-tree))
|
||||
(test (tree-sorted? (Leaf 1)))
|
||||
(test (not (tree-sorted? 528-tree)))
|
||||
#|
|
||||
#| [3d]
|
||||
|
||||
Say that the cost function is cost(n) for a tree with n leaves, and
|
||||
that we're given a balanced tree of 32 leaves. We have:
|
||||
|
||||
cost(32) = 16 ; for finding the max the left side
|
||||
+ 16 ; for finding the min the right side
|
||||
+ cost(16) ; for the recursive call on the left
|
||||
+ cost(16) ; for the recursive call on the right
|
||||
+ 1 ; some constant for the `and' and the `<'
|
||||
|
||||
In general, we can drop the last one since it doesn't matter and get:
|
||||
|
||||
cost(n) = 2*(n/2) + 2*cost(n/2) = n + 2*cost(n/2)
|
||||
|
||||
and
|
||||
|
||||
cost(1) = 1
|
||||
|
||||
Continueing with the case of 32:
|
||||
|
||||
cost(32) = 32 + 2*cost(16)
|
||||
= 32 + 2*(16 + 2*cost(8))
|
||||
= 32 + 32 + 4*cost(8)
|
||||
= 32 + 32 + 32 + 8*cost(4)
|
||||
= 32 + 32 + 32 + 32 + 16*cost(2)
|
||||
= 32 + 32 + 32 + 32 + 32 + 32*cost(1)
|
||||
= 32 + 32 + 32 + 32 + 32 + 32
|
||||
|
||||
So the total cost for n leaves is n*log2(n).
|
||||
|
||||
|#
|
||||
|
||||
;; 3e
|
||||
|
||||
;; tree-sorted*? : BINTREE -> bool
|
||||
;; Tests whether the tree is sorted or not in linear time.
|
||||
;; -- The trick is to check for sortedness by recursively walking the
|
||||
;; tree and remembering the last value we have seen and making sure
|
||||
;; that new leaves are always bigger. The return value of the helper
|
||||
;; is either the right-most value if it is sorted, or #f if not.
|
||||
(define (tree-sorted*? tree)
|
||||
;; `and' is used to turn the result into a proper boolean
|
||||
(and (sorted*?-helper
|
||||
tree
|
||||
(- (left-most-value tree) 1)) ; initialize a last value
|
||||
#t))
|
||||
|
||||
;; left-most-value : BINTREE -> num
|
||||
;; Finds the left-most value in a BINTREE.
|
||||
(define (left-most-value tree)
|
||||
(cases tree
|
||||
[(Leaf n) n]
|
||||
[(Node l r) (left-most-value l)]))
|
||||
|
||||
;; sorted*?-helper : BINTREE num -> bool-or-num
|
||||
;; Helper for the above -- checks that the given tree is sorted and
|
||||
;; bigger than the given number, and returns the right-most number if it
|
||||
;; is sorted.
|
||||
(define (sorted*?-helper tree last)
|
||||
(cases tree
|
||||
[(Leaf n)
|
||||
(and (< last n) n)]
|
||||
[(Node l r)
|
||||
(let ([left-last (sorted*?-helper l last)])
|
||||
(and left-last (sorted*?-helper r left-last)))]))
|
||||
|
||||
;; tests:
|
||||
(test (tree-sorted*? 1234-tree))
|
||||
(test (tree-sorted*? (Leaf 1)))
|
||||
(test (not (tree-sorted*? 528-tree)))
|
||||
|
||||
|
||||
;;; --------------------------------------------------------------------
|
||||
;;; Question 4
|
||||
|
||||
;; tree-map : (num -> num) BINTREE -> BINTREE
|
||||
;; Maps the given function recursively over the given tree, returning a
|
||||
;; tree of the results with the same shape.
|
||||
(define (tree-map f tree)
|
||||
(cases tree
|
||||
[(Leaf n) (Leaf (f n))]
|
||||
[(Node l r) (Node (tree-map f l) (tree-map f r))]))
|
||||
|
||||
;; tests
|
||||
(test (tree-map add1 (Node (Leaf 1) (Node (Leaf 2) (Leaf 3))))
|
||||
=> (Node (Leaf 2) (Node (Leaf 3) (Leaf 4))))
|
||||
(test (tree-map add1 1234-tree)
|
||||
=> (Node (Node (Leaf 2) (Leaf 3)) (Node (Leaf 4) (Leaf 5))))
|
||||
(test (tree-map add1 (Leaf 1))
|
||||
=> (Leaf 2))
|
||||
|
||||
|
||||
;;; --------------------------------------------------------------------
|
||||
;;; Question 5
|
||||
|
||||
;; tree-insert : BINTREE num -> BINTREE
|
||||
(define (tree-insert tree n)
|
||||
(cases tree
|
||||
[(Leaf m) (if (< n m)
|
||||
(Node (Leaf n) tree)
|
||||
(Node tree (Leaf n)))]
|
||||
[(Node l r) (if (< n (tree-max l))
|
||||
(Node (tree-insert l n) r)
|
||||
(Node l (tree-insert r n)))]))
|
||||
|
||||
;; tests:
|
||||
(test (tree-sorted?
|
||||
(tree-insert (Node (Leaf 2) (Node (Leaf 4) (Leaf 6)))
|
||||
3)))
|
||||
(test (tree-sorted? (tree-insert 1234-tree 0)))
|
||||
(test (tree-sorted? (tree-insert 1234-tree 5)))
|
||||
|
||||
|
||||
;;; --------------------------------------------------------------------
|
||||
;;; Question 6
|
||||
|
||||
#|
|
||||
|
||||
The problem is that we need to keep both flattened copies in memory
|
||||
for the comparison. This means that if we have two big trees, say
|
||||
200MB each, then during the comparison we will need to have 800MB of
|
||||
RAM! The solution for this is very hard for now, but later in the
|
||||
course we will see one easy way to solve it.
|
||||
|
||||
|#|#
|
||||
|
||||
)
|
||||
|
|
@ -1,275 +0,0 @@
|
|||
#reader (planet "typed-reader.ss" ("plt" "typed-scheme.plt"))
|
||||
(module hw03 "../../typed-scheme.ss"
|
||||
|
||||
(require "support.ss")
|
||||
|
||||
#| This is the updated Algae BNF definition:
|
||||
<ALGAE> ::= <num>
|
||||
| { + <ALGAE> ... }
|
||||
| { - <ALGAE> <ALGAE> ... }
|
||||
| { * <ALGAE> ... }
|
||||
| { / <ALGAE> <ALGAE> ... }
|
||||
| { = <ALGAE> <ALGAE> }
|
||||
| { < <ALGAE> <ALGAE> }
|
||||
| { <= <ALGAE> <ALGAE> }
|
||||
| { if <ALGAE> <ALGAE> <ALGAE> }
|
||||
| { with { <id> <ALGAE> } <ALGAE>}
|
||||
| <id>
|
||||
|#
|
||||
|
||||
(define-type ALGAE
|
||||
[Num (n number)]
|
||||
[Add (args (list-of ALGAE))]
|
||||
;; note how Sub & Div match the corresponding BNF derivation
|
||||
[Sub (fst ALGAE) (args (list-of ALGAE))]
|
||||
[Mul (args (list-of ALGAE))]
|
||||
[Div (fst ALGAE) (args (list-of ALGAE))]
|
||||
[Eql (lhs ALGAE) (rhs ALGAE)]
|
||||
[Less (lhs ALGAE) (rhs ALGAE)]
|
||||
[LessEql (lhs ALGAE) (rhs ALGAE)]
|
||||
[If (cond-expr ALGAE) (then-expr ALGAE) (else-expr ALGAE)]
|
||||
[Id (name symbol)]
|
||||
[With (name symbol) (named ALGAE) (body ALGAE)])
|
||||
|
||||
|
||||
;; parse-sexpr : s-expr -> ALGAE
|
||||
#;(define: (parse-sexpr [sexpr : Sexp]) : ALGAE
|
||||
(cond
|
||||
[(number? sexpr) (Num sexpr)]
|
||||
[(symbol? sexpr) (Id sexpr)]
|
||||
;; new code (needed because not doesn't work)
|
||||
[(null? sexpr) (error 'parse-sexpr "bad syntax in ~s" sexpr)]
|
||||
;; end new code
|
||||
;; these next two have the horrid and trick.
|
||||
[(and (list? sexpr) (not (null? sexpr))
|
||||
(eq? 'with (first sexpr))
|
||||
(let ([s (second sexpr)])
|
||||
(if (list? s)
|
||||
(if (= 2 (length s))
|
||||
(let ([sym (first s)])
|
||||
(if (symbol? sym)
|
||||
(With sym
|
||||
(parse-sexpr (second s))
|
||||
(parse-sexpr (third sexpr)))
|
||||
(error 'parse-sexpr "bad `with' syntax")))
|
||||
(error 'parse-sexpr "bad `with' syntax"))
|
||||
(error 'parse-sexpr "bad `with' syntax"))))]
|
||||
[(and (list? sexpr) (not (null? sexpr))
|
||||
(let ([subs (map parse-sexpr (rest sexpr))])
|
||||
(case (first sexpr)
|
||||
[(+) (Add subs)]
|
||||
[(-) (if (null? subs)
|
||||
(error 'parse-sexpr "need at least one arg for `-'")
|
||||
(Sub (first subs) (rest subs)))]
|
||||
[(*) (Mul subs)]
|
||||
[(/) (if (null? subs)
|
||||
(error 'parse-sexpr "need at least one arg for `/'")
|
||||
(Div (first subs) (rest subs)))]
|
||||
[(=) (if (= 2 (length subs))
|
||||
(Eql (first subs) (second subs))
|
||||
(error 'parse-sexpr "need two args for `='"))]
|
||||
[(<) (if (= 2 (length subs))
|
||||
(Less (first subs) (second subs))
|
||||
(error 'parse-sexpr "need two args for `<'"))]
|
||||
[(<=) (if (= 2 (length subs))
|
||||
(LessEql (first subs) (second subs))
|
||||
(error 'parse-sexpr "need two args for `<='"))]
|
||||
[(if) (if (= 3 (length subs))
|
||||
(If (first subs) (second subs) (third subs))
|
||||
(error 'parse-sexpr "need three exprs for `if'"))]
|
||||
[else (error 'parse-sexpr "don't know about ~s"
|
||||
(first sexpr))])))]
|
||||
[else (error 'parse-sexpr "bad syntax in ~s" sexpr)]))
|
||||
|
||||
;; parse : string -> ALGAE
|
||||
;; parses a string containing an ALGAE expression to an ALGAE AST
|
||||
#;(define: (parse [str : String]) : ALGAE
|
||||
(parse-sexpr (string->sexpr str)))
|
||||
|
||||
#| Formal specs for `subst':
|
||||
(`N' is a <num>, `E1', `E2' are <ALGAE>s, `x' is some <id>, `y' is a
|
||||
*different* <id>)
|
||||
N[v/x] = N
|
||||
{+ E ...}[v/x] = {+ E[v/x] ...}
|
||||
{- E1 E ...}[v/x] = {- E1[v/x] E[v/x] ...}
|
||||
{* E ...}[v/x] = {* E[v/x] ...}
|
||||
{/ E1 E ...}[v/x] = {/ E1[v/x] E[v/x] ...}
|
||||
{= E1 E2}[v/x] = {= E1[v/x] E2[v/x]}
|
||||
{< E1 E2}[v/x] = {< E1[v/x] E2[v/x]}
|
||||
{<= E1 E2}[v/x] = {<= E1[v/x] E2[v/x]}
|
||||
{if E1 E2 E3}[v/x] = {if E1[v/x] E2[v/x] E3[v/x]}
|
||||
y[v/x] = y
|
||||
x[v/x] = v
|
||||
{with {y E1} E2}[v/x] = {with {y E1[v/x]} E2[v/x]}
|
||||
{with {x E1} E2}[v/x] = {with {x E1[v/x]} E2}
|
||||
|#
|
||||
|
||||
;; subst : ALGAE symbol ALGAE -> ALGAE
|
||||
;; substitutes the second argument with the third argument in the
|
||||
;; first argument, as per the rules of substitution; the resulting
|
||||
;; expression contains no free instances of the second argument
|
||||
(define: (subst [expr : ALGAE] [from : Symbol] [to : ALGAE]) : ALGAE
|
||||
(let ([subst-list (lambda: ([exprs : (Listof ALGAE)])
|
||||
(map (lambda: ([x : ALGAE]) (subst x from to)) exprs))])
|
||||
(cases expr
|
||||
[(Num n) expr]
|
||||
[(Add args) (Add (subst-list args))]
|
||||
[(Mul args) (Mul (subst-list args))]
|
||||
[(Sub fst args) (Sub (subst fst from to) (subst-list args))]
|
||||
[(Div fst args) (Div (subst fst from to) (subst-list args))]
|
||||
[(Eql l r) (Eql (subst l from to) (subst r from to))]
|
||||
[(Less l r) (Less (subst l from to) (subst r from to))]
|
||||
[(LessEql l r) (LessEql (subst l from to) (subst r from to))]
|
||||
[(If c t e) (If (subst c from to)
|
||||
(subst t from to)
|
||||
(subst e from to))]
|
||||
[(Id id) (if (eq? id from) to expr)]
|
||||
[(With bound-id named-expr bound-body)
|
||||
(With bound-id
|
||||
(subst named-expr from to)
|
||||
(if (eq? bound-id from)
|
||||
bound-body
|
||||
(subst bound-body from to)))])))
|
||||
|
||||
(define: (subst2 [expr : ALGAE] [from : Symbol] [to : ALGAE]) : ALGAE
|
||||
(let ([subst-list (lambda: ([exprs : (Listof ALGAE)])
|
||||
(map (lambda: ([x : ALGAE]) (subst2 x from to)) exprs))])
|
||||
(cond
|
||||
[(Num? expr) expr]
|
||||
[(Add? expr) (Add (subst-list (Add-args expr)))]
|
||||
[(Mul? expr) (Mul (subst-list (Mul-args expr)))]
|
||||
[(Sub? expr) (Sub (subst2 (Sub-fst expr) from to) (subst-list (Sub-args expr)))]
|
||||
[(Div? expr) (Div (subst2 (Div-fst expr) from to) (subst-list (Div-args expr)))]
|
||||
[(Eql? expr) (Eql (subst2 (Eql-lhs expr) from to) (subst2 (Eql-rhs expr) from to))]
|
||||
[(Less? expr) (Less (subst2 (Less-lhs expr) from to) (subst2 (Less-rhs expr) from to))]
|
||||
[(LessEql? expr) (LessEql (subst2 (LessEql-lhs expr) from to) (subst2 (LessEql-rhs expr) from to))]
|
||||
[(If? expr) (If (subst2 (If-cond-expr expr) from to)
|
||||
(subst2 (If-then-expr expr) from to)
|
||||
(subst2 (If-else-expr expr) from to))]
|
||||
[(Id? expr) (if (eq? (Id-name expr) from) to expr)]
|
||||
[(With? expr)
|
||||
(With (With-name expr)
|
||||
(subst2 (With-named expr) from to)
|
||||
(if (eq? (With-name expr) from)
|
||||
(With-body expr)
|
||||
(subst2 (With-body expr) from to)))])))
|
||||
|
||||
#| Formal specs for `eval':
|
||||
eval(N) = N
|
||||
eval({+ E ...}) = eval(E) + ...
|
||||
eval({- E1}) = -eval(E1)
|
||||
eval({- E1 E ...}) = eval(E1) - (eval(E) + ...)
|
||||
eval({* E ...}) = eval(E1) * ...
|
||||
eval({/ E1}) = 1/eval(E1)
|
||||
eval({/ E1 E ...}) = eval(E1) / (eval(E) * ...)
|
||||
eval({= E1 E2}) = 1 if eval(E1)=eval(E2), 0 otherwise
|
||||
eval({< E1 E2}) = 1 if eval(E1)<eval(E2), 0 otherwise
|
||||
eval({<= E1 E2}) = 1 if eval(E1)<=eval(E2), 0 otherwise
|
||||
eval({if E1 E2 E3}) = eval(E3) if eval(E1)=0, eval(E2) otherwise
|
||||
eval(id) = error!
|
||||
eval({with {x E1} E2}) = eval(E2[eval(E1)/x])
|
||||
|#
|
||||
|
||||
;; -eval : ALGAE -> number
|
||||
;; evaluates ALGAE expressions by reducing them to numbers
|
||||
(define: (-eval [expr : ALGAE]) : Number
|
||||
(cases expr
|
||||
[(Num n) n]
|
||||
[(Add args) (foldl #{+ : (Number Number -> Number)} 0 (map -eval args))]
|
||||
[(Mul args) (foldl #{* : (Number Number -> Number)} 1 (map -eval args))]
|
||||
[(Sub fst args) (if (null? args)
|
||||
(- (-eval fst))
|
||||
(- (-eval fst) (foldl #{+ : (Number Number -> Number)} 0 (map -eval args))))]
|
||||
[(Div fst args) (if (null? args)
|
||||
(/ (-eval fst))
|
||||
(/ (-eval fst) (foldl #{* : (Number Number -> Number)} 1 (map -eval args))))]
|
||||
[(Eql l r) (if (= (-eval l) (-eval r)) 1 0)]
|
||||
[(Less l r) (if (< (-eval l) (-eval r)) 1 0)]
|
||||
[(LessEql l r) (if (<= (-eval l) (-eval r)) 1 0)]
|
||||
[(If cond then else) (-eval (if (= 0 (-eval cond)) else then))]
|
||||
[(With bound-id named-expr bound-body)
|
||||
(-eval (subst bound-body bound-id (Num (-eval named-expr))))]
|
||||
[(Id id) (error '-eval "free identifier: ~s" id)]))
|
||||
|
||||
;; run : string -> number
|
||||
;; evaluate an ALGAE program contained in a string
|
||||
#;(define: (run [str : String]) : Number
|
||||
(-eval (parse str)))
|
||||
|
||||
;; previous tests
|
||||
(test 5 <= (run "5"))
|
||||
(test 10 <= (run "{+ 5 5}"))
|
||||
(test 20 <= (run "{with {x {+ 5 5}} {+ x x}}"))
|
||||
(test 10 <= (run "{with {x 5} {+ x x}}"))
|
||||
(test 14 <= (run "{with {x {+ 5 5}} {with {y {- x 3}} {+ y y}}}"))
|
||||
(test 4 <= (run "{with {x 5} {with {y {- x 3}} {+ y y}}}"))
|
||||
(test 15 <= (run "{with {x 5} {+ x {with {x 3} 10}}}"))
|
||||
(test 8 <= (run "{with {x 5} {+ x {with {x 3} x}}}"))
|
||||
(test 10 <= (run "{with {x 5} {+ x {with {y 3} x}}}"))
|
||||
(test 5 <= (run "{with {x 5} {with {y x} y}}"))
|
||||
(test 5 <= (run "{with {x 5} {with {x x} x}}"))
|
||||
;; new tests
|
||||
(test 0 <= (run "{+}"))
|
||||
(test 1 <= (run "{*}"))
|
||||
(test -2 <= (run "{- 2}"))
|
||||
(test 1/2 <= (run "{/ 2}"))
|
||||
(test 1/2 <= (run "{/ 1 2}"))
|
||||
(test 10 <= (run "{+ 1 2 3 4}"))
|
||||
(test 2 <= (run "{if {< 2 3} 2 3}"))
|
||||
(test 2 <= (run "{if {<= 3 3} 2 3}"))
|
||||
(test 3 <= (run "{if {= 2 3} {/ 2 0} 3}"))
|
||||
(test 1 <= (run "{+ {= 3 3} {< 3 2} {<= 3 2}}"))
|
||||
(test 1 <= (run "{with {x 2} {= 1/8 {/ {* x 4}}}}"))
|
||||
(test 1 <= (run "{with {x 2} {if {< 1 2} {<= 1 2} 3}}"))
|
||||
;; test errors
|
||||
(test (run "{-}") =error> "need at least")
|
||||
(test (run "{/}") =error> "need at least")
|
||||
(test (run "{= 1 2 3}") =error> "need two args")
|
||||
(test (run "{< 1}") =error> "need two args")
|
||||
(test (run "{<=}") =error> "need two args")
|
||||
(test (run "{with 1}") =error> "bad * syntax")
|
||||
(test (run "{with {x 1} y}") =error> "free identifier")
|
||||
(test (run "{if 1}") =error> "need three")
|
||||
(test (run "{foo 1}") =error> "don't know")
|
||||
(test (run "{}") =error> "bad syntax in")
|
||||
|
||||
#| Dessert answer:
|
||||
|
||||
Adding `...' (or Kleene star) to our BNF language does not make it
|
||||
more expressive. An informal proof: say that you have a BNF with
|
||||
some use of `...' ("?" indicates unknown parts):
|
||||
|
||||
<FOO> ::= ? | ? <BAR> ... ? | ?
|
||||
|
||||
we can translate that to a BNF that does not use `...' by inventing a
|
||||
fresh non-terminal (say that `<FOO1>' is not used elsewhere) and
|
||||
rewriting the above derivation as follows:
|
||||
|
||||
<FOO> ::= ? | ? <FOO1> ? | ?
|
||||
<FOO1> ::= <BAR> <FOO1>
|
||||
| <-- an empty derivation
|
||||
|
||||
This can be systematically repeated, and the result will be an
|
||||
ellipsis-free BNF that is equivalent to the original.
|
||||
|
||||
|#
|
||||
|
||||
#| Bonus answer
|
||||
|
||||
Yes, we could simulate `and' and `or' using arithmetics:
|
||||
|
||||
* use {* x y} instead of {and x y}
|
||||
|
||||
* use {+ {* x x} {* y y}} instead of {or x y}
|
||||
|
||||
... but that wouldn't be enough to do short circuiting and simulating
|
||||
Scheme's `and' and `or', because these forms will evaluate *all* of
|
||||
their subexpressions. To do that properly, we need more than
|
||||
arithmetics: we need conditionals. For example:
|
||||
|
||||
* use {if x y 0} instead of {and x y}
|
||||
|
||||
* use {if x 1 y} instead of {or x y}
|
||||
|
||||
|#
|
||||
)
|
||||
|
|
@ -1,349 +0,0 @@
|
|||
#reader (planet "typed-reader.ss" ("plt" "typed-scheme.plt"))
|
||||
(module hw04 "../../typed-scheme.ss"
|
||||
|
||||
(require "support.ss")
|
||||
|
||||
#| This is the updated Algae BNF definition:
|
||||
<PROGRAM> ::= { program <FUN> ... }
|
||||
<FUN> ::= { fun <id> { <id> } <ALGAE> }
|
||||
<ALGAE> ::= <num>
|
||||
| { + <ALGAE> ... }
|
||||
| { - <ALGAE> <ALGAE> ... }
|
||||
| { * <ALGAE> ... }
|
||||
| { / <ALGAE> <ALGAE> ... }
|
||||
| { = <ALGAE> <ALGAE> }
|
||||
| { < <ALGAE> <ALGAE> }
|
||||
| { <= <ALGAE> <ALGAE> }
|
||||
| { if <ALGAE> <ALGAE> <ALGAE> }
|
||||
| { with { <id> <ALGAE> } <ALGAE>}
|
||||
| <id>
|
||||
| { call <id> <ALGAE> }
|
||||
|#
|
||||
|
||||
|
||||
(define-type ALGAE
|
||||
[Num (n number)]
|
||||
[Add (args (list-of ALGAE))]
|
||||
;; note how Sub & Div match the corresponding BNF derivation
|
||||
[Sub (fst ALGAE) (args (list-of ALGAE))]
|
||||
[Mul (args (list-of ALGAE))]
|
||||
[Div (fst ALGAE) (args (list-of ALGAE))]
|
||||
[Eql (lhs ALGAE) (rhs ALGAE)]
|
||||
[Less (lhs ALGAE) (rhs ALGAE)]
|
||||
[LessEql (lhs ALGAE) (rhs ALGAE)]
|
||||
[If (cond-expr ALGAE) (then-expr ALGAE) (else-expr ALGAE)]
|
||||
[Id (name symbol)]
|
||||
[With (name symbol) (named ALGAE) (body ALGAE)]
|
||||
[Call (fun symbol) (arg ALGAE)])
|
||||
|
||||
(define-type FUN
|
||||
[Fun (name symbol) (arg symbol) (body ALGAE)])
|
||||
|
||||
(define-type PROGRAM
|
||||
[Funs (funs (list-of FUN))])
|
||||
|
||||
|
||||
;; parse-program : s-expr -> PROGRAM
|
||||
;; parses a whole program s-expression into a PROGRAM
|
||||
#;(define: (parse-program [sexpr : Sexp]) : PROGRAM
|
||||
(if (and (list? sexpr)
|
||||
(not (null? sexpr))
|
||||
(eq? 'program (first sexpr)))
|
||||
(Funs (map parse-fun (rest sexpr)))
|
||||
(error 'parse-program "bad program syntax: ~s" sexpr)))
|
||||
|
||||
;; parse-fun : s-expr -> FUN
|
||||
;; parses a function s-expression syntax to an instance of FUN
|
||||
#;(define: (parse-fun [sexpr : Sexp]) : FUN
|
||||
(if (and ;; check overall structure
|
||||
(list? sexpr)
|
||||
(= 4 (length sexpr))
|
||||
(eq? 'fun (first sexpr))
|
||||
;; check function name
|
||||
(symbol? (second sexpr))
|
||||
;; check argument in a sublist
|
||||
(list? (third sexpr))
|
||||
(= 1 (length (third sexpr)))
|
||||
(symbol? (first (third sexpr))))
|
||||
;; assemble the needed Fun parts
|
||||
(Fun (second sexpr)
|
||||
(first (third sexpr))
|
||||
(parse-expr (fourth sexpr)))
|
||||
(error 'parse-program "bad function syntax: ~s" sexpr)))
|
||||
|
||||
;; parse-expr : s-expr -> ALGAE
|
||||
;; parses an s-expression into an ALGAE abstract syntax tree
|
||||
#;(define: (parse-expr [sexpr : Sexp]) : ALGAE
|
||||
(cond
|
||||
[(number? sexpr) (Num sexpr)]
|
||||
[(symbol? sexpr) (Id sexpr)]
|
||||
[(and (list? sexpr) (not (null? sexpr))
|
||||
(eq? 'with (first sexpr)))
|
||||
(if (and (list? (second sexpr))
|
||||
(= 2 (length (second sexpr)))
|
||||
(symbol? (first (second sexpr))))
|
||||
(With (first (second sexpr))
|
||||
(parse-expr (second (second sexpr)))
|
||||
(parse-expr (third sexpr)))
|
||||
(error 'parse-expr "bad `with' syntax"))]
|
||||
;; and trick
|
||||
[(and (list? sexpr) (not (null? sexpr))
|
||||
(eq? 'call (first sexpr)))
|
||||
(if (and (= 3 (length sexpr)) (symbol? (second sexpr)))
|
||||
(Call (second sexpr)
|
||||
(parse-expr (third sexpr)))
|
||||
(error 'parse-expr "bad `call' syntax"))]
|
||||
;; and trick
|
||||
[(and (list? sexpr) (not (null? sexpr)))
|
||||
(let ([subs (map parse-expr (rest sexpr))])
|
||||
(case (first sexpr)
|
||||
[(+) (Add subs)]
|
||||
[(-) (if (null? subs)
|
||||
(error 'parse-expr "need at least one arg for `-'")
|
||||
(Sub (first subs) (rest subs)))]
|
||||
[(*) (Mul subs)]
|
||||
[(/) (if (null? subs)
|
||||
(error 'parse-expr "need at least one arg for `/'")
|
||||
(Div (first subs) (rest subs)))]
|
||||
[(=) (if (= 2 (length subs))
|
||||
(Eql (first subs) (second subs))
|
||||
(error 'parse-expr "need two args for `='"))]
|
||||
[(<) (if (= 2 (length subs))
|
||||
(Less (first subs) (second subs))
|
||||
(error 'parse-expr "need two args for `<'"))]
|
||||
[(<=) (if (= 2 (length subs))
|
||||
(LessEql (first subs) (second subs))
|
||||
(error 'parse-expr "need two args for `<='"))]
|
||||
[(if) (if (= 3 (length subs))
|
||||
(If (first subs) (second subs) (third subs))
|
||||
(error 'parse-expr "need three exprs for `if'"))]
|
||||
[else (error 'parse-expr "don't know about ~s"
|
||||
(first sexpr))]))]
|
||||
[else (error 'parse-expr "bad syntax in ~s" sexpr)]))
|
||||
|
||||
;; Bonus:
|
||||
;; verify-functions : PROGRAM -> void
|
||||
;; this function verifies the list of functions, and doesn't return any
|
||||
;; useful value.
|
||||
(define: (verify-functions [prog : PROGRAM]) : Any
|
||||
;; this will fail if there is no `main' definition
|
||||
(lookup-fun 'main prog)
|
||||
;; check for repeating names, see helper below
|
||||
(check-duplicates (map Fun-name (Funs-funs prog)) '())
|
||||
;; finally, scan `Call' syntaxes
|
||||
(check-calls-list (map Fun-body (Funs-funs prog)) prog))
|
||||
|
||||
;; check-duplicates : (list-of symbol) (list-of symbol) -> void
|
||||
;; helper for `verify-functions'
|
||||
(define: (check-duplicates [symbols : (Listof Symbol)] [seen : (Listof Symbol)]) : Any
|
||||
;; `symbols' is what we check, `seen' is names we've already seen
|
||||
(cond [(null? symbols) 'ok]
|
||||
[(member (first symbols) seen)
|
||||
(error 'verify-functions
|
||||
"duplicate definition: ~s" (first symbols))]
|
||||
[else (check-duplicates (rest symbols) ;; CHANGE
|
||||
(cons (first symbols) seen))]))
|
||||
|
||||
;; helper for `verify-functions'
|
||||
(define: (check-calls-list [funs : (Listof ALGAE)] [prog : PROGRAM]) : Any
|
||||
(if (null? funs)
|
||||
'ok
|
||||
;; note that `and' is not really needed below, we just want to use
|
||||
;; both expressions so everything is checked. Also in
|
||||
;; `check-calls-expr'.
|
||||
(and (check-calls-expr (first funs) prog)
|
||||
(check-calls-list (rest funs) prog))))
|
||||
|
||||
(define: (check-calls-expr [expr : ALGAE] [prog : PROGRAM]) : Any
|
||||
(cases expr
|
||||
[(Num n) 'ok]
|
||||
[(Add args) (check-calls-list args prog)]
|
||||
[(Mul args) (check-calls-list args prog)]
|
||||
[(Sub fst args) (check-calls-list (cons fst args) prog)]
|
||||
[(Div fst args) (check-calls-list (cons fst args) prog)]
|
||||
[(Eql l r) (and (check-calls-expr l prog)
|
||||
(check-calls-expr r prog))]
|
||||
[(Less l r) (and (check-calls-expr l prog)
|
||||
(check-calls-expr r prog))]
|
||||
[(LessEql l r) (and (check-calls-expr l prog)
|
||||
(check-calls-expr r prog))]
|
||||
[(If c t e) (and (check-calls-expr c prog)
|
||||
(check-calls-expr t prog)
|
||||
(check-calls-expr e prog))]
|
||||
[(Id id) 'ok]
|
||||
[(With bound-id named-expr bound-body)
|
||||
(and (check-calls-expr named-expr prog)
|
||||
(check-calls-expr bound-body prog))]
|
||||
[(Call fun-name arg)
|
||||
(and (lookup-fun fun-name prog)
|
||||
(check-calls-expr arg prog))]))
|
||||
|
||||
;; parse : string -> PROGRAM
|
||||
;; parses a string containing an ALGAE program to a PROGRAM instance
|
||||
#;(define (parse str)
|
||||
(let ([prog (parse-program (string->sexpr str))])
|
||||
;; Bonus answer: the reason we use two expressions is that
|
||||
;; `verify-functions' can only signal errors, so it is used only for
|
||||
;; its side effect.
|
||||
(verify-functions prog)
|
||||
prog))
|
||||
|
||||
;; subst : ALGAE symbol ALGAE -> ALGAE
|
||||
;; substitutes the second argument with the third argument in the
|
||||
;; first argument, as per the rules of substitution; the resulting
|
||||
;; expression contains no free instances of the second argument
|
||||
(define: (subst [expr : ALGAE] [from : symbol] [to : ALGAE]) : ALGAE
|
||||
(let ([subst-list (lambda: ([exprs : (Listof ALGAE)])
|
||||
(map (lambda: ([x : ALGAE]) (subst x from to)) exprs))])
|
||||
(cases expr
|
||||
[(Num n) expr]
|
||||
[(Add args) (Add (subst-list args))]
|
||||
[(Mul args) (Mul (subst-list args))]
|
||||
[(Sub fst args) (Sub (subst fst from to) (subst-list args))]
|
||||
[(Div fst args) (Div (subst fst from to) (subst-list args))]
|
||||
[(Eql l r) (Eql (subst l from to) (subst r from to))]
|
||||
[(Less l r) (Less (subst l from to) (subst r from to))]
|
||||
[(LessEql l r) (LessEql (subst l from to) (subst r from to))]
|
||||
[(If c t e) (If (subst c from to)
|
||||
(subst t from to)
|
||||
(subst e from to))]
|
||||
[(Id id) (if (eq? id from) to expr)]
|
||||
[(With bound-id named-expr bound-body)
|
||||
(With bound-id
|
||||
(subst named-expr from to)
|
||||
(if (eq? bound-id from)
|
||||
bound-body
|
||||
(subst bound-body from to)))]
|
||||
[(Call fun-name arg) (Call fun-name (subst arg from to))])))
|
||||
|
||||
;; lookup-fun : symbol PROGRAM -> FUN
|
||||
;; looks up a FUN instance in a PROGRAM given its name
|
||||
(define: (lookup-fun [name : Symbol] [prog : PROGRAM]) : FUN
|
||||
(cases prog
|
||||
[(Funs funs)
|
||||
(or (ormap (lambda: ([fun : FUN])
|
||||
;; `ormap' will return the first true (= non-#f)
|
||||
;; result, so this is both a predicate and returning
|
||||
;; the value that is used
|
||||
(cases fun
|
||||
[(Fun fname arg expr) (and (eq? fname name) fun)]))
|
||||
funs)
|
||||
(error 'lookup-fun
|
||||
"missing function definition for: ~s" name))]))
|
||||
|
||||
;; eval : ALGAE PROGRAM -> number
|
||||
;; evaluates ALGAE expressions by reducing them to numbers
|
||||
;; `prog' is provided for function lookup
|
||||
(define: (-eval [expr : ALGAE] [prog : PROGRAM]) : Number
|
||||
;; note the scoping rules: the following function will call the real
|
||||
;; eval, but it expects a single argument, and always uses `prog'
|
||||
(let ([-eval (lambda: ([expr : ALGAE]) (-eval expr prog))])
|
||||
(cases expr
|
||||
[(Num n) n]
|
||||
[(Add args) (foldl #{+ :: (Number Number -> Number)} 0 (map -eval args))]
|
||||
[(Mul args) (foldl #{* :: (Number Number -> Number)} 1 (map -eval args))]
|
||||
[(Sub fst args) (if (null? args)
|
||||
(- (-eval fst))
|
||||
(- (-eval fst) (foldl #{+ :: (Number Number -> Number)} 0 (map -eval args))))]
|
||||
[(Div fst args) (if (null? args)
|
||||
(/ (-eval fst))
|
||||
(/ (-eval fst) (foldl #{* :: (Number Number -> Number)} 1 (map -eval args))))]
|
||||
[(Eql l r) (if (= (-eval l) (-eval r)) 1 0)]
|
||||
[(Less l r) (if (< (-eval l) (-eval r)) 1 0)]
|
||||
[(LessEql l r) (if (<= (-eval l) (-eval r)) 1 0)]
|
||||
[(If cond then else) (-eval (if (= 0 (-eval cond)) else then))]
|
||||
[(With bound-id named-expr bound-body)
|
||||
(-eval (subst bound-body bound-id (Num (-eval named-expr))))]
|
||||
[(Id id) (error '-eval "free identifier: ~s" id)]
|
||||
[(Call fun-name arg)
|
||||
(cases (lookup-fun fun-name prog)
|
||||
[(Fun name bound-id body)
|
||||
(-eval (subst body bound-id (Num (-eval arg))))])])))
|
||||
|
||||
;; run : string number -> number
|
||||
;; evaluate an ALGAE complete program contained in a string using a
|
||||
;; given value
|
||||
#;(define: (run [str : String] [arg : Number]) : Number
|
||||
(let ([prog (parse str)])
|
||||
(-eval (Call 'main (Num arg)) prog)))
|
||||
|
||||
;; big test
|
||||
(test (run "{program
|
||||
{fun even? {n}
|
||||
{if {= 0 n} 1 {call odd? {- n 1}}}}
|
||||
{fun odd? {n}
|
||||
{if {= 0 n} 0 {call even? {- n 1}}}}
|
||||
{fun main {n}
|
||||
{if {= n 1}
|
||||
1
|
||||
{+ 1 {call main
|
||||
{if {call even? n}
|
||||
{/ n 2}
|
||||
{+ 1 {* n 3}}}}}}}}"
|
||||
3)
|
||||
=> 8)
|
||||
;; test cases for full coverage
|
||||
(test (run "1" 1)
|
||||
=error> "bad program syntax")
|
||||
(test (run "{program 1}" 1)
|
||||
=error> "bad function syntax")
|
||||
(test (run "{program {fun main {x} {with {y 1} {+ x y}}}}" 1)
|
||||
=> 2)
|
||||
(test (run "{program {fun main {x} {with {foo 1} {call foo foo}}}
|
||||
{fun foo {x} {- x -1}}}"
|
||||
1)
|
||||
=> 2)
|
||||
(test (run "{program {fun main {x} {with y {+ x y}}}}" 1)
|
||||
=error> "bad `with' syntax")
|
||||
(test (run "{program {fun main {x} {call 1 2}}}" 1)
|
||||
=error> "bad `call' syntax")
|
||||
(test (run "{program {fun main {x} {-}}}" 1)
|
||||
=error> "need at least one")
|
||||
(test (run "{program {fun main {x} {/}}}" 1)
|
||||
=error> "need at least one")
|
||||
(test (run "{program {fun main {x} {=}}}" 1)
|
||||
=error> "need two args")
|
||||
(test (run "{program {fun main {x} {< 1}}}" 1)
|
||||
=error> "need two args")
|
||||
(test (run "{program {fun main {x} {<=}}}" 1)
|
||||
=error> "need two args")
|
||||
(test (run "{program {fun main {x} {if 1 2 3 4}}}" 1)
|
||||
=error> "need three exprs")
|
||||
(test (run "{program {fun main {x} {main 1}}}" 1)
|
||||
=error> "don't know about")
|
||||
(test (run "{program {fun main {x} {}}}" 1)
|
||||
=error> "bad syntax in")
|
||||
(test (run "{program {fun main {x} x} {fun main {x} x}}" 1)
|
||||
=error> "duplicate definition")
|
||||
(test (run "{program {fun main {x} {call foo x}}}" 1)
|
||||
=error> "missing function definition")
|
||||
(test (run "{program {fun main {x} y}}" 1)
|
||||
=error> "free identifier")
|
||||
(test (run "{program
|
||||
{fun main {x}
|
||||
{*{+{*{+{*}{*}}{+{*}{*}{*}{*}}{+{*}{*}{*}{*}}}{*}}
|
||||
{+{*}{*}{*}{*}{*}}
|
||||
{+{*}{*}{*}{*}}}}}" 1)
|
||||
=> 660)
|
||||
(test (run "{program {fun main {x} {+ {< x 3} {<= x 3} {= x 3}}}}" 1)
|
||||
=> 2)
|
||||
(test (run "{program {fun main {x} {+ {< x 3} {<= x 3} {= x 3}}}}" 3)
|
||||
=> 2)
|
||||
(test (run "{program {fun main {x} {+ {< x 3} {<= x 3} {= x 3}}}}" 4)
|
||||
=> 0)
|
||||
(test (run "{program {fun main {x} {* {- x} {/ x}}}}" 2)
|
||||
=> -1)
|
||||
(test (run "{program {fun main {x} {with {x 2} x}}}" 1)
|
||||
=> 2)
|
||||
;; can't check `run' since we won't check that the error happend when
|
||||
;; parsing
|
||||
(test (parse "{program {fun foo {x} x}}")
|
||||
=error> "missing function definition for: main")
|
||||
(test (parse "{program {fun main {x} {call bar x}} {fun foo {x} x}}")
|
||||
=error> "missing function definition for: bar")
|
||||
;; test that the language is not higher order
|
||||
(test 1 <= (run "{program {fun foo {foo} foo}
|
||||
{fun main {foo} {call foo foo}}}"
|
||||
1))
|
||||
|
||||
)
|
||||
|
|
@ -1,222 +0,0 @@
|
|||
#reader(planet "typed-reader.ss" ("plt" "typed-scheme.plt"))
|
||||
(module hw05 "../../typed-scheme.ss"
|
||||
|
||||
(require "support.ss")
|
||||
|
||||
#|
|
||||
The grammar:
|
||||
<BRANG> ::= <num>
|
||||
| { + <BRANG> <BRANG> }
|
||||
| { - <BRANG> <BRANG> }
|
||||
| { * <BRANG> <BRANG> }
|
||||
| { / <BRANG> <BRANG> }
|
||||
| { with { <id> <BRANG> } <BRANG> }
|
||||
| <id>
|
||||
| { fun { <id> } <BRANG> }
|
||||
| { call <BRANG> <BRANG> }
|
||||
|
||||
Evaluation rules:
|
||||
eval(N,env) = N
|
||||
eval({+ E1 E2},env) = eval(E1,env) + eval(E2,env)
|
||||
eval({- E1 E2},env) = eval(E1,env) - eval(E2,env)
|
||||
eval({* E1 E2},env) = eval(E1,env) * eval(E2,env)
|
||||
eval({/ E1 E2},env) = eval(E1,env) / eval(E2,env)
|
||||
eval(Ref(N),env) = list-ref(env,N)
|
||||
eval({with {x E1} E2},env) = eval(E2,cons(eval(E1,env),env))
|
||||
eval({fun {x} E},env) = <{fun {x} E},env>
|
||||
eval({call E1 E2},env1) = eval(Ef,cons(eval(E2,env1),env2))
|
||||
if eval(E1,env1)=<{fun {x} Ef},env2>
|
||||
= error! otherwise
|
||||
|#
|
||||
|
||||
;; input syntax
|
||||
(define-type BRANG
|
||||
[Num (n number)]
|
||||
[Add (lhs BRANG) (rhs BRANG)]
|
||||
[Sub (lhs BRANG) (rhs BRANG)]
|
||||
[Mul (lhs BRANG) (rhs BRANG)]
|
||||
[Div (lhs BRANG) (rhs BRANG)]
|
||||
[Id (name symbol)]
|
||||
[With (name symbol) (named BRANG) (body BRANG)]
|
||||
[Fun (name symbol) (body BRANG)]
|
||||
[Call (fun-expr BRANG) (arg-expr BRANG)])
|
||||
|
||||
;; preprocessed syntax
|
||||
(define-type BRANG*
|
||||
[Num* (n number)]
|
||||
[Add* (lhs BRANG*) (rhs BRANG*)]
|
||||
[Sub* (lhs BRANG*) (rhs BRANG*)]
|
||||
[Mul* (lhs BRANG*) (rhs BRANG*)]
|
||||
[Div* (lhs BRANG*) (rhs BRANG*)]
|
||||
[Ref* (idx Number)]
|
||||
[With* (named BRANG*) (body BRANG*)]
|
||||
[Fun* (body BRANG*)]
|
||||
[Call* (fun-expr BRANG*) (arg-expr BRANG*)])
|
||||
|
||||
;; parse-sexpr : s-expr -> BRANG
|
||||
#;(define (parse-sexpr sexpr)
|
||||
(cond [(number? sexpr) (Num sexpr)]
|
||||
[(symbol? sexpr) (Id sexpr)]
|
||||
[(and (list? sexpr)
|
||||
(not (null? sexpr))
|
||||
(eq? 'with (first sexpr)))
|
||||
(if (and (= 3 (length sexpr))
|
||||
(list? (second sexpr))
|
||||
(= 2 (length (second sexpr)))
|
||||
(symbol? (first (second sexpr))))
|
||||
(With (first (second sexpr))
|
||||
(parse-sexpr (second (second sexpr)))
|
||||
(parse-sexpr (third sexpr)))
|
||||
(error 'parse-sexpr "bad `with' syntax"))]
|
||||
[(and (list? sexpr)
|
||||
(not (null? sexpr))
|
||||
(eq? 'fun (first sexpr)))
|
||||
(if (and (= 3 (length sexpr))
|
||||
(list? (second sexpr))
|
||||
(= 1 (length (second sexpr)))
|
||||
(symbol? (first (second sexpr))))
|
||||
(Fun (first (second sexpr))
|
||||
(parse-sexpr (third sexpr)))
|
||||
(error 'parse-sexpr "bad `fun' syntax"))]
|
||||
[(and (list? sexpr) (= 3 (length sexpr)))
|
||||
(let ([make-node
|
||||
(case (first sexpr)
|
||||
[(+) Add]
|
||||
[(-) Sub]
|
||||
[(*) Mul]
|
||||
[(/) Div]
|
||||
[(call) Call]
|
||||
[else (error 'parse-sexpr "don't know about ~s"
|
||||
(first sexpr))])])
|
||||
(make-node (parse-sexpr (second sexpr))
|
||||
(parse-sexpr (third sexpr))))]
|
||||
[else (error 'parse-sexpr "bad syntax in ~s" sexpr)]))
|
||||
|
||||
;; parse : string -> BRANG
|
||||
;; parses a string containing an BRANG expression to a BRANG AST
|
||||
#;(define (parse str)
|
||||
(parse-sexpr (string->sexpr str)))
|
||||
|
||||
|
||||
;; These are the values of our language
|
||||
(define-type VAL
|
||||
[NumV (n number)]
|
||||
[FunV (body BRANG*) (env ENV)])
|
||||
|
||||
;; NEW
|
||||
(define-type-alias ENV (Listof VAL))
|
||||
|
||||
;; An environment is a simple list of values
|
||||
;(define ENV? (list-of VAL?))
|
||||
|
||||
;; Syntactic environments for the de-Bruijn preprocessing:
|
||||
;; define a type and an empty environment
|
||||
|
||||
;; this is represented by procedures, but the type should be:
|
||||
;; DE-ENV := symbol -> integer
|
||||
;; NEW
|
||||
(define-type-alias DE-ENV (Symbol -> Number))
|
||||
|
||||
;; de-empty-env : DE-ENV
|
||||
;; the empty syntactic environment, always throws an error
|
||||
(define: (de-empty-env [id : Symbol]) : Number
|
||||
(error 'de-env "Free identifier: ~s" id))
|
||||
|
||||
;; de-extend : DE-ENV symbol -> DE-ENV
|
||||
;; extends a given de-env for a new identifier
|
||||
(define: (de-extend [env : DE-ENV] [id : Symbol]) : DE-ENV
|
||||
(lambda: ([name : Symbol])
|
||||
(if (eq? id name)
|
||||
0
|
||||
(+ 1 (env name)))))
|
||||
;; test
|
||||
#;(test (let ([e (de-extend (de-extend de-empty-env 'b) 'a)])
|
||||
(map (lambda (id) (e id))
|
||||
'(a b)))
|
||||
=> '(0 1))
|
||||
|
||||
;; preprocess : BRANG DE-ENV -> BRANG*
|
||||
;; replaces identifier expressions into Ref AST values
|
||||
(define: (preprocess [expr : BRANG] [de-env : DE-ENV]) : BRANG*
|
||||
(let ([sub (lambda: ([expr : BRANG]) (preprocess expr de-env))])
|
||||
(cases expr
|
||||
[(Num n) (Num* n)]
|
||||
[(Add l r) (Add* (sub l) (sub r))]
|
||||
[(Sub l r) (Sub* (sub l) (sub r))]
|
||||
[(Mul l r) (Mul* (sub l) (sub r))]
|
||||
[(Div l r) (Div* (sub l) (sub r))]
|
||||
[(With bound-id named-expr bound-body)
|
||||
(With* (sub named-expr)
|
||||
(preprocess bound-body (de-extend de-env bound-id)))]
|
||||
[(Id id) (Ref* (de-env id))]
|
||||
[(Fun bound-id bound-body)
|
||||
(Fun* (preprocess bound-body (de-extend de-env bound-id)))]
|
||||
[(Call fun-expr arg-expr)
|
||||
(Call* (sub fun-expr) (sub arg-expr))])))
|
||||
|
||||
;; arith-op : (num num -> num) VAL VAL -> VAL
|
||||
;; gets a Scheme numeric binary operator, and uses it within a NumV
|
||||
;; wrapper
|
||||
(define: (arith-op [op : (Number Number -> Number)] [val1 : VAL] [val2 : VAL]) : VAL
|
||||
(define: (NumV->number [v : VAL]) : Number
|
||||
(cases v
|
||||
[(NumV n) n]
|
||||
[else (error 'arith-op "expects a number, got: ~s" v)]))
|
||||
(NumV (op (NumV->number val1) (NumV->number val2))))
|
||||
|
||||
;; eval : BRANG* env -> VAL
|
||||
;; evaluates BRANG* expressions by reducing them to values
|
||||
(define: (-eval [expr : BRANG*] [env : ENV]) : VAL
|
||||
(cases expr
|
||||
[(Num* n) (NumV n)]
|
||||
[(Add* l r) (arith-op + (-eval l env) (-eval r env))]
|
||||
[(Sub* l r) (arith-op - (-eval l env) (-eval r env))]
|
||||
[(Mul* l r) (arith-op * (-eval l env) (-eval r env))]
|
||||
[(Div* l r) (arith-op / (-eval l env) (-eval r env))]
|
||||
[(With* named-expr bound-body)
|
||||
(-eval bound-body (cons (-eval named-expr env) env))]
|
||||
[(Ref* n) (list-ref env n)]
|
||||
[(Fun* bound-body) (FunV bound-body env)]
|
||||
[(Call* fun-expr arg-expr)
|
||||
(let ([fval (-eval fun-expr env)])
|
||||
(cases fval
|
||||
[(FunV bound-body f-env)
|
||||
(-eval bound-body (cons (-eval arg-expr env) f-env))]
|
||||
[else (error '-eval "`call' expects a function, got: ~s"
|
||||
fval)]))]))
|
||||
#|
|
||||
;; run : string -> number
|
||||
;; evaluate a BRANG program contained in a string
|
||||
(define (run str)
|
||||
(let ([result (-eval (preprocess (parse str) de-empty-env) null)])
|
||||
(cases result
|
||||
[(NumV n) n]
|
||||
[else (error 'run
|
||||
"evaluation returned a non-number: ~s" result)])))
|
||||
|
||||
;; tests
|
||||
|
||||
(test (run "{call {fun {x} {+ x 1}} 4}")
|
||||
=> 5)
|
||||
(test (run "{with {add3 {fun {x} {+ x 3}}}
|
||||
{call add3 1}}")
|
||||
=> 4)
|
||||
(test (run "{with {add3 {fun {x} {+ x 3}}}
|
||||
{with {add1 {fun {x} {+ x 1}}}
|
||||
{with {x 3}
|
||||
{call add1 {call add3 x}}}}}")
|
||||
=> 7)
|
||||
(test (run "{with {identity {fun {x} x}}
|
||||
{with {foo {fun {x} {+ x 1}}}
|
||||
{call {call identity foo} 123}}}")
|
||||
=> 124)
|
||||
(test (run "{with {x 3}
|
||||
{with {f {fun {y} {+ x y}}}
|
||||
{with {x 5}
|
||||
{call f 4}}}}")
|
||||
=> 7)
|
||||
(test (run "{call {call {fun {x} {call x 1}}
|
||||
{fun {x} {fun {y} {+ x y}}}}
|
||||
123}")
|
||||
=> 124)
|
||||
|#)
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
(module slow "../../typed-scheme.ss"
|
||||
(require "../../CSU660/datatype.ss")
|
||||
|
||||
(define-type BINTREE
|
||||
[Node (l BINTREE) (r BINTREE)]
|
||||
[Leaf (n number)]
|
||||
[Q ]
|
||||
[Q1 ]
|
||||
[Q2 ]
|
||||
[Q3 ]
|
||||
[Q4 ]
|
||||
[Q5 ]
|
||||
|
||||
)
|
||||
|
||||
(cases (Leaf 1)
|
||||
[(Node (Node (Node (Node (Node zz z) x) a) e) b) a]
|
||||
[(Node a b) a]
|
||||
[(Q) 1]
|
||||
[(Q1) 1]
|
||||
[(Q2) 1]
|
||||
[(Q3) 1]
|
||||
[(Q4) 1]
|
||||
[(Q5) 1]
|
||||
[(Leaf l) l]))
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
(module support "../../typed-scheme.ss"
|
||||
(require (for-syntax scheme/base))
|
||||
(provide sqr test first second third fourth string->sexpr rest foldl)
|
||||
|
||||
(define: (sqr [a : number]) : number (* a a))
|
||||
|
||||
(define-type-alias SExp (mu s (Un Number Boolean String Symbol (Listof s))))
|
||||
|
||||
(define-syntax (test stx) #'#f)
|
||||
(pdefine: (a) (first [x : (Listof a)]) : a (car x))
|
||||
(pdefine: (a) (second [x : (Listof a)]) : a (car (cdr x)))
|
||||
(pdefine: (a) (third [x : (Listof a)]) : a (car (cdr (cdr x))))
|
||||
(pdefine: (a) (fourth [x : (Listof a)]) : a (car (cdr (cdr (cdr x)))))
|
||||
(pdefine: (a) (rest [x : (Listof a)]) : (Listof a) (cdr x))
|
||||
(define: (string->sexpr [s : String]) : Sexp
|
||||
(read (open-input-string s)))
|
||||
|
||||
#;(define: (list-of [f : (Any -> Any)]) : Any
|
||||
(lambda: ([l : List]) (andmap f l)))
|
||||
|
||||
)
|
||||
Loading…
Reference in New Issue
Block a user