### A3. TYPES ### #| 0. Write your name and OU ID (the part before the "@" in your email address) below: NAME: ID: |# #| In this assignment, you'll be (EXERCISEs I-III) extending your parser, interpreter, and type-checker from the previous assignment to support products and sums (case analysis). The new language features in this assignment (pair, fst, snd, inl, inr, case) are marked as "NEW" in the BNF grammar below. We've discussed products (pairs) and sums in class a bit (earlier in the semester when we discussed algebraic data types) but here's a quick recap: Products / Pairs ================ Products, or pairs, are ordered tuples of variables like {1; 2} or {false; 3}. One accesses the elements of a pair using operations: fst :: {A;B} -> A //get the first element of the pair snd :: {A;B} -> B //get the second element You create pairs in Pyret simply by writing {x; y} for the pair containing x and y. We'll write this as (pair x y). So pair has the type: pair :: A -> B -> {A;B} //or (prod A B) below in our syntax Sums ==== A (sum A B) is an expression that's either an A or a B. Sums are created using the following operations: inl :: A -> (sum A B) //turn an A into an "A or B" inr :: B -> (sum A B) //turn a B into an "A or B" If you're given a value that's either an A or a B, you can do case analysis on it to figure out which it is. For example, (let s (inl bool 3) //x has type (sum num bool) (case s (inl x (+ x 1)) (inr y 0))) has type num because the case expression returns a number whether s is a num or a bool. Note that (inl bool 3) contains a *type annotation*: the "bool" indicates that the type of the right-hand side of the sum is bool -- so (inl bool 3) overall has type (sum nat bool). Here's the general typing rule for case: set-ty(G, x, t1) |- e1 : t set-ty(G, y, t2) |- e2 : t G |- e : (sum t1 t2) ------------------------------------ ty-case NEW G |- (case e (inl x e1) (inr y e2)) : t The overall type is t assuming both branches of the case analysis have type t. Note that e1 and e2 get to assume that they've been given values (x and y respectively) that have types t1 and t2, assuming e has type (sum t1 t2). SYNTAX ====== Unary Operators u ::== neg #negate a number (not a boolean) Binary Operators b ::== + #add two numbers | - #subtract two numbers | * #multiply two numbers | / #divide two numbers | and #boolean conjunction | or #boolean disjunction Values: v ::== true | false | n #a number (one or more integers in the range [0-9]) | clos(env, x, e) #closures. Your parser DOES NOT need to parse closures -- they're created and manipulated only in your interpreter. | loc(l) #locations (aka. pointers). Your parser DOES NOT need to parse location values -- they're created and manipulated only in your interpreter. | () #the unit value #NOTE: Your parser DOES NOT need to parse inl, inr, or pair values (you must, however, parse inl, inr, and pair expressions -- see the new expression types below). | inl v1 #NEW: see description of inl expression | inr v2 #NEW: see description of inr expression | (pair v1 v2) #NEW: pair of values (v1, v2) Types: t ::== bool | num | (-> t1 t2) #the type of functions mapping t1's to t2's | (array t) #the type of arrays of t's | unit #the type of side-effecting operations like 'set' | (prod t1 t2) #NEW: the type of pairs of t1's and t2's | (sum t1 t2) #NEW: the type of values that are either a t1 or a t2 Expressions: e ::== v #a value | x #an identifier | (u e) #unary op u applied to expression e | (b e1 e2) #binary op b applies to e1, e2 | (cond e1 e2 e3) #if e1 then e2, else e3 | (let x e2 e3) #let x = the value of e2 in e3 (in which x may appear) | (lam x t e) #anonymous functions ("lambdas") with bound variable x of type t and body e | (e1 e2) #application of expression e1 (itself evaluating to a function if the program is well-typed) to argument e2 | (alloc einit) #allocate a box initialized to contain the result of einit in each cell | (set eloc e) #update box eloc to contain value enew | (get eloc) #dereference box eloc | (seq e1 e2) #do e1 then e2 | (pair e1 e2) #NEW: create the pair (e1, e2) | (fst e) #NEW: project the first element of pair e | (snd e) #NEW: project the second element of pair e | (inl t2 e1) #NEW: create a value of type (+ t1 t2) assuming e1 has type t1 | (inr t1 e2) #NEW: create a value of type (+ t1 t2) assuming e2 has type t2 | (case e (inl x e1) (inr y e2)) #NEW: do case analysis on e, executing e1 with x = v1 if e evaluates to inl t2 v1 or e2 with y = v2 if e evaluates to inr t1 v2 For example, here's a valid Grumpy0 program, in concrete syntax: (let x 3 (let y 4 (+ x y))) As you might expect, this program evaluates to 7. Here's a slightly more complicated program that uses the new anonymous function feature you're adding in this assignment: (let twice (lam x num (+ x x)) (twice 2)) This program should evaluate to 4. |# ########## PARSER COMBINATOR LIBRARY ########### #NOTE: Unfortunately, we can't put this code in a library because there's no easy way in Pyret to import all library functions without using a qualified name like P.. #The "unit" type with just a single constructor data Unit: | tt end #The type of possibly erroring computations data Error: | Ok(t :: T) | Err(msg :: String) end #The primary parser type parameterized by # State: the type of states manipulated by the parser (usually = String) # T: the parser's return type data Parser: | mkParser(f :: (State -> {State; Error})) end #Run a parser in a given initial state. fun run-parser(p :: Parser, init :: State) -> {State; Error}: cases(Parser) p: | mkParser(f) => f(init) end end #Lift a value t to a parser that returns t. fun ret(t :: T) -> Parser: mkParser(lam(s): {s; Ok(t)} end) end #Compose a parser p with a function that, given p's return result, produces a second parser. fun bind(p :: Parser, f :: (A -> Parser)) -> Parser: mkParser( lam(s): {intermediate-s; r} = run-parser(p, s) cases(Error) r: | Ok(a) => run-parser(f(a), intermediate-s) | Err(msg) => {intermediate-s; Err(msg)} end end) end #The parser that immediately raises an error fun signal(msg :: String) -> Parser: mkParser(lam(s): {s; Err(msg)} end) end #The parser that returns the current state fun get() -> Parser: mkParser(lam(s): {s; Ok(s)} end) end #Set the current state to some value s fun set-state(s :: State) -> Parser: mkParser(lam(_): {s; Ok(tt)} end) end #Drop the first n characters of the input string, #returning value t. fun drop(n :: Number) -> Parser: if n < 0: signal("drop: n < 0") else: mkParser(lam(s): if n > string-length(s): {s; Err("drop: not enough chars")} else: {string-substring(s, n, string-length(s)); Ok(tt)} end end) end end #Parse a prefix of the input string, failing if the prefix #doesn't equal k fun string(k :: String) -> Parser: bind(get(), lam(s): if string-length(s) < string-length(k): signal("string: not enough chars") else: if string-substring(s, 0, string-length(k)) == k: drop(string-length(k)) else: signal("string: no match") end end end) end #Do two parsers p1 and p2 in sequence, feeding p1's output #state into p2 as p2's input state fun seq(p1 :: Parser, p2 :: Parser) -> Parser: bind(p1, lam(_): p2 end) end #Try p1 then p2 (if p1 fails) fun either(p1 :: Parser, p2 :: Parser) -> Parser: mkParser( lam(s): {new-s; r} = run-parser(p1, s) cases(Error) r: | Ok(t1) => {new-s; Ok(t1)} | Err(msg) => run-parser(p2, s) end end) end #Parse the empty string fun epsilon() -> Parser: string("") end #The parser that always succeeds fun succeed() -> Parser: mkParser(lam(s): {s; Ok(tt)} end) end #Do p zero or more times fun star(p :: Parser) -> Parser: either(bind(p, lam(_): star(p) end), succeed()) end #Do p one or more times fun plus(p :: Parser) -> Parser: seq(p, star(p)) end #Parse a series of spaces fun spaces() -> Parser: star(string(" ")) end #Parse a string k padded with spaces fun keyword(k :: String) -> Parser: seq(spaces(), seq(string(k), spaces())) end #Parse p but with an open and close paren first and last fun parens(p :: Parser) -> Parser: seq(keyword("("), bind(p, lam(t): seq(keyword(")"), ret(t)) end)) end fun take-while(f :: (A -> Boolean), l :: List) -> List: cases(List) l: | empty => empty | link(x, rest) => if f(x): link(x, take-while(f, rest)) else: empty end end end fun drop-while(f :: (A -> Boolean), l :: List) -> List: cases(List) l: | empty => empty | link(x, rest) => if f(x): drop-while(f, rest) else: link(x, rest) end end end fun is-ascii(i :: Number) -> Boolean: ((65 <= i) and (i <= 90)) or ((97 <= i) and (i <= 122)) end fun is-numeric(i :: Number) -> Boolean: (48 <= i) and (i <= 57) end #Return the longest sequence of characters (from the beginning) satisfying a predicate `f`, removing the sequence from the input string. # #Returns an error if the longest such sequence has length 0. fun eat(f :: (Number -> Boolean)) -> Parser: bind(get(), lam(s): points = string-to-code-points(s) ok-chars = take-while(f, points) if ok-chars.length() > 0: seq(set-state(string-from-code-points(drop-while(f, points))), ret(string-from-code-points(ok-chars))) else: signal("eat: no valid string") end end) end #Return the longest sequence of ASCII alphabetic characters from the beginning of the string fun alphas() -> Parser: eat(is-ascii) end #Return the longest sequence of ASCII numeric [0-9] characters from the beginning of the string fun numerics() -> Parser: eat(is-numeric) end #| ####### EXERCISE I ####### In the first part of the assignment, your job is to extend your `parse` program from the previous assignment to deal with the syntax constructors marked as "NEW" above. This exercise builds on the previous exercise (A4). If you feel unconfident in your previous solution, you may request from the TA a working version of just the `parse` portion of the assignment for a penalty of -0.5 points on this assignment. |# #| States (a.k.a. environments) |# type State = (String -> Error) init-state = lam(x :: String): Err(string-append(x, " is unbound")) end fun lookup(s :: State, x :: String) -> Error: s(x) end fun upd(s :: State, x :: String, new-val :: Val) -> State: lam(y :: String): if string-equal(x, y): Ok(new-val) else: s(y) end end end #| Memories mapping Locations (Numbers) to Errors |# type Loc = Number var loc-counter = 0 #Global fresh location counter fun init-locs(): loc-counter := 0 end fun fresh-loc() -> Loc: r = loc-counter block: loc-counter := loc-counter + 1 r end end type Mem = (Loc -> Error) init-mem = lam(l :: Loc): Err("unbound location") end fun get-mem(m :: Mem, l :: Loc) -> Error: m(l) end fun set-mem(m :: Mem, l :: Loc, new-val :: Val) -> Mem: lam(l2 :: Loc): if l == l2: Ok(new-val) else: m(l2) end end end #| Grumpy1 Abstract Syntax |# data Unop: | neg end data Binop: | add | sub | mul | div | conj | disj end data Ty: | tbool | tnum | tarr(t1 :: Ty, t2 :: Ty) | tloc(t :: Ty) | tunit | tpair(t1 :: Ty, t2 :: Ty) | tsum(t1 :: Ty, t2 :: Ty) end data Val: | num(n :: Number) | bool(b :: Boolean) | clos(env :: State, x :: String, e :: Exp) | loc(l :: Loc) | vunit | vinl(v1 :: Val) | vinr(v2 :: Val) | vpair(v1 :: Val, v2 :: Val) end data Exp: | val(v :: Val) | id(x :: String) | unexp(u :: Unop, e :: Exp) | binexp(b :: Binop, e1 :: Exp, e2 :: Exp) | cond(e1 :: Exp, e2 :: Exp, e3 :: Exp) | letx(x :: String, e1 :: Exp, e2 :: Exp) | lambda(x :: String, t :: Ty, e :: Exp) | app(e1 :: Exp, e2 :: Exp) | alloc(einit :: Exp) | eset(eloc :: Exp, e :: Exp) | eget(eloc :: Exp) | eseq(e1 :: Exp, e2 :: Exp) | pair(e1 :: Exp, e2 :: Exp) | fst(e :: Exp) | snd(e :: Exp) | inl(t2 :: Ty, e1 :: Exp) | inr(t1 :: Ty, e2 :: Exp) | ecase(e :: Exp, x :: String, e1 :: Exp, y :: String, e2 :: Exp) end fun exp() -> Parser: ... end ex1 = val(num(3)) ex2 = val(num(100)) ex3 = val(bool(true)) ex4 = val(bool(false)) ex5 = binexp(add, ex1, ex2) ex6 = binexp(sub, ex1, ex2) ex7 = binexp(mul, ex1, ex2) ex8 = binexp(div, ex1, ex2) ex9 = binexp(mul, ex8, ex8) ex10 = binexp(mul, ex7, ex5) ex11 = binexp(add, id("x"), id("y")) ex20 = unexp(neg, val(num(100))) ex21 = unexp(neg, (binexp(sub, val(num(5)), val(num(5))))) ex30 = letx("x", val(num(3)), id("x")) ex31 = letx("yzw", binexp(add, val(num(4)), id("x")), id("x")) ex32 = letx("x", binexp(add, val(num(4)), binexp(add, id("x"), id("x"))), binexp(mul, id("x"), id("y"))) ex40 = cond(val(bool(true)), val(num(3)), val(num(4))) ex41 = cond(val(bool(true)), id("x"), val(num(4))) ex50 = lambda("x", tnum, id("x")) ex51 = lambda("x", tbool, ex41) ex52 = lambda("x", tarr(tnum, tbool), id("x")) ex60 = app(ex50, val(num(3))) ex61 = app(ex51, val(bool(false))) ex62 = app(ex52, ex50) ex70 = alloc(val(num(30))) # : tloc tnum ex71 = alloc(ex70) # : tloc (tloc tnum) ex72 = alloc(ex71) # : tloc (tloc (tloc tnum)) ex80 = eset(alloc(val(num(1))), val(num(2))) # : tunit ex90 = eget(alloc(val(num(3)))) # : tnum ex91 = eget(ex80) # error; not well-typed ex100 = val(vunit) # : tunit ex110 = eseq(ex80, val(num(3))) # : tnum ex120 = pair(ex1, ex2) # = (pair 3 100) ex121 = fst(ex120) # = (fst (pair 3 100)) ex122 = snd(ex120) # = (snd (pair 3 100)) ex130 = inl(tbool, ex1)# = (inl bool 3) ex131 = inr(tbool, ex2)# = (inr bool 100) ex132 = ecase(ex130, "x", id("x"), "y", ex1) # = (case (inl bool 3) (inl x x) (inr y 3)) fun is-err(e :: Error) -> Boolean: cases(Error) e: | Ok(_) => false | Err(_) => true end end fun parse(s :: String) -> Error: {new-s; r} = run-parser(exp(), s) if new-s == "": r else: Err("error: " + new-s) end where: #values parse("3") is Ok(ex1) parse(" 3") is Ok(ex1) parse("3 ") is Ok(ex1) parse("100") is Ok(ex2) parse(" 100 ") is Ok(ex2) parse("true") is Ok(ex3) parse(" true") is Ok(ex3) parse("false ") is Ok(ex4) parse("FALSE") is Ok(id("FALSE")) parse("-x") satisfies is-err #binexps parse("(+ 3 100)") is Ok(ex5) parse("(- 3 100)") is Ok(ex6) parse("(* 3 100)") is Ok(ex7) parse("( * 3 100 )") is Ok(ex7) parse("(/ 3 100)") is Ok(ex8) parse("(* (/ 3 100) (/ 3 100))") is Ok(ex9) parse("(* (* 3 100) (+ 3 100))") is Ok(ex10) parse("( * ( *3 100) (+ 3 100 ))") is Ok(ex10) parse("(+ x y)") is Ok(ex11) parse("(plus 3 4)") satisfies is-err parse("(+ 3 4") satisfies is-err parse("(+ 3)") satisfies is-err #unexps parse("(neg 100)") is Ok(ex20) parse("(neg (- 5 5))") is Ok(ex21) parse("neg 5") satisfies is-err parse("(neg 5") satisfies is-err parse("(neg )") satisfies is-err #let expressions parse("(let x 3 x)") is Ok(ex30) parse("( let yzw (+ 4 x) x )") is Ok(ex31) parse(" ( let x (+ 4 (+ x x)) (*x y ) )") is Ok(ex32) parse("let x 3 4") satisfies is-err parse("(let x 3 4") satisfies is-err parse("(let x 4)") satisfies is-err #cond expressions parse("(cond true 3 4)") is Ok(ex40) parse("(cond true x 4)") is Ok(ex41) parse("(cond true x)") satisfies is-err #lambda expressions parse("(lam x num x)") is Ok(ex50) parse("(lam x bool (cond true x 4))") is Ok(ex51) parse("(lam x (-> num bool) x)") is Ok(ex52) parse("(lam x x)") satisfies is-err #applications expressions parse("( (lam x num x) 3 )") is Ok(ex60) parse("( (lam x bool (cond true x 4)) false )") is Ok(ex61) parse("( (lam x (-> num bool) x) (lam x num x) )") is Ok(ex62) #alloc, set, and get expressions parse("(alloc 30)") is Ok(ex70) parse("(alloc(alloc 30))") is Ok(ex71) parse("(alloc(alloc(alloc 30)))") is Ok(ex72) parse("(set (alloc 1) 2)") is Ok(ex80) parse("(get (alloc 3))") is Ok(ex90) parse("(get (set (alloc 1) 2))") is Ok(ex91) #the unit expression parse("()") is Ok(ex100) #sequence expressions parse("(seq (set (alloc 1) 2) 3)") is Ok(ex110) #pair expressions parse("(pair 3 100)") is Ok(ex120) parse("(fst (pair 3 100))") is Ok(ex121) parse("(snd (pair 3 100))") is Ok(ex122) #sum expressions parse("(inl bool 3)") is Ok(ex130) parse("(inr bool 100)") is Ok(ex131) parse("(case (inl bool 3) (inl x x) (inr y 3))") is Ok(ex132) end #| ####### EXERCISE II ####### Extend your `interp` function from the previous assignment to support products and sums as described in lecture. You can request a solution to the prior assignment's interp from the TA for a penalty on this assignment of -0.5 points. |# fun err-ret(t :: T) -> Error: Ok(t) end fun err-bind(m :: Error, f :: (A -> Error)) -> Error: cases(Error) m: | Ok(a) => f(a) | Err(msg) => Err(msg) end end fun signal-err(msg :: String) -> Error: Err(msg) end #NEW: the type of interpreters data Interp: | mkInterp(f :: (Mem, State -> Error<{Mem; T}>)) end #NEW: Run an interpreter on initial memory m and initial state s, returning either the final memory and a value or an error. fun run-interp(m :: Mem, s :: State, c :: Interp) -> Error<{Mem; A}>: cases(Interp) c: | mkInterp(f) => f(m, s) end end #NEW: The ret interpreter returns t, leaving memory m unchanged. fun interp-ret(t :: T) -> Interp: mkInterp(lam(m, s): Ok({m; t}) end) end #NEW: The bind interpreter operates a lot like the Parser bind, threading one interpreter into another. fun interp-bind(c :: Interp, f :: (A -> Interp)) -> Interp: mkInterp(lam(m, s): cases(Error) run-interp(m, s, c): | Ok(p) => {new-m; a} = p run-interp(new-m, s, f(a)) | Err(msg) => Err(msg) end end) end #NEW: signal an interpreter error fun interp-signal(msg :: String) -> Interp: mkInterp(lam(_, _): Err(msg) end) end #NEW: run c with new state snew fun with-state(snew :: State, c :: Interp) -> Interp: mkInterp(lam(m, s): run-interp(m, snew, c) end) end #NEW: run c with new assignment x equals v fun with-assignment(x :: String, v :: Val, c :: Interp) -> Interp: mkInterp(lam(m, s): run-interp(m, upd(s, x, v), c) end) end #NEW: get the value (if any) of identifier x fun read-id(x :: String) -> Interp: mkInterp(lam(m, s): cases(Error) lookup(s, x): | Ok(v) => Ok({m; v}) | Err(msg) => Err(msg) end end) end #NEW: access the current state fun read-state() -> Interp: mkInterp(lam(m, s): Ok({m; s}) end) end #NEW: access the current memory fun read-mem() -> Interp: mkInterp(lam(m, s): Ok({m; m}) end) end #NEW: modify the memory according to function f fun modify-mem(f :: (Mem -> Mem)) -> Interp: mkInterp(lam(m, s): Ok({f(m); vunit}) end) end #NEW: turn an Error into an Interp fun lift-err(e :: Error) -> Interp: mkInterp(lam(m, s): cases(Error) e: | Ok(t) => Ok({m; t}) | Err(msg) => Err(msg) end end) end fun interp(e :: Exp) -> Interp: ... end #run-interp-val: just like run-interp except that it returns just the val (throwing away the memory) fun run-interp-val(m :: Mem, s :: State, c :: Interp) -> Error: err-bind(run-interp(m, s, c), lam(p :: {Mem; Val}): {_; v} = p Ok(v) end) end fun run(s :: String) -> Error: err-bind(parse(s), lam(e): run-interp-val(init-mem, init-state, interp(e)) end) end fun is-closure(e :: Error) -> Boolean: cases(Error) e: | Ok(v) => cases(Val) v: | clos(_, y, e2) => true | else => false end | Err(_) => false end end # These tests provide evidence that your interpreter is working properly. check "interp(...)": run-interp-val(init-mem, init-state, interp(ex1)) is Ok(num(3)) run-interp-val(init-mem, init-state, interp(ex2)) is Ok(num(100)) run-interp-val(init-mem, init-state, interp(ex3)) is Ok(bool(true)) run-interp-val(init-mem, init-state, interp(ex4)) is Ok(bool(false)) run-interp-val(init-mem, init-state, interp(ex5)) is Ok(num(103)) run-interp-val(init-mem, init-state, interp(ex6)) is Ok(num(-97)) run-interp-val(init-mem, init-state, interp(ex7)) is Ok(num(300)) run-interp-val(init-mem, init-state, interp(ex8)) is Ok(num(0.03)) run-interp-val(init-mem, init-state, interp(ex9)) is Ok(num(0.0009)) run-interp-val(init-mem, init-state, interp(ex10)) is Ok(num(30900)) run-interp-val(init-mem, init-state, interp(ex11)) satisfies is-err run-interp-val(init-mem, init-state, interp(ex20)) is Ok(num(-100)) run-interp-val(init-mem, init-state, interp(ex21)) is Ok(num(0)) run-interp-val(init-mem, init-state, interp(ex30)) is Ok(num(3)) run-interp-val(init-mem, init-state, interp(ex31)) satisfies is-err run-interp-val(init-mem, init-state, interp(ex32)) satisfies is-err run-interp-val(init-mem, init-state, interp(ex40)) is Ok(num(3)) run-interp-val(init-mem, init-state, interp(ex41)) satisfies is-err run-interp-val(init-mem, init-state, interp(ex50)) satisfies is-closure run-interp-val(init-mem, init-state, interp(ex51)) satisfies is-closure run-interp-val(init-mem, init-state, interp(ex52)) satisfies is-closure run-interp-val(init-mem, init-state, interp(ex60)) is Ok(num(3)) run-interp-val(init-mem, init-state, interp(ex61)) is Ok(bool(false)) run-interp-val(init-mem, init-state, interp(ex62)) satisfies is-closure run-interp-val(init-mem, init-state, interp(ex90)) is Ok(num(3)) run-interp-val(init-mem, init-state, interp(ex91)) satisfies is-err run-interp-val(init-mem, init-state, interp(ex110)) is Ok(num(3)) #| New tests: ex120 = pair(ex1, ex2) # = (pair 3 100) ex121 = fst(ex120) # = (fst (pair 3 100)) ex122 = snd(ex120) # = (snd (pair 3 100)) ex130 = inl(tbool, ex1)# = (inl bool 3) ex131 = inr(tbool, ex2)# = (inr bool 100) ex132 = ecase(ex130, "x", id("x"), "y", ex1) # = (case (inl bool 3) (inl x x) (inr y 3)) |# run-interp-val(init-mem, init-state, interp(ex120)) is Ok(vpair(num(3), num(100))) run-interp-val(init-mem, init-state, interp(ex121)) is Ok(num(3)) run-interp-val(init-mem, init-state, interp(ex122)) is Ok(num(100)) run-interp-val(init-mem, init-state, interp(ex130)) is Ok(vinl(num(3))) run-interp-val(init-mem, init-state, interp(ex131)) is Ok(vinr(num(100))) run-interp-val(init-mem, init-state, interp(ex132)) is Ok(num(3)) end # These tests provide evidence that your parser and interpreter are both working properly. check "run(...)": run("3") is Ok(num(3)) run("true") is Ok(bool(true)) run("(* 3 4)") is Ok(num(12)) run("(let x 3 4)") is Ok(num(4)) run("(let x 3 (* x true))") satisfies is-err run("(4 * 5)") satisfies is-err run("(* true false)") satisfies is-err run("(and true false)") is Ok(bool(false)) run("(or (or true false) false)") is Ok(bool(true)) run("(let x 5 (* x x))") is Ok(num(25)) run("(LET x 5 (* x x))") satisfies is-err run("(let x 4 (let x 5 (* x x)))") is Ok(num(25)) run("(+ (let x 0 (+ x x)) 0)") is Ok(num(0)) run("(/ (let x 0 0) (let x 0 x))") satisfies is-err run("(let x (let x (+ 3 4) x) (* x x))") is Ok(num(49)) run("(* x 4)") satisfies is-err run("(let twice (lam x num (+ x x)) (twice 4))") is Ok(num(8)) #A4 tests: run("()") is Ok(vunit) run("(get (alloc 3))") is Ok(num(3)) run("(set (alloc 3) 4)") is Ok(vunit) run("(let l (alloc 3) (seq (set l 4) (get l)))") is Ok(num(4)) run("(let l (alloc 3) (seq (set l 4) (seq (set l (get l)) (get l))))") is Ok(num(4)) run("(let l (alloc 0) (seq (set l (+ (get l) 1)) (get l)))") is Ok(num(1)) #A5 tests: run("(let x (inl bool 3) (case x (inl x (+ x 1)) (inr y 3)))") is Ok(num(4)) end #| ####### EXERCISE III ####### Extend your `tycheck` function from the previous assignment to support the typing rules marked as "NEW" below. You may request a solution to the A3 `tycheck` function from the TA for a penalty of -0.5 points on this assignment. ------------------------------------ ty-bool G |- b : bool ^This rule is read: "In type context G, any boolean value b has type bool." ------------------------------------ ty-num G |- n : num ------------------------------------ ty-unit #NEW G |- () : tunit get-ty(G, x) = Ok(t) ------------------------------------ ty-id G |- x : t G |- e : num u \in {neg} ------------------------------------ ty-unop G |- (u e) : num G |- e1 : num G |- e2 : num b \in {+, -, *, /} ------------------------------------ ty-binop1 G |- (b e1 e2) : num G |- e1 : bool G |- e2 : bool b \in {and, or} ------------------------------------ ty-binop2 G |- (b e1 e2) : bool G |- e1 : bool G |- e2 : t G |- e3 : t ------------------------------------ ty-cond G |- (cond e1 e2 e3) : t G |- e1 : t1 set-ty(G, x, t1) |- e2 : t2 ------------------------------------ ty-let G |- (let x e1 e2) : t2 set-ty(G, x, t1) |- e : t ------------------------------------ ty-lam G |- (lam x t1 e) : (-> t1 t) G |- e1 : (-> t1 t2) G |- e2 : t1 ------------------------------------ ty-app G |- (e1 e2) : t2 G |- einit : t ------------------------------------ ty-alloc G |- (alloc einit) : tloc t G |- enew : t G |- eloc : tloc t ------------------------------------ ty-set G |- (set eloc enew) : tunit G |- eloc : tloc t ------------------------------------ ty-get G |- (get eloc) : t G |- e1 : tunit G |- e2 : t ------------------------------------ ty-seq G |- (seq e1 e2) : t G |- e1 : t1 G |- e2 : t2 ------------------------------------ ty-pair NEW G |- (pair e1 e2) : (prod t1 t2) G |- e : (prod t1 t2) ------------------------------------ ty-fst NEW G |- (fst e) : t1 G |- e : (prod t1 t2) ------------------------------------ ty-snd NEW G |- (snd e) : t2 G |- e1 : t1 ------------------------------------ ty-inl NEW G |- (inl t2 e1) : (sum t1 t2) G |- e2 : t2 ------------------------------------ ty-inr NEW G |- (inr t1 e2) : (sum t1 t2) set-ty(G, x, t1) |- e1 : t set-ty(G, y, t2) |- e2 : t G |- e : (sum t1 t2) ------------------------------------ ty-case NEW G |- (case e (inl x e1) (inr y e2)) : t |# #| Type Contexts |# type Ctx = (String -> Error) init-ctx = lam(x :: String): Err(string-append(x, " is unbound")) end fun get-ty(G :: Ctx, x :: String) -> Error: G(x) end fun set-ty(G :: Ctx, x :: String, t :: Ty) -> Ctx: lam(y :: String): if string-equal(x, y): Ok(t) else: G(y) end end end tycheck :: (Ctx, Exp -> Error) fun tycheck(G, e): ... end check "tycheck(...)": tycheck(init-ctx, ex1) is Ok(tnum) tycheck(init-ctx, ex2) is Ok(tnum) tycheck(init-ctx, ex3) is Ok(tbool) tycheck(init-ctx, ex4) is Ok(tbool) tycheck(init-ctx, ex5) is Ok(tnum) tycheck(init-ctx, ex6) is Ok(tnum) tycheck(init-ctx, ex7) is Ok(tnum) tycheck(init-ctx, ex8) is Ok(tnum) tycheck(init-ctx, ex9) is Ok(tnum) tycheck(init-ctx, ex10) is Ok(tnum) tycheck(init-ctx, ex11) satisfies is-err tycheck(init-ctx, ex20) is Ok(tnum) tycheck(init-ctx, ex21) is Ok(tnum) tycheck(init-ctx, ex30) is Ok(tnum) tycheck(init-ctx, ex31) satisfies is-err tycheck(init-ctx, ex32) satisfies is-err tycheck(init-ctx, ex40) is Ok(tnum) tycheck(init-ctx, ex41) satisfies is-err tycheck(init-ctx, ex50) is Ok(tarr(tnum, tnum)) tycheck(init-ctx, ex51) satisfies is-err tycheck(init-ctx, ex52) is Ok(tarr(tarr(tnum, tbool), tarr(tnum, tbool))) tycheck(init-ctx, ex60) is Ok(tnum) tycheck(init-ctx, ex61) satisfies is-err tycheck(init-ctx, ex62) satisfies is-err tycheck(init-ctx, ex70) is Ok(tloc(tnum)) tycheck(init-ctx, ex71) is Ok(tloc(tloc(tnum))) tycheck(init-ctx, ex72) is Ok(tloc(tloc(tloc(tnum)))) tycheck(init-ctx, ex80) is Ok(tunit) tycheck(init-ctx, ex90) is Ok(tnum) tycheck(init-ctx, ex91) satisfies is-err tycheck(init-ctx, ex100) is Ok(tunit) tycheck(init-ctx, ex110) is Ok(tnum) #| New tests: ex120 = pair(ex1, ex2) # = (pair 3 100) ex121 = fst(ex120) # = (fst (pair 3 100)) ex122 = snd(ex120) # = (snd (pair 3 100)) ex130 = inl(tbool, ex1)# = (inl bool 3) ex131 = inr(tbool, ex2)# = (inr bool 100) ex132 = ecase(ex130, "x", id("x"), "y", ex1) # = (case (inl bool 3) (inl x x) (inr y 3)) |# tycheck(init-ctx, ex120) is Ok(tpair(tnum,tnum)) tycheck(init-ctx, ex121) is Ok(tnum) tycheck(init-ctx, ex122) is Ok(tnum) tycheck(init-ctx, ex130) is Ok(tsum(tnum, tbool)) tycheck(init-ctx, ex131) is Ok(tsum(tbool, tnum)) tycheck(init-ctx, ex132) is Ok(tnum) end