ObjectVlad

import Library._
import Parser._
import Untyped._

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()
        }

        /** Binds all the values before processing the `body`, so that all the names are in scope */
        def solveLetBinds(binds: List[LetBindExt], body: ExprExt): ExprC = binds match {
        case LetBindExt(name, value) :: t => SeqC(SetC(name, desugar(value)), solveLetBinds(t, body))
        case Nil => desugar(body)  // No more bindings to declare
        }

        def desugarMethods(methods: List[MethodExt]): ExprC = methods match {
        case Nil => UndefinedC()
        case meth :: t => IfC(EqStrC(IdC("msg"), StringC(meth.name)), FdC("self" :: meth.args, desugar(meth.body)), desugarMethods(t))
        }

        def desugarMethodsDelegate(methods: List[MethodExt]): ExprC = methods match {
        case Nil => AppC(IdC("method"), List(IdC("msg")))
        case meth :: t => IfC(EqStrC(IdC("msg"), StringC(meth.name)), FdC("self" :: meth.args, desugar(meth.body)), desugarMethodsDelegate(t))
        }

        // OBJECTS

        def solveLetBindsObjects(binds: List[FieldExt], body: ExprC): ExprC = binds match {
        case FieldExt(name, value) :: t => SeqC(SetC(name, desugar(value)), solveLetBindsObjects(t, body))
        case Nil => body  // No more bindings to declare
        }

        def desugarDoSeq (l: List[ExprExt]): ExprC = l match {
        case h :: Nil => desugar(h)
        case h :: t :: Nil => SeqC(desugar(h), desugar(t))
        case h :: t => SeqC(desugar(h), desugarDoSeq(t))
        }

        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)))

        case "and" => IfC(desugar(l), desugar(r), FalseC())
        case "or" => IfC(desugar(l), TrueC(), desugar(r))

        case "num=" => EqNumC(desugar(l), desugar(r))
        case "num<" => LtC(desugar(l), desugar(r))
        case "num>" => LtC(MultC(NumC(-1), desugar(l)), MultC(NumC(-1), desugar(r))) // In interp, evaluate `l` first while also use `LtC` => Multiply eq. by (-1) on both sides
        case "cons" => ConsC(desugar(l), desugar(r))

        case "setbox" => SetboxC(desugar(l), desugar(r))
        case "seq" => SeqC(desugar(l), desugar(r))

        // NEW
        case "str=" => EqStrC(desugar(l), desugar(r))
        case "str++" => ConcStrC(desugar(l), desugar(r))


        case _ => throw new DesugarOpInvalidExcep(s"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))

        // Newly added unOps: `box`, `unbox`
        case "box" => BoxC(desugar(l))
        case "unbox" => UnboxC(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 AppExt(f, args) => AppC(desugar(f), args.map(arg => desugar(arg)))

        case IdExt(c) => IdC(c)

        case FdExt(params, body) => FdC(params, desugar(body))

        case LetExt(binds, body) => AppC(
        FdC(binds.map(bind => bind.name), desugar(body)),
        binds.map(bind => desugar(bind.value))
        )
        case SetExt(id, e) => SetC(id, desugar(e))

        // Make use of Z_Combinator from Lecture Notes (!);
        // Desugar RecLamExt as a AppC(ZComb, FdC(List(name), FdC(List(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))))
        )

        // Newly added: `LetRecExt`, which makes use of `LetBindExt`
        // Desugar `let-rec` into `AppC`; ALTERNATIVE - desugar `let-rec` into `let`, but this would imply generative recursion
        // 2 pass algorithm:
        // 1. Scan bindings; Create bindings for all names in `let-rec` w/ `UninitializedC`
        // 2. Rescan when evaluating (in interp) and update the bindings' values accordingly
        case LetRecExt(binds, body) => AppC(
        FdC(binds.map(bind => bind.name), solveLetBinds(binds, body)),
        binds.map(bind => UninitializedC()) // Allow `indirect recursion`
        )

        // NEW
        case StringExt(str) => StringC(str)

        case ObjectExt(fields: List[FieldExt], methods: List[MethodExt]) => {

        if (fields.size == 0) throw new DesugarOpInvalidExcep("Objects must have at least one filed")

        val body = FdC(List("msg"), desugarMethods(methods))

        AppC ( // LetRecExt desugar
        FdC(fields.map(bind => bind.name), solveLetBindsObjects(fields, body)),
        fields.map(bind => UninitializedC())
        )
        }


        case ObjectDelExt(del: ExprExt, fields: List[FieldExt], methods: List[MethodExt]) => {
        // IDEA: Parametrize all methods by `self`

        val delegate = desugar(del)

        val body = FdC(List("msg"), desugarMethodsDelegate(methods))

        AppC ( // LetRecExt desugar
        FdC("method" :: fields.map(bind => bind.name), solveLetBindsObjects(fields, body)),
        delegate :: fields.map(bind => UninitializedC())
        )

        }


        case MsgExt(recvr: ExprExt, msg: String, args: List[ExprExt]) => {
        val initBody = AppC(AppC(IdC("self"), List(StringC(msg))), IdC("self") :: args.map(desugar))
        AppC(FdC(List("self"), initBody), List(desugar(recvr)))
        }

        case DoSeqExt(expr: List[ExprExt]) => {
        // Parser ensures the following cond:
        //  if (expr.size < 1) throw new DesugarOpInvalidExcep("do-seq expressions should always have at least one subexpression")
        if (expr.size == 1)
        desugar(expr(0))
        else
        desugarDoSeq(expr)
        }


        }
        }

        object Interp {
        type Store = List[Cell]
        type PointerEnvironment = List[Pointer]

        // Do not remove this method. We use this for grading.
        def interp(e: ExprC): Value = interp(e, Nil, Nil)._1

        // Helper methods from assignment "Manipulating Stores"

        def lookup(name: String, nv: PointerEnvironment): Int = nv match {
        case Nil => throw new InterpOpInvalidExcep("Identifier not found")
        case Pointer(_name, location) :: t if _name == name => location
        case h :: t => lookup(name, t)
        }

        def update(loc: Int, st: Store, v: Value): Store = st match {
        case Nil => throw new InterpOpInvalidExcep("Cell location not found")
        case Cell(location, value) :: t if location == loc => Cell(loc, v) :: t
        case h :: t => h :: update(loc, t, v)
        }

        def fetch(loc: Int, st: Store): Value = st match {
        case Nil => throw new InterpOpInvalidExcep("Cell location not found")
        case Cell(location, value) :: t if location == loc => value
        case h :: t => fetch(loc, t)
        }

        def newLoc(store: Store): Int = store.length

        def extendStore(c: Cell, st: Store): Store = c :: st

        def interpArgs(args: List[ExprC], nv: PointerEnvironment, st1: Store): (List[Value], Store) = args match {
        case Nil => (Nil, st1) // base case -> Empty list in current environment; later on prepend to List[Value]s
        case arg :: t => {
        val (v, st2): (Value, Store) = interp(arg, nv, st1)
        val (values, st3) = interpArgs(t, nv, st2)
        (v :: values, st3)
        }
        }

        def extendEnvStore(params: List[String], interpretedArgs: List[Value], nv: PointerEnvironment, st1: Store): (PointerEnvironment, Store)
        =  (params, interpretedArgs) match { // REMEMBER: params.length == interpretedArgs.length
        case (Nil, Nil) => (nv, st1)
        case (param :: t_params, arg :: t_args) => {
        val newLocation = newLoc(st1)
        val newPointer: Pointer = Pointer(param, newLocation)
        val extendedNv: PointerEnvironment = newPointer :: nv
        val extendedStore: Store = extendStore(Cell(newLocation, arg), st1)// Extend store by prepending new values to previous Store
        extendEnvStore(t_params, t_args, extendedNv, extendedStore)
        }
        }

        def interp(e: ExprC, nv: PointerEnvironment, st1: Store): (Value, Store) = e match {

        case NilC() => (NilV(), st1)
        case TrueC() => (BoolV(true), st1)
        case FalseC() => (BoolV(false), st1)
        case NumC(x) => (NumV(x), st1)

        case PlusC(l, r) => {

        val (v1, st2) = interp(l, nv, st1)
        val (v2, st3) = interp(r, nv, st2)

        (v1, v2) match {
        case (NumV(a), NumV(b)) => (NumV(a + b), st3)
        case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
        }
        }

        case MultC(l, r) => {

        val (v1, st2) = interp(l, nv, st1)
        val (v2, st3) = interp(r, nv, st2)

        (v1, v2) match {
        case (NumV(a), NumV(b)) => (NumV(a * b), st3)
        case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
        }
        }

        case EqNumC(l, r) => {

        val (v1, st2) = interp(l, nv, st1)
        val (v2, st3) = interp(r, nv, st2)

        (v1, v2) match {
        case (NumV(a), NumV(b)) => if (a == b) (BoolV(true), st3) else (BoolV(false), st3)
        case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
        }
        }

        case LtC(l, r) => {

        val (v1, st2) = interp(l, nv, st1)
        val (v2, st3) = interp(r, nv, st2)

        (v1, v2) match {
        case (NumV(a), NumV(b)) => if (a < b) (BoolV(true), st3) else (BoolV(false), st3)
        case _ => throw new InterpOpInvalidExcep("These operations are only defined for numbers")
        }
        }


        case ConsC(l, r) => {
        val (v1, st2) = interp(l, nv, st1)
        val (v2, st3) = interp(r, nv, st2)

        (ConsV(v1, v2), st3)
        }


        case HeadC(e) => interp(e, nv, st1) match {
        case (ConsV(h, _), st2) => (h, st2)
        case _ => throw new InterpOpInvalidExcep("HEAD not allowed")
        }

        case TailC(e) => interp(e, nv, st1) match {
        case (ConsV(_, t), st2) => (t, st2)
        case _ => throw new InterpOpInvalidExcep("TAIL not allowed")
        }

        case IsNilC(e) => interp(e, nv, st1) match {
        case (NilV(), st2) => (BoolV(true), st2)
        case (ConsV(_, _), st2) => (BoolV(false), st2)
        case _ => throw new InterpOpInvalidExcep("isNil not allowed")
        }

        case IsListC(e) => {
        val (v1, st2) = interp(e, nv, st1)
        v1 match {
        case NilV() | ConsV(_, _) => (BoolV(true), st2)
        case _ => (BoolV(false), st2)
        }
        }

        case IfC(e, e1, e2) => interp(e, nv, st1) match {
        case (BoolV(true), st2) => interp(e1, nv, st2)
        case (BoolV(false), st2) => interp(e2, nv, st2)
        case _ => throw new InterpOpInvalidExcep(s"IF not allowed as $e does not evaluate to Boolean")
        }

        case UninitializedC() => (UninitializedV(), st1)

        case AppC(f, args) => interp(f, nv, st1) match {
        case (PointerClosV(f@FdC(params, body), env), st2) => {
        //Alternative - val (interpretedArgs, st3) = interpArgsAlt(args, nv, st2, Nil)
        val (interpretedArgs, st3) = interpArgs(args, nv, st2)
        val (envNew, stNew): (PointerEnvironment, Store) = extendEnvStore(params, interpretedArgs, env, st3)
        interp(body, envNew, stNew)
        }
        //case FdC(params, body) if (params.size != args.size) => throw new InterpOpInvalidExcep("Error thrown in case AppC/ClosV - Number of `params` and `args` do not match")
        case _ => throw new InterpOpInvalidExcep("Error thrown in case AppC/ClosV - `f` IS NOT a function definition")
        }

        case IdC(s) =>  (fetch(lookup(s, nv), st1), st1)

        case fdc@FdC(params, body) => (PointerClosV(fdc, nv), st1)

        case BoxC(v) => {
        val (v1, st2) = interp(v, nv, st1)
        val newLocation = newLoc(st2)
        (BoxV(newLocation), extendStore(Cell(newLocation, v1), st2))
        }

        case UnboxC(b) => {
        val (b1, st2) = interp(b, nv, st1)
        b1 match {
        case BoxV(loc) => (fetch(loc, st2), st2)
        case _ => throw new InterpOpInvalidExcep(s"Cannot unbox $b1, as it is not a box")
        }
        }

        case SetboxC(b, c) => { // REMEMBER - left->right evaluation order

        val (b1, st2) = interp(b, nv, st1)
        val (b2, st3) = interp(c, nv, st2)

        b1 match {
        case BoxV(loc) => (b2, update(loc, st3, b2))
        case _ => throw new InterpOpInvalidExcep(s"Cannot Setbox $b1, as it is not a box")
        }

        }

        case SetC(v, b) => interp(b, nv, st1) match{
        case (v1, st2) => (v1, update(lookup(v, nv), st2, v1))
        case _ => throw new InterpOpInvalidExcep("SetC not allowed.")
        }

        case SeqC(b1, b2) => {
        val st2 = interp(b1, nv, st1)._2
        interp(b2, nv, st2)
        }

        // NEW
        case EqStrC(l, r) => {
        val (v1, st2) = interp(l, nv, st1)
        val (v2, st3) = interp(r, nv, st2)
        (v1, v2) match {
        case (StringV(s1), StringV(s2)) => if (s1 == s2) (BoolV(true), st3) else (BoolV(false), st3)
        case _ => throw new InterpOpInvalidExcep("EqStringC not allowed.")
        }
        }
        case ConcStrC(l, r) => {
        val (v1, st2) = interp(l, nv, st1)
        val (v2, st3) = interp(r, nv, st2)

        (v1, v2) match {
        case (StringV(s1), StringV(s2)) => (StringV(s1 + s2), st3)
        case _ => throw new InterpOpInvalidExcep("EqStringC not allowed.")
        }

        }
        case StringC(str) => (StringV(str), st1)
        }
        }