provide {parse-n-calc: parse-n-calc} end

import sets as S
import shared-gdrive("calc-fields-typed-definitions.arr", "0B5p0KwAwF4VoRXV0ZkdZY3M0dGM") as C
include string-dict

fun parse-n-calc(prog :: String) -> Set<String>:
  doc: "Parse a program with a hole, and return the fields avaiable there"
  calc-locals(C.parse(prog), [string-dict:])
end


fun calc-locals(expr :: C.Expr, bound :: C.TEnv) -> Set<String>:
  doc: "Find all of the fields available at a hole."
  cases (C.Expr) expr :
    | e-num(v) => [set:]
    | e-bool(b) => [set:]
    | e-op(op, left, right) => calc-locals(left, bound).union(calc-locals(right, bound))
    | e-if(cond, consq, altern) =>
      calc-locals(cond, bound).union(calc-locals(consq, bound)).union(calc-locals(altern, bound))
    | e-id(name) => [set:]
    | e-lam(param, body) => calc-locals(body, bound.set(param, body))
    | e-app(func, arg) => calc-locals(func, bound).union(calc-locals(arg, bound))
    | e-let(id, value, body) =>
      new-pvar = bound.set(id, value)
      calc-locals(value, new-pvar).union(calc-locals(body, new-pvar))
    | e-rec(fields) => rec-helper(fields.keys().to-list(), fields, bound)

    | e-lookup(recr, field-name-or-hole) =>
      cases (C.Expr) expr :
        | l-hole =>
          type-check(field-name-or-hole, bound)

        | l-name =>  calc-locals(recr, bound)
      end



    | e-extend(reco, field-name, new-val) => calc-locals(reco, bound).union(calc-locals(new-val, bound))
      # | e-num(n) =>


      #| e-bool(b)
    | e-op(op, l, r)
    | e-if(cond, consq, altern)
    | e-id(name)
    | e-app(func, arg)
    | e-let(na, ex, bdy)
    | e-rec(fields)
    | e-lookup(recr, field-na)
    | e-extend(reco, field-name, new-val)
    | e-lam(id, ar, body) |#
      end
end

fun rec-helper(f :: List<String>, fields, bound) -> Set<String>:
  #rec-accum(f, [set:], bound)
  cases (List) f:
    | empty => [set: ]
    | link(first, rest) => calc-locals(fields.get-value(first), bound).union(rec-helper(rest, fields, bound))


end

end

#|
fun rec-accum(l, sofar, bound):
  cases (List) l:
    | empty => sofar
    | link(f, r) => calc-locals(l.get-value(f), bound).union(rec-accum, r
  end
end
|#


check:
  parse-n-calc("(lookup (record (x 1)) @)") is [set: "x"]
  parse-n-calc("(let (x (record (a 1) (b 2))) (let (y (extend x c 3)) (lookup y @)))") is [set: "a", "b", "c"]
end

## Type Checker Below ##


fun type-check(e :: C.Expr, env :: C.TEnv) -> C.Type:
  doc: "Find the type of the given expression."
  cases (C.Expr) e:
    | e-op(op :: C.Operator, left :: C.Expr, right :: C.Expr) => op-helper(op, type-check(left, env), type-check(right, env))
    | e-un-op(op :: C.UnaryOperator, expr :: C.Expr) => un-op-helper(op, type-check(expr, env))
    | e-if(cond :: C.Expr, consq :: C.Expr, altern :: C.Expr) => if-helper(type-check(cond, env), type-check(consq, env), type-check(altern, env))

    | e-let(name :: String, expr :: C.Expr, body :: C.Expr) =>  let-helper(name, type-check(expr, env), body, env)

    | e-lam(param :: String, arg-type :: C.Type, body :: C.Expr) => lam-helper(param, arg-type, type-check(body, env.set(param, arg-type)))
    | e-app(func :: C.Expr, arg :: C.Expr) => app-helper(type-check(func, env), type-check(arg, env))
    | e-id(name :: String) => id-helper(name, env)
    | e-num(value :: Number) => C.t-num
    | e-bool(value :: Boolean) => C.t-bool
    | e-empty(elem-type :: C.Type) => C.t-list(elem-type)


  end
end

fun op-helper(op :: C.Operator, left :: C.Type, right :: C.Type) -> C.Type:

  cases (C.Operator) op:
    | op-plus => if C.is-t-num(left):
        if C.is-t-num(right):
          C.t-num
        else: raise(C.tc-err-bad-arg-to-op(op, right))
        end
      else: raise(C.tc-err-bad-arg-to-op(op, left))
      end
    | op-num-eq => if C.is-t-num(left):
        if C.is-t-num(right):
          C.t-bool
        else: raise(C.tc-err-bad-arg-to-op(op, right))
        end
      else: raise(C.tc-err-bad-arg-to-op(op, left))
      end
    | op-link => if not(C.is-t-list(right)):
        raise(C.tc-err-bad-arg-to-op(op, right))
      else if not(C.t-list(left) == right):  #right matches type of list.
        raise(C.tc-err-bad-arg-to-op(op, left))
      else:
        C.t-list(left)


  end


end
end

fun if-helper(cond :: C.Type, consq :: C.Type, altern :: C.Type) -> C.Type:
  if cond == C.t-bool:
    if not(consq == altern):
      raise(C.tc-err-if-branches(consq, altern))
    else: consq
    end
  else:
    raise(C.tc-err-if-got-non-boolean(cond))
  end


end

fun un-op-helper(op :: C.UnaryOperator, exprt :: C.Type) -> C.Type:
  cases (C.UnaryOperator) op:
    | op-first =>
      if not(C.is-t-list(exprt)):
         raise(C.tc-err-bad-arg-to-op(op, exprt))
      else:
        exprt
      end
    | op-rest =>
      if not(C.is-t-list(exprt)):
        raise(C.tc-err-bad-arg-to-op(op, exprt))
      else:
        exprt
      end
    | op-is-empty =>
        if not(C.is-t-list(exprt)):
        raise(C.tc-err-bad-arg-to-op(op, exprt))

      else:
        C.t-bool
      end

end
end

fun app-helper(func :: C.Type, arg :: C.Type) -> C.Type:
  if not(func.arg-type == arg):
    raise(C.tc-err-bad-arg-to-fun(func, arg))
  else:
    func.return-type
  end


end

fun let-helper(name :: String, et :: C.Type, body :: C.Expr, env :: C.TEnv) -> C.Type:
  type-check(body, env.set(name,et))
end

fun id-helper(name :: String, env :: C.TEnv) -> C.Type:

  if env.has-key(name):
  env.get-value(name)
  else:
   raise(C.tc-err-unbound-id(name))
  end
end


fun lam-helper(name :: String, arg-type :: C.Type, bodyt :: C.Type) -> C.Type:
  if not(arg-type == bodyt):
    raise(C.tc-err-bad-arg-to-fun(bodyt, arg-type))

  else:
    C.t-fun(arg-type, bodyt)

  end

end