API tools faq
paste
Advertisement
VladNitu

CorrectLetRecC

VladNitu
Apr 18th, 2023
207
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 8.69 KB | None | 0 0
raw download clone embed print report
  1. import Library._
  2. import Untyped._
  3. import Parser._
  4.  
  5. case class NotImplementedException(s: String) extends RuntimeException(s)
  6. case class DesugarOpInvalidExcep(s: String) extends DesugarException(s)
  7. case class InterpOpInvalidExcep(s: String) extends InterpException(s)
  8.  
  9.  
  10.  
  11. object Desugar {
  12.  
  13. val ZCombinator =
  14. """
  15. (lambda (f)
  16. ((lambda (y)
  17. (y y))
  18. (lambda (z)
  19. (f (lambda (x)
  20. ((z z) x))))))
  21. """
  22.  
  23.  
  24. def desugarList (l: List[ExprExt]): ExprC = l match {
  25. case h :: t => ConsC(desugar(h), desugarList(t))
  26. case _ => NilC()
  27. }
  28.  
  29. def solveCondEExt(cs: List[(ExprExt, ExprExt)], e: ExprExt): ExprC = (cs, e) match {
  30. case ((e1, e2) :: t, e)=> IfC(desugar(e1), desugar(e2), solveCondEExt(t, e))
  31. case _ => desugar(e)
  32. }
  33.  
  34. def solveCondExt(cs: List[(ExprExt, ExprExt)]): ExprC = cs match {
  35. case (e1, e2) :: t => IfC(desugar(e1), desugar(e2), solveCondExt(t))
  36. case _ => UndefinedC()
  37. }
  38.  
  39. def desugar(e: ExprExt): ExprC = e match {
  40.  
  41. case NilExt() => NilC()
  42. case TrueExt() => TrueC()
  43. case FalseExt() => FalseC()
  44. case NumExt(x) => NumC(x)
  45. case BinOpExt(sym, l, r) => sym match {
  46. case "+" => PlusC(desugar(l), desugar(r))
  47. case "*" => MultC(desugar(l), desugar(r))
  48. case "-" => PlusC(desugar(l), MultC(NumC(-1), desugar(r))) // l - r
  49.  
  50.  
  51. // TODO: Check AND FALSE, OR TRUE logic
  52. case "and" => IfC(desugar(l), desugar(r), FalseC()) // OR (for a strictly-typed language): IfC(desugar(l), desugar(r), FalseC())
  53. case "or" => IfC(desugar(l), desugar(l), desugar(r)) // OR (for a strictly-typed language): IfC(desugar(l), TrueC(), desugar(r))
  54.  
  55. case "num=" => EqNumC(desugar(l), desugar(r))
  56. case "num<" => LtC(desugar(l), desugar(r))
  57. case "num>" => LtC(desugar(r), desugar(l)) // (l > r) <=> (r < l)
  58. case "cons" => ConsC(desugar(l), desugar(r))
  59.  
  60. case _ => throw new DesugarOpInvalidExcep("Cannot desugarize this binary operator: " + sym);
  61. }
  62.  
  63. case UnOpExt(sym, l) => sym match {
  64. case "-" => MultC(NumC(-1), desugar(l))
  65. case "not" => IfC(desugar(l), FalseC(), TrueC())
  66. case "head" => HeadC(desugar(l))
  67. case "tail" => TailC(desugar(l))
  68. case "is-nil" => IsNilC(desugar(l))
  69. case "is-list" => IsListC(desugar(l))
  70.  
  71. // NEW
  72. case "print" => PrintC(desugar(l))
  73. case "force" => ForceC(desugar(l))
  74.  
  75. case _ => throw new DesugarOpInvalidExcep("Cannot desugarize this unary operator: " + sym);
  76. }
  77. case ListExt(l) => l match { // Alternative: ConsC(desugar(h), desugar(ListExt(t))) // !!: generative recursion;
  78. case h :: t => desugarList(l)
  79. case _ => NilC()
  80. }
  81.  
  82. case IfExt(c, t, e) => IfC(desugar(c), desugar(t), desugar(e))
  83.  
  84. case CondExt(cs) => solveCondExt(cs)
  85.  
  86. case CondEExt(cs, e) => solveCondEExt(cs, e)
  87.  
  88. // Newly added
  89.  
  90. case AppExt(f, args) => AppC(desugar(f), args.map(arg => desugar(arg)))
  91.  
  92. case IdExt(c) => IdC(c)
  93.  
  94. case FdExt(params, body) => FdC(params, desugar(body))
  95.  
  96. // LetExt should be desugared into AppC
  97. case LetExt(binds, body) => AppC(
  98. FdC(binds.map(bind => bind.name), desugar(body)),
  99. binds.map(bind => desugar(bind.value)) // List[ExprExt]
  100. )
  101.  
  102. // Make use of Z_Combinator from Lecture Notes (!);
  103. // 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
  104. case RecLamExt(name, param, body) => AppC (
  105. desugar(parse(ZCombinator)),
  106. List(FdC(List(name), FdC(List(param), desugar(body))))
  107. )
  108.  
  109. // NEW
  110. case LetRecExt(binds, body) => LetRecC(binds.map(bind => LetBindC(bind.name, desugar(bind.value))), desugar(body))
  111.  
  112. }
  113. }
  114.  
  115. object Interp {
  116. def interp(e: ExprC): Value = interp(e, Nil)
  117. def take(myEnv: Environment, name: String): Value = myEnv match {
  118. case Nil => throw new InterpOpInvalidExcep(s"Could not find $name in environment `nv`")
  119. case Bind(name_, value) :: t if name_ == name => value
  120. case Bind(name_, value) :: t => take(t, name)
  121. }
  122.  
  123. def produceOutput(v: Value): Unit = v match {
  124. case NumV(n) => print(n.toString)
  125. case BoolV(b) => print(b.toString)
  126. case NilV() => print("[]")
  127. case ConsV(hd, tl) => {
  128. print("[")
  129. produceOutput(strict(hd))
  130. print(" ")
  131. produceOutput(strict(tl))
  132. print("]")
  133. }
  134. case ClosV(_, _) => print("<closure>")
  135. case UninitializedV() => print("<uninitialized>")
  136.  
  137. }
  138.  
  139.  
  140. def interp(e: ExprC, nv: Environment): Value = e match {
  141.  
  142. case NilC() => NilV()
  143. case TrueC() => BoolV(true)
  144. case FalseC() => BoolV(false)
  145. case NumC(x) => NumV(x)
  146.  
  147. case PlusC(l, r) => (strict(interp(l, nv)), strict(interp(r, nv))) match {
  148. case (NumV(a), NumV(b)) => NumV(a + b)
  149. case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
  150. }
  151.  
  152. case MultC(l, r) => (strict(interp(l, nv)), strict(interp(r, nv))) match {
  153. case (NumV(a), NumV(b)) => NumV(a * b)
  154. case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
  155. }
  156.  
  157. case EqNumC(l, r) => (strict(interp(l, nv)), strict(interp(r, nv))) match {
  158. case (NumV(a), NumV(b)) => if (a == b) BoolV(true) else BoolV(false)
  159. case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
  160. }
  161.  
  162. case LtC(l, r) => (strict(interp(l, nv)), strict(interp(r, nv))) match {
  163. case (NumV(a), NumV(b)) => if (a < b) BoolV(true) else BoolV(false)
  164. case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
  165. }
  166.  
  167.  
  168. case ConsC(l, r) => ConsV(ThunkV(Left(l, nv)), ThunkV(Left(r, nv)))
  169.  
  170. case HeadC(e) => strict(interp(e, nv)) match {
  171. case ConsV(h, _) => h
  172. case x => throw new InterpOpInvalidExcep(s"HEAD not allowed: $x")
  173. }
  174.  
  175. case TailC(e) => strict(interp(e, nv)) match {
  176. case ConsV(_, t) => t
  177. case _ => throw new InterpOpInvalidExcep("TAIL not allowed")
  178. }
  179.  
  180. case IsNilC(e) => strict(interp(e, nv)) match {
  181. case NilV() => BoolV(true)
  182. case ConsV(_, _) => BoolV(false)
  183. case _ => throw new InterpOpInvalidExcep("IS_NIL not allowed")
  184. }
  185.  
  186. case IsListC(e) => strict(interp(e, nv)) match {
  187. case NilV() | ConsV(_, _) => BoolV(true)
  188. case _ => BoolV(false)
  189. }
  190.  
  191. case IfC(e, e1, e2) => strict(interp(e, nv)) match {
  192. case BoolV(true) => interp(e1, nv)
  193. case BoolV(false) => interp(e2, nv)
  194. case _ => throw new InterpOpInvalidExcep("IF not allowed as _e_ does not evaluate to Boolean")
  195. }
  196.  
  197. // NEW
  198.  
  199. case PrintC(e) =>
  200. val v = strict(interp(e, nv))
  201. produceOutput(v)
  202. println()
  203. v
  204.  
  205. case ForceC(e) => force(interp(e, nv))
  206.  
  207. case LetRecC(binds, body) =>
  208. val bindsLetRec = binds.map(bnd => Bind(bnd.name, UninitializedV()))
  209. val bindsThunked = binds.map(bnd => ThunkV(Left((bnd.value, bindsLetRec ::: nv))))
  210.  
  211. bindsLetRec.zip(bindsThunked) // (Bind, ThunkV(Left(...)))
  212. .map(x => x._1.value = x._2)
  213.  
  214. interp(body, bindsLetRec ::: nv)
  215.  
  216. case UndefinedC() => throw new InterpOpInvalidExcep("Desugarizing went wrong!")
  217.  
  218.  
  219. // Newly added
  220.  
  221. // See notes (3) Interp AppC
  222. // match on the interpreted value of (f, nv)
  223. case AppC(f: ExprC, args: List[ExprC]) => strict(interp(f, nv)) match {
  224. 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)
  225. val thunkedArgs = args.map(arg => ThunkV(Left((arg, nv))))
  226. val newEnv = params.zip(thunkedArgs).map(x => Bind(x._1, x._2)) ::: nv_clos
  227. interp(body, newEnv)
  228.  
  229. }
  230.  
  231. case _ => throw new InterpOpInvalidExcep("Error thrown in case AppC - `f` IS NOT a closure")
  232. }
  233.  
  234. case IdC(c) => take(nv, c)
  235.  
  236. case fdc@FdC(params, body) => ClosV(fdc, nv) // Use `named patterns`
  237.  
  238. case _ => throw new UnknownInstructionInterpException(e)
  239.  
  240. }
  241.  
  242.  
  243. def strict(v: Value): Value = v match {
  244.  
  245. case thk@ThunkV(Left((e, nv))) =>
  246. val ans = strict(interp(e, nv))
  247. thk.value = Right(ans)
  248. ans
  249.  
  250. case ThunkV(Right(eval)) => eval
  251.  
  252. case _ => v
  253. }
  254.  
  255. def force(v: Value): Value = v match {
  256. case thk@ThunkV(Left((e, nv))) => {
  257. val ans = force(interp(e, nv))
  258. thk.value = Right(ans)
  259. ans
  260. }
  261. case ThunkV(Right(eval)) => force(eval)
  262. case ConsV(hd, tl) => ConsV(force(hd), force(tl))
  263. case x => x
  264. }
  265. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!