Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- import Library._
- import Untyped._
- import Parser._
- case class NotImplementedException(s: String) extends RuntimeException(s)
- case class DesugarOpInvalidExcep(s: String) extends DesugarException(s)
- case class InterpOpInvalidExcep(s: String) extends InterpException(s)
- object Desugar {
- val ZCombinator =
- """
- (lambda (f)
- ((lambda (y)
- (y y))
- (lambda (z)
- (f (lambda (x)
- ((z z) x))))))
- """
- def desugarList (l: List[ExprExt]): ExprC = l match {
- case h :: t => ConsC(desugar(h), desugarList(t))
- case _ => NilC()
- }
- def solveCondEExt(cs: List[(ExprExt, ExprExt)], e: ExprExt): ExprC = (cs, e) match {
- case ((e1, e2) :: t, e)=> IfC(desugar(e1), desugar(e2), solveCondEExt(t, e))
- case _ => desugar(e)
- }
- def solveCondExt(cs: List[(ExprExt, ExprExt)]): ExprC = cs match {
- case (e1, e2) :: t => IfC(desugar(e1), desugar(e2), solveCondExt(t))
- case _ => UndefinedC()
- }
- def desugar(e: ExprExt): ExprC = e match {
- case NilExt() => NilC()
- case TrueExt() => TrueC()
- case FalseExt() => FalseC()
- case NumExt(x) => NumC(x)
- case BinOpExt(sym, l, r) => sym match {
- case "+" => PlusC(desugar(l), desugar(r))
- case "*" => MultC(desugar(l), desugar(r))
- case "-" => PlusC(desugar(l), MultC(NumC(-1), desugar(r))) // l - r
- // TODO: Check AND FALSE, OR TRUE logic
- case "and" => IfC(desugar(l), desugar(r), FalseC()) // OR (for a strictly-typed language): IfC(desugar(l), desugar(r), FalseC())
- case "or" => IfC(desugar(l), desugar(l), desugar(r)) // OR (for a strictly-typed language): IfC(desugar(l), TrueC(), desugar(r))
- case "num=" => EqNumC(desugar(l), desugar(r))
- case "num<" => LtC(desugar(l), desugar(r))
- case "num>" => LtC(desugar(r), desugar(l)) // (l > r) <=> (r < l)
- case "cons" => ConsC(desugar(l), desugar(r))
- case _ => throw new DesugarOpInvalidExcep("Cannot desugarize this binary operator: " + sym);
- }
- case UnOpExt(sym, l) => sym match {
- case "-" => MultC(NumC(-1), desugar(l))
- case "not" => IfC(desugar(l), FalseC(), TrueC())
- case "head" => HeadC(desugar(l))
- case "tail" => TailC(desugar(l))
- case "is-nil" => IsNilC(desugar(l))
- case "is-list" => IsListC(desugar(l))
- // NEW
- case "print" => PrintC(desugar(l))
- case "force" => ForceC(desugar(l))
- case _ => throw new DesugarOpInvalidExcep("Cannot desugarize this unary operator: " + sym);
- }
- case ListExt(l) => l match { // Alternative: ConsC(desugar(h), desugar(ListExt(t))) // !!: generative recursion;
- case h :: t => desugarList(l)
- case _ => NilC()
- }
- case IfExt(c, t, e) => IfC(desugar(c), desugar(t), desugar(e))
- case CondExt(cs) => solveCondExt(cs)
- case CondEExt(cs, e) => solveCondEExt(cs, e)
- // Newly added
- case AppExt(f, args) => AppC(desugar(f), args.map(arg => desugar(arg)))
- case IdExt(c) => IdC(c)
- case FdExt(params, body) => FdC(params, desugar(body))
- // LetExt should be desugared into AppC
- case LetExt(binds, body) => AppC(
- FdC(binds.map(bind => bind.name), desugar(body)),
- binds.map(bind => desugar(bind.value)) // List[ExprExt]
- )
- // Make use of Z_Combinator from Lecture Notes (!);
- // Desugar RecLamExt as a AppC(ZComb, FdC(name, FdC(param), body)) <=> Application of ZComb function that takes as a parameter the body of actual function
- case RecLamExt(name, param, body) => AppC (
- desugar(parse(ZCombinator)),
- List(FdC(List(name), FdC(List(param), desugar(body))))
- )
- // NEW
- case LetRecExt(binds, body) => LetRecC(binds.map(bind => LetBindC(bind.name, desugar(bind.value))), desugar(body))
- }
- }
- object Interp {
- def interp(e: ExprC): Value = interp(e, Nil)
- def take(myEnv: Environment, name: String): Value = myEnv match {
- case Nil => throw new InterpOpInvalidExcep(s"Could not find $name in environment `nv`")
- case Bind(name_, value) :: t if name_ == name => value
- case Bind(name_, value) :: t => take(t, name)
- }
- def produceOutput(v: Value): Unit = v match {
- case NumV(n) => print(n.toString)
- case BoolV(b) => print(b.toString)
- case NilV() => print("[]")
- case ConsV(hd, tl) => {
- print("[")
- produceOutput(strict(hd))
- print(" ")
- produceOutput(strict(tl))
- print("]")
- }
- case ClosV(_, _) => print("<closure>")
- case UninitializedV() => print("<uninitialized>")
- }
- def interp(e: ExprC, nv: Environment): Value = e match {
- case NilC() => NilV()
- case TrueC() => BoolV(true)
- case FalseC() => BoolV(false)
- case NumC(x) => NumV(x)
- case PlusC(l, r) => (strict(interp(l, nv)), strict(interp(r, nv))) match {
- case (NumV(a), NumV(b)) => NumV(a + b)
- case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
- }
- case MultC(l, r) => (strict(interp(l, nv)), strict(interp(r, nv))) match {
- case (NumV(a), NumV(b)) => NumV(a * b)
- case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
- }
- case EqNumC(l, r) => (strict(interp(l, nv)), strict(interp(r, nv))) match {
- case (NumV(a), NumV(b)) => if (a == b) BoolV(true) else BoolV(false)
- case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
- }
- case LtC(l, r) => (strict(interp(l, nv)), strict(interp(r, nv))) match {
- case (NumV(a), NumV(b)) => if (a < b) BoolV(true) else BoolV(false)
- case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
- }
- case ConsC(l, r) => ConsV(ThunkV(Left(l, nv)), ThunkV(Left(r, nv)))
- case HeadC(e) => strict(interp(e, nv)) match {
- case ConsV(h, _) => h
- case x => throw new InterpOpInvalidExcep(s"HEAD not allowed: $x")
- }
- case TailC(e) => strict(interp(e, nv)) match {
- case ConsV(_, t) => t
- case _ => throw new InterpOpInvalidExcep("TAIL not allowed")
- }
- case IsNilC(e) => strict(interp(e, nv)) match {
- case NilV() => BoolV(true)
- case ConsV(_, _) => BoolV(false)
- case _ => throw new InterpOpInvalidExcep("IS_NIL not allowed")
- }
- case IsListC(e) => strict(interp(e, nv)) match {
- case NilV() | ConsV(_, _) => BoolV(true)
- case _ => BoolV(false)
- }
- case IfC(e, e1, e2) => strict(interp(e, nv)) match {
- case BoolV(true) => interp(e1, nv)
- case BoolV(false) => interp(e2, nv)
- case _ => throw new InterpOpInvalidExcep("IF not allowed as _e_ does not evaluate to Boolean")
- }
- // NEW
- case PrintC(e) =>
- val v = strict(interp(e, nv))
- produceOutput(v)
- println()
- v
- case ForceC(e) => force(interp(e, nv))
- case LetRecC(binds, body) =>
- val bindsLetRec = binds.map(bnd => Bind(bnd.name, UninitializedV()))
- val bindsThunked = binds.map(bnd => ThunkV(Left((bnd.value, bindsLetRec ::: nv))))
- bindsLetRec.zip(bindsThunked) // (Bind, ThunkV(Left(...)))
- .map(x => x._1.value = x._2)
- interp(body, bindsLetRec ::: nv)
- case UndefinedC() => throw new InterpOpInvalidExcep("Desugarizing went wrong!")
- // Newly added
- // See notes (3) Interp AppC
- // match on the interpreted value of (f, nv)
- case AppC(f: ExprC, args: List[ExprC]) => strict(interp(f, nv)) match {
- case ClosV(FdC(params, body), nv_clos) if params.size == args.size => { // NOTE!: `f` param. from ClosV shadows `f` param from case AppC(f:ExprC)
- val thunkedArgs = args.map(arg => ThunkV(Left((arg, nv))))
- val newEnv = params.zip(thunkedArgs).map(x => Bind(x._1, x._2)) ::: nv_clos
- interp(body, newEnv)
- }
- case _ => throw new InterpOpInvalidExcep("Error thrown in case AppC - `f` IS NOT a closure")
- }
- case IdC(c) => take(nv, c)
- case fdc@FdC(params, body) => ClosV(fdc, nv) // Use `named patterns`
- case _ => throw new UnknownInstructionInterpException(e)
- }
- def strict(v: Value): Value = v match {
- case thk@ThunkV(Left((e, nv))) =>
- val ans = strict(interp(e, nv))
- thk.value = Right(ans)
- ans
- case ThunkV(Right(eval)) => eval
- case _ => v
- }
- def force(v: Value): Value = v match {
- case thk@ThunkV(Left((e, nv))) => {
- val ans = force(interp(e, nv))
- thk.value = Right(ans)
- ans
- }
- case ThunkV(Right(eval)) => force(eval)
- case ConsV(hd, tl) => ConsV(force(hd), force(tl))
- case x => x
- }
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement