Fix spelling of file names

1 files changed, 0 insertions, 419 deletions

diff --git a/elab.sml b/elab.sml
deleted file mode 100644
index 60760cd..0000000
--- a/elab.sml
+++ /dev/null
@@ -1,419 +0,0 @@
-structure Elab =
-struct
-  structure StringMap = Map(type k = string val cmp = String.compare)
-  structure IntMap = Map(type k = int val cmp = Int.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
-    | "read" => Syntax.PRead
-    | "write" => Syntax.PWrite
-    | "writeErr" => Syntax.PWriteErr
-    | _ => raise Fail ("invalid op: " ^ s)
-
-  fun enumerate (l : 'a list) : (int * 'a) list =
-  let
-    fun go _ [] = []
-      | go i (x :: xs) = (i, x) :: go (i + 1) xs
-  in go 0 l
-  end
-
-  fun hdstls ([] : 'a list list) : ('a list * 'a list list) option = SOME ([], [])
-    | hdstls ([] :: _) = NONE
-    | hdstls ((x :: xs) :: ls) =
-      case hdstls ls of
-        NONE => NONE
-      | SOME (heads, tails) => SOME (x :: heads, xs :: tails)
-
-  fun transpose ([] : 'a list list) : 'a list list = []
-    | transpose l =
-      case hdstls l of
-        NONE => []
-      | SOME (heads, tails) => heads :: transpose tails
-
-  datatype env = Env of { vars: int StringMap.map, types: (int * int) StringMap.map, structTypes: env StringMap.map }
-
-  val emptyEnv = Env { vars = StringMap.empty, types = StringMap.empty, structTypes = StringMap.empty }
-
-  fun bindVar (name : string) (sym : int) (Env env) : env = Env { vars = StringMap.insert name sym (#vars env), types = #types env, structTypes = #structTypes env }
-
-  fun lookupVar (name : string) (Env env) : int =
-    case StringMap.lookup name (#vars env) of
-      SOME x => x
-    | NONE => raise Fail ("unbound identifier " ^ name)
-
-  fun bindDataCons (cons : (string * Syntax.etype option) list) (Env env) : env =
-  let
-    val nCons = length cons
-    val (_, vars, types) =
-      foldl
-        (fn ((name, _), (i, vars, types)) =>
-          (i + 1, StringMap.insert name (GenSym.new ()) vars, StringMap.insert name (i, nCons) types))
-        (0, #vars env, #types env)
-        cons
-  in Env { vars = vars, types = types, structTypes = #structTypes env }
-  end
-
-  fun lookupStructType (name : string) (Env env) : env =
-    case StringMap.lookup name (#structTypes env) of
-      SOME x => x
-    | NONE => raise Fail ("unbound structure " ^ name)
-
-  fun lookupCon ([name] : string list) (Env env) : int option =
-        Option.map (fn (i, _) => i) (StringMap.lookup name (#types env))
-    | lookupCon (structName :: names) env =
-        lookupCon names (lookupStructType structName env)
-    | lookupCon [] _ = raise Fail "lookupCon empty"
-
-  fun nConstructors ([name] : string list) (Env env) : int =
-        let val (_, n) = valOf (StringMap.lookup name (#types env))
-        in n
-        end
-    | nConstructors (structName :: names) env =
-        nConstructors names (lookupStructType structName env)
-    | nConstructors [] _ = raise Fail "nConstructors empty"
-
-  fun patternMatrix (arms : Syntax.pat list) : Syntax.pat list list =
-  let val ts =
-    foldl
-      (fn (Syntax.PWild, tupleSize) => tupleSize
-        | (Syntax.PVar _, tupleSize) => tupleSize
-        | (Syntax.PCon _, _) => ~2
-        | (Syntax.PInt _, _) => ~2
-        | (Syntax.PTuple t, ~1) => length t
-        | (Syntax.PTuple t, tupleSize) =>
-            if tupleSize = length t
-            then tupleSize
-            else raise Fail "a type checker would have caught this")
-    ~1
-    arms
-  in if ts < 0
-  then [arms]
-  else let
-    val expandedArms =
-      map
-        (fn Syntax.PTuple t => t
-          | _ => List.tabulate (ts, fn _ => Syntax.PWild))
-        arms
-    val cols = transpose expandedArms
-  in List.concat (map patternMatrix cols)
-  end
-  end
-
-  fun occurrenceVector (expr : Syntax.lexp) (arms : Syntax.pat list) : Syntax.lexp list =
-  let
-    val expandedArms =
-      List.mapPartial
-        (fn Syntax.PTuple t => SOME t
-          | _ => NONE)
-        arms
-    val cols = transpose expandedArms
-  in
-    case cols of
-      [] => [expr]
-    | _ => List.concat (map (fn (i, col) => occurrenceVector (Syntax.LSelect (i, expr)) col) (enumerate cols))
-  end
-
-  fun patternBindings (expr : Syntax.lexp) (Syntax.PVar v) : (string * Syntax.lexp) list = [(v, expr)]
-    | patternBindings expr (Syntax.PTuple t) =
-        List.concat (map (fn (i, p) => patternBindings (Syntax.LSelect (i, expr)) p) (enumerate t))
-    | patternBindings expr (Syntax.PCon (_, arg)) = patternBindings (Syntax.LSelect (1, expr)) arg
-    | patternBindings _ _ = []
-
-  fun swap1 0 (l : 'a list) : 'a list = l
-    | swap1 n (first :: rest) =
-        (case swap1 (n - 1) rest of
-          x :: rest => x :: first :: rest
-        | _ => raise Fail "swap1: index out of bounds")
-    | swap1 _ _ = raise Fail "swap1: index out of bounds"
-
-  fun swap (n : int) (patterns : Syntax.pat list list) (occurrences : Syntax.lexp list) : Syntax.pat list list * Syntax.lexp list =
-    (map (swap1 n) patterns, swap1 n occurrences)
-
-  fun specialize (env : env) (n : int) (patterns : Syntax.pat list list, occurrences : Syntax.lexp list, actions : Syntax.lexp list) : Syntax.pat list list * Syntax.lexp list * Syntax.lexp list =
-    let
-      val con1 =
-        List.find
-          (fn Syntax.PCon (name, _) => valOf (lookupCon name env) = n
-            | _ => false)
-          (map hd patterns)
-      val newTupleSize =
-        case con1 of
-          SOME (Syntax.PCon (_, Syntax.PTuple t)) => length t
-        | _ => 0
-      val occHead = hd occurrences
-      val occRest = tl occurrences
-      val occurrences =
-        if newTupleSize = 0
-        then Syntax.LSelect (1, occHead) :: occRest
-        else
-          List.tabulate (newTupleSize, fn i => Syntax.LSelect (i, Syntax.LSelect (1, occHead))) @ occRest
-      fun specializeRow (Syntax.PInt i :: rest) =
-            if i = n then SOME (Syntax.PWild :: rest) else NONE
-        | specializeRow (Syntax.PWild :: rest) = SOME (Syntax.PWild :: rest)
-        | specializeRow (Syntax.PVar _ :: rest) = SOME (Syntax.PWild :: rest)
-        | specializeRow (Syntax.PCon (con, Syntax.PTuple []) :: rest) =
-            specializeRow (Syntax.PCon (con, Syntax.PTuple [Syntax.PWild]) :: rest)
-        | specializeRow (Syntax.PCon (con, Syntax.PTuple args) :: rest) =
-            if valOf (lookupCon con env) = n
-            then SOME (args @ rest)
-            else NONE
-        | specializeRow (Syntax.PCon (con, obj) :: rest) =
-            specializeRow (Syntax.PCon (con, Syntax.PTuple [obj]) :: rest)
-        | specializeRow _ = raise Fail "unexpected pattern in the matrix"
-      val (patterns, actions) =
-        ListPair.unzip
-          (List.mapPartial
-            (fn (p, a) =>
-              Option.map (fn p => (p, a)) (specializeRow p))
-            (ListPair.zipEq (patterns, actions)))
-    in (patterns, occurrences, actions)
-    end
-
-  fun default (patterns : Syntax.pat list list, occurrences : Syntax.lexp list, actions : Syntax.lexp list) : Syntax.pat list list * Syntax.lexp list * Syntax.lexp list =
-    let
-      val (patterns, actions) =
-        ListPair.unzip
-          (List.filter
-            (fn (Syntax.PWild :: _, _) => true
-              | (Syntax.PVar _ :: _, _) => true
-              | _ => false)
-            (ListPair.zipEq (patterns, actions)))
-    in (patterns, occurrences, actions)
-    end
-
-  fun compilePatternMatching (env : env) ([] : Syntax.pat list list, _ : Syntax.lexp list, _ : Syntax.lexp list) : Syntax.lexp =
-        raise Fail "nonexhaustive match"
-    | compilePatternMatching env (patterns as firstRow :: rows, occurrences, actions) =
-        let val refutablePattern =
-          List.find
-            (fn (_, Syntax.PInt _) => true
-              | (_, Syntax.PCon _) => true
-              | _ => false)
-            (enumerate firstRow)
-        in
-          case refutablePattern of
-            NONE => hd actions
-          | SOME (i, _) =>
-              let
-                val (patterns, occurrences) =
-                  if i = 0
-                  then (patterns, occurrences)
-                  else swap i patterns occurrences
-                val firstCol = map hd patterns
-                val signatures =
-                  map (fn (x, _) => x)
-                    (IntMap.toList
-                      (foldl
-                        (fn (Syntax.PInt i, acc) => IntMap.insert i true acc
-                          | (Syntax.PCon (c, _), acc) => IntMap.insert (valOf (lookupCon c env)) true acc
-                          | (_, acc) => acc)
-                        IntMap.empty
-                        firstCol))
-                val nCons =
-                  case List.find (fn (Syntax.PCon _) => true | _ => false) firstCol of
-                    SOME (Syntax.PCon (name, _)) => nConstructors name env
-                  | _ => ~1
-                val defaultCase =
-                  if length signatures = nCons
-                  then NONE
-                  else SOME (compilePatternMatching env (default (patterns, occurrences, actions)))
-                val switchOperand =
-                  if nCons < 0
-                  then hd occurrences
-                  else Syntax.LSelect (0, hd occurrences)
-              in
-                Syntax.LSwitch
-                  ( switchOperand
-                  , map
-                      (fn i => (i, compilePatternMatching env (specialize env i (patterns, occurrences, actions))))
-                      signatures
-                  , defaultCase
-                  )
-              end
-        end
-
-  fun declBoundVars (Syntax.DVal (p, _)) : string list = map (fn (x, _) => x) (patternBindings (Syntax.LInt 0) p)
-    | declBoundVars (Syntax.DValRec (p, _)) = map (fn (x, _) => x) (patternBindings (Syntax.LInt 0) p)
-    | declBoundVars (Syntax.DFun (name, _)) = [name]
-    | declBoundVars (Syntax.DDatatype (_, cons)) = map (fn (x, _) => x) cons
-    | declBoundVars (Syntax.DStruct (name, _)) = [name]
-
-  fun structBoundVars (decls : Syntax.dec list) : string list = List.concatMap declBoundVars decls
-
-  fun bindStructType (name : string) (decls : Syntax.dec list) (Env env) : env =
-    let
-      val structEnv =
-        foldl
-          (fn (Syntax.DDatatype (_, cons), env) => bindDataCons cons env
-            | (Syntax.DStruct (name, decls), env) => bindStructType name decls env
-            | (_, env) => env)
-          emptyEnv
-          decls
-      val structEnv =
-        foldl
-          (fn ((i, n), env) => bindVar n i env)
-          structEnv
-          (enumerate (structBoundVars decls))
-    in
-      Env { vars = #vars env, types = #types env, structTypes = StringMap.insert name structEnv (#structTypes env) }
-    end
-
-  fun actionVector (env : env) (expr : Syntax.lexp) (arms : (Syntax.pat * Syntax.expr) list) : Syntax.lexp list =
-    map
-      (fn (p, body) =>
-        let
-          val bindings = patternBindings expr p
-          val env =
-            foldl
-              (fn ((name, _), env) =>
-                bindVar name (GenSym.new ()) env)
-              env
-              bindings
-        in
-          foldl
-            (fn ((name, binding), acc) =>
-              Syntax.LApp (Syntax.LFn (lookupVar name env, acc), binding))
-            (elab env body)
-            bindings
-        end)
-      arms
-
-  and elabCase (env : env) (expr : Syntax.lexp) (arms : (Syntax.pat * Syntax.expr) list) =
-    let
-      val patterns = transpose (patternMatrix (map (fn (x, _) => x) arms))
-      val occurrences = occurrenceVector expr (map (fn (x, _) => x) arms)
-      val actions = actionVector env expr arms
-      val actionFns =
-        map
-          (fn a => (GenSym.new (), GenSym.new (), a))
-          actions
-      val smallActions =
-        map
-          (fn (f, _, _) => Syntax.LApp (Syntax.LVar f, Syntax.LInt 0))
-          actionFns
-    in
-      Syntax.LFix
-        ( actionFns
-        , compilePatternMatching env (patterns, occurrences, smallActions)
-        )
-    end
-
-  and elab (env : env) (p : Syntax.expr) : Syntax.lexp =
-    case p of
-      Syntax.EIdent [i] => Syntax.LVar (lookupVar i env)
-    | Syntax.EIdent (structName :: accessors) =>
-        let
-          val s = Syntax.LVar (lookupVar structName env)
-          val env = lookupStructType structName env
-          fun go env [i] acc = Syntax.LSelect (lookupVar i env, acc)
-            | go env (accessor :: accessors) acc =
-                let val env = lookupStructType accessor env
-                in go env accessors (Syntax.LSelect (lookupVar accessor env, acc))
-                end
-            | go _ [] _ = raise Fail "go empty"
-        in go env accessors s
-        end
-    | Syntax.EIdent [] => raise Fail "invalid syntax"
-    | 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.DDatatype (name, cons) :: decls, body) =>
-        let
-          val env = bindDataCons cons env
-          val funs =
-            List.mapPartial
-              (fn (_, (_, NONE)) => NONE
-                | (i, (name, _)) =>
-                    let val v = GenSym.new ()
-                    in SOME (lookupVar name env, v, Syntax.LRecord [Syntax.LInt i, Syntax.LVar v])
-                    end)
-              (enumerate cons)
-          val vals =
-            List.mapPartial
-              (fn (i, (name, NONE)) => SOME (lookupVar name env, Syntax.LRecord [Syntax.LInt i])
-                | _ => NONE)
-              (enumerate cons)
-        in
-          foldl
-            (fn ((v, x), acc) =>
-              Syntax.LApp (Syntax.LFn (v, acc), x))
-            (Syntax.LFix (funs, elab env (Syntax.ELet (decls, body))))
-            vals
-        end
-    | Syntax.ELet (Syntax.DVal (pat, v) :: decls, body) =>
-        elab env (Syntax.ECase (v, [(pat, Syntax.ELet (decls, body))]))
-    | Syntax.ELet (Syntax.DValRec (Syntax.PVar name, f as Syntax.ELambda _) :: decls, body) =>
-        let
-          val n = GenSym.new ()
-          val env = bindVar name n env
-          val (arg, fnBody) =
-            case elab env f of
-              Syntax.LFn x => x
-            | _ => raise Fail "Syntax.ELambda should expand to Syntax.LFn"
-        in
-          Syntax.LFix ([(n, arg, fnBody)], elab env (Syntax.ELet (decls, body)))
-        end
-    | Syntax.ELet (Syntax.DValRec _ :: _, _) => raise Fail "invalid val rec"
-    | Syntax.ELet (Syntax.DFun (name, cases) :: decls, body) =>
-        let
-          val (ps1, _) = hd cases
-          val nPats = length ps1
-        in if not (List.all (fn (ps, _) => length ps = nPats) cases)
-        then raise Fail "clauses do not all have same number of patterns"
-        else let
-          val n = GenSym.new ()
-          val temps = List.tabulate (nPats, fn _ => GenSym.new ())
-          val env = bindVar name n env
-          val t = GenSym.new ()
-          val innerCase = elabCase env (Syntax.LVar t) (map (fn (ps, b) => (Syntax.PTuple ps, b)) cases)
-        in
-          Syntax.LFix
-            ( [ ( n
-                , hd temps
-                , foldr
-                    Syntax.LFn
-                    (Syntax.LApp (Syntax.LFn (t, innerCase), Syntax.LRecord (map Syntax.LVar temps)))
-                    (tl temps)
-                )
-              ]
-            , elab env (Syntax.ELet (decls, body))
-            )
-        end
-        end
-    | Syntax.ELet (Syntax.DStruct (name, structDecls) :: decls, body) =>
-        let
-          val names = structBoundVars structDecls
-          val tuple = elab env (Syntax.ELet (structDecls, Syntax.ETuple (map (fn n => Syntax.EIdent [n]) names)))
-          val v = GenSym.new ()
-          val env = bindStructType name structDecls env
-          val env = bindVar name v env
-        in Syntax.LApp (Syntax.LFn (v, elab env (Syntax.ELet (decls, body))), tuple)
-        end
-    | Syntax.ELambda body =>
-        let val v = GenSym.new ()
-        in Syntax.LFn (v, elabCase env (Syntax.LVar v) [body])
-        end
-    | Syntax.ECase (expr, arms) =>
-        let val v = GenSym.new ()
-        in Syntax.LApp (Syntax.LFn (v, elabCase env (Syntax.LVar v) arms), elab env expr)
-        end
-
-  fun elaborate (p : Syntax.expr) : Syntax.lexp = elab emptyEnv p
-end