structure Elab =
struct
  structure StringMap = Map(type k = string val cmp = String.compare);

  fun primop (s : string) : Syntax.primop =
    case s of
      "exit" => Syntax.PExit
    | "add" => Syntax.PAdd
    | "sub" => Syntax.PSub
    | "mul" => Syntax.PMul
    | "div" => Syntax.PDiv
    | _ => raise Fail ("invalid op: " ^ s)

  fun elab (env : int StringMap.map) (p : Syntax.expr) : Syntax.lexp =
    case p of
      Syntax.EIdent [i] => (case StringMap.lookup i env of
        NONE => raise Fail ("unbound identifier " ^ i)
      | SOME x => Syntax.LVar x)
    | Syntax.EIdent _ => raise Fail "long identifiers are not supported"
    | Syntax.EBuiltin builtin => Syntax.LPrim (primop builtin)
    | Syntax.EInt i => Syntax.LInt i
    | Syntax.EStr s => Syntax.LString s
    | Syntax.ETuple exprs => Syntax.LRecord (map (elab env) exprs)
    | Syntax.EList exprs =>
        foldr
          (fn (x, acc) =>
            Syntax.LRecord [elab env x, acc])
          (Syntax.LInt 0)
          exprs
    | Syntax.EApp (f, x) => Syntax.LApp (elab env f, elab env x)
    | Syntax.ETyped (e, _) => elab env e
    | Syntax.EAndAlso (_, _) => raise Fail "unimplemented"
    | Syntax.EOrElse (_, _) => raise Fail "unimplemented"
    | Syntax.ELet ([], body) => elab env body
    | Syntax.ELet (Syntax.DVal (pat, v) :: decls, body) =>
        elab env (Syntax.ECase (v, [(pat, Syntax.ELet (decls, body))]))
    | Syntax.ELambda (pat, body) =>
        let
          val v = Gensym.new ()
          val env' =
            case pat of
              Syntax.PVar name => StringMap.insert name v env
            | _ => env
        in Syntax.LFn (v, elab env' body)
        end
    | Syntax.ECase (expr, []) => raise Fail "nonexhaustive match"
    | Syntax.ECase (expr, arms) =>
        let
          fun go [] _ = raise Fail "nonexhaustive match"
            | go ((Syntax.PWild, body) :: []) acc = Syntax.LSwitch (elab env expr, rev acc, elab env body)
            | go ((Syntax.PVar name, body) :: []) acc =
                let val v = Gensym.new () in
                  Syntax.LApp (Syntax.LFn (v, Syntax.LSwitch (Syntax.LVar v, rev acc, elab (StringMap.insert name v env) body)), elab env expr)
                end
            | go ((Syntax.PInt i, body) :: rest) acc =
                go rest ((i, elab env body) :: acc)
            | go _ _ = raise Fail "redundant match"
        in go arms []
        end

  fun elaborate (p : Syntax.expr) : Syntax.lexp = elab StringMap.empty p
end