Fix spelling of file names

1 files changed, 0 insertions, 672 deletions

diff --git a/parser.sml b/parser.sml
deleted file mode 100644
index e464332..0000000
--- a/parser.sml
+++ /dev/null
@@ -1,672 +0,0 @@
-infix 4 <$> <$
-infix 1 >>
-infixr 1 <|>
-infix 0 <?>
-
-structure Parser =
-struct
-  structure StringMap = Map(type k = string val cmp = String.compare)
-
-  (* vector of length 10, holding the left and right associative infix operators for each precedence level. *)
-  type infixTable = (string list * string list) vector
-  type userState = {infixTable : infixTable}
-  type sourceLoc = {file : string, row : int, column : int}
-  type state = {stream : TextIO.StreamIO.instream, loc : sourceLoc, userState : userState}
-  datatype response = Consumed | Empty
-  datatype message = Unexpected of string | Expected of string
-  type parseError = {loc : sourceLoc, msgs : message list}
-  datatype hints = Hints of string list
-  type 'a parser = state -> response * (parseError, 'a * state * hints) Result.either
-
-  val reservedWords =
-    [ "abstype", "and", "andalso", "as", "case", "datatype", "do", "else"
-    , "end", "exception", "fn", "fun", "handle", "if", "in", "infix"
-    , "infixr", "let", "local", "nonfix", "of", "op", "open", "orelse"
-    , "raise", "rec", "then", "type", "val", "with", "withtype", "while"
-    , "(", ")", "[", "]", "{", "}", ",", ":", ";", "...", "_", "|", "=", "=>", "->", "#"
-    , "eqtype", "functor", "include", "sharing", "sig"
-    , "signature", "struct", "structure", "where", ":>"
-    ]
-
-  val emptyInfixOperators : infixTable =
-    Vector.tabulate (10, fn _ => ([], []))
-
-  fun printSourceLoc ({file, row, column} : sourceLoc) : string =
-    file ^ ":" ^ Int.toString row ^ "." ^ Int.toString column
-
-  fun printError ({loc, msgs} : parseError) : string =
-    let
-      val unexpect = List.mapPartial (fn Unexpected x => SOME x | _ => NONE) msgs
-      val showUnexpect = case unexpect of
-                           [] => ""
-                         | s :: _ => "unexpected " ^ s ^ ";\n"
-      val expect = List.mapPartial (fn Expected s => SOME s | _ => NONE) msgs
-    in
-        printSourceLoc loc ^ " Syntax error:\n"
-      ^ showUnexpect
-      ^ "expecting " ^ String.concatWith ", " expect
-    end
-
-  fun unpackParserResponse (_ : response, Result.Left err : (parseError, 'a * state * hints) Result.either) : (string, 'a) Result.either =
-        Result.Left (printError err)
-    | unpackParserResponse (_, Result.Right (a, st, _)) =
-        if TextIO.StreamIO.endOfStream (#stream st)
-        then Result.Right a
-        else Result.Left (printSourceLoc (#loc st) ^ " Syntax error: trailing characters")
-
-  fun newLoc (fileName : string) : sourceLoc = {
-    file = fileName,
-    row = 1,
-    column = 1
-  }
-
-  fun collectInfixOperators (opTable : (string list * string list) vector) : string list =
-    Vector.foldl (fn ((a, b), acc) => a @ b @ acc) [] opTable
-
-  fun infixOps (opTable : infixTable) : string list =
-    Vector.foldl (fn ((a, b), acc) => a @ b @ acc) [] opTable
-
-  fun newState (fileName : string) (fileStream : TextIO.instream) : state = {
-    stream = TextIO.getInstream fileStream,
-    loc = newLoc fileName,
-    userState = {infixTable = emptyInfixOperators}
-  }
-
-  fun updateUserState (f : userState -> userState) : userState parser =
-    fn {stream, loc, userState} =>
-      let val st' = f userState
-      in (Empty, Result.Right (st', {stream = stream, loc = loc, userState = st'}, Hints []))
-      end
-
-  val getUserState : userState parser = updateUserState (fn x => x)
-
-  fun runParser (p : 'a parser) (fileName : string) : (string, 'a) Result.either =
-    unpackParserResponse (p (newState fileName (TextIO.openIn fileName)))
-
-  fun testParser (p : 'a parser) (s : string) : 'a =
-    case unpackParserResponse (p (newState "STRING" (TextIO.openString s))) of
-      Result.Right x => x
-    | Result.Left e => raise Fail ("Parse failed: " ^ e)
-
-  fun mergeHints (Hints a) (Hints b) : hints = Hints (a @ b)
-
-  fun withHints (Hints hints) ({loc, msgs} : parseError) : parseError = {
-    loc = loc,
-    msgs = map Expected hints @ msgs
-  }
-
-  fun errToHints ({msgs, ...} : parseError) : hints = Hints (List.mapPartial (fn Expected s => SOME s | _ => NONE) msgs)
-
-  fun compareLoc (l : sourceLoc, m : sourceLoc) : order =
-    case Int.compare (#row l, #row m) of
-      EQUAL => Int.compare (#column l, #column m)
-    | ord => ord
-
-  fun mergeError (e1 : parseError) (e2 : parseError) : parseError =
-    (* pick the longest match *)
-    case compareLoc (#loc e1, #loc e2) of
-      EQUAL => {
-        loc = #loc e1,
-        msgs = #msgs e1 @ #msgs e2
-      }
-    | GREATER => e1
-    | LESS => e2
-
-  fun bind (p : 'a parser) (f : 'a -> 'b parser) : 'b parser =
-    fn st =>
-      case p st of
-        (consumed1, Result.Right (a, st', hints)) =>
-          (case (f a) st' of
-            (Consumed, Result.Right success) => (Consumed, Result.Right success)
-          | (Empty, Result.Right (b, st'', hints')) => (consumed1, Result.Right (b, st'', mergeHints hints hints'))
-          | (Consumed, Result.Left err) => (Consumed, Result.Left (withHints hints err))
-          | (Empty, Result.Left err) => (consumed1, Result.Left (withHints hints err)))
-      | (consumed, Result.Left err) => (consumed, Result.Left err)
-
-  fun (p1 : 'a parser) >> (p2 : 'b parser) : 'b parser = bind p1 (fn _ => p2)
-
-  fun (p : 'a parser) <?> (msg : string) : 'a parser =
-    fn st =>
-      case p st of
-        (consumed, Result.Right (a, st', _)) => (consumed, Result.Right (a, st', Hints [msg]))
-      | (consumed, Result.Left {loc, ...}) => (consumed, Result.Left {loc = loc, msgs = [Expected msg]})
-
-  fun (p1 : 'a parser) <|> (p2 : 'a parser) : 'a parser =
-    fn st =>
-      case p1 st of
-        (Empty, Result.Left err) =>
-          (case p2 st of
-            (Empty, Result.Right (a, st', hints)) => (Empty, Result.Right (a, st', mergeHints (errToHints err) hints))
-          | (Empty, Result.Left err') => (Empty, Result.Left (mergeError err err'))
-          | res => res)
-      | res => res
-
-  fun const (x : 'a) (st : state) = (Empty, Result.Right (x, st, Hints []))
-
-  fun (f : 'a -> 'b) <$> (p : 'a parser) : 'b parser = bind p (const o f)
-
-  fun (x : 'a) <$ (p : 'b parser) : 'a parser = (fn _ => x) <$> p
-
-  fun try (p : 'a parser) : 'a parser =
-    fn st =>
-      case p st of
-        (Consumed, Result.Left err) => (Empty, Result.Left err)
-      | res => res
-
-  fun updatePosChar ({file, row, column} : sourceLoc) (c : char) : sourceLoc =
-    case c of
-      #"\n" => {
-        file = file,
-        row = row + 1,
-        column = 1
-      }
-    | #"\t" => {
-      file = file,
-      row = row,
-      column = column + 8 - (column - 1) mod 8
-    }
-    | _ => {
-      file = file,
-      row = row,
-      column = column + 1
-    }
-
-  fun satisfy (pred : char -> bool) : char parser =
-    fn {stream, loc, userState} =>
-      case TextIO.StreamIO.input1 stream of
-        NONE => (Empty, Result.Left {loc = loc, msgs = [Expected "UNKNOWN"]})
-      | SOME (c, stream') =>
-          if pred c
-          then (Consumed, Result.Right (c, {stream = stream', loc = updatePosChar loc c, userState = userState}, Hints []))
-          else (Empty, Result.Left {loc = loc, msgs = [Expected "UNKNOWN"]})
-
-  fun parseChar (c : char) : char parser =
-    satisfy (fn c' => c = c') <?> str c
-
-  fun parseString (s : string) : string parser =
-    case explode s of
-      [] => const ""
-    | c1 :: cs => s <$ foldl (fn (c, p) => p >> parseChar c) (parseChar c1) cs <?> "'" ^ String.toString s ^ "'"
-
-  fun manyErr () = raise Fail "many is applied to a parser that accepts an empty string"
-
-  fun many (p : 'a parser) : 'a list parser =
-    fn st =>
-      let fun walk xs s' =
-            case p s' of
-              (Consumed, Result.Right (x, s'', _)) => walk (x :: xs) s''
-            | (Consumed, Result.Left err) => (Consumed, Result.Left err)
-            | (Empty, Result.Right _) => manyErr ()
-            | (Empty, Result.Left err) => (Consumed, Result.Right (rev xs, s', errToHints err))
-      in
-        case p st of
-          (Consumed, Result.Right (x, s', _)) => walk [x] s'
-        | (Consumed, Result.Left err) => (Consumed, Result.Left err)
-        | (Empty, Result.Right _) => manyErr ()
-        | (Empty, Result.Left err) => (Empty, Result.Right ([], st, errToHints err))
-      end
-
-  fun many1 (p : 'a parser) : 'a list parser =
-    bind p (fn x =>
-    bind (many p) (fn xs =>
-    const (x :: xs)))
-
-  val space : char parser = satisfy Char.isSpace <?> "space"
-
-  val spaces : unit parser = () <$ many space <?> "white space"
-
-  fun unexpected (s : string) : 'a parser =
-    fn {loc, ...} => (Empty, Result.Left {loc = loc, msgs = [Unexpected s]})
-
-  val letter : char parser = satisfy Char.isAlpha <?> "letter"
-
-  val alphaNum : char parser = satisfy Char.isAlphaNum <?> "letter or digit"
-
-  fun oneOf ([] : char list) : char parser = raise Fail "oneOf empty"
-    | oneOf (x :: xs) = foldl (fn (c, p) => p <|> parseChar c) (parseChar x) xs
-
-  (* some day, whiteSpace will support comments *)
-  val whiteSpace = spaces
-
-  fun lexeme (p : 'a parser) : 'a parser =
-    bind p (fn x =>
-    whiteSpace >>
-    const x)
-
-  val alphaNumIdentifierLetter : char parser =
-    alphaNum <|> oneOf [#"'", #"_"]
-
-  val symbolicIdentifierLetters : char list =
-    [ #"!", #"%", #"&", #"$", #"#", #"+", #"-", #"/", #":", #"<"
-    , #"=", #">", #"?", #"@", #"\\", #"~", #"`", #"^", #"|", #"*"
-    ]
-
-  val symbolicIdentifierLetter : char parser = oneOf symbolicIdentifierLetters
-
-  val alphaNumIdentifier : string parser =
-    lexeme
-      (bind letter (fn firstLetter =>
-      bind (many alphaNumIdentifierLetter) (fn rest =>
-      const (implode (firstLetter :: rest)))))
-
-  val tyvar : string parser =
-    lexeme
-      (bind (parseChar #"'") (fn firstLetter =>
-      bind (many alphaNumIdentifierLetter) (fn rest =>
-      const (implode (firstLetter :: rest)))))
-
-  val symbolicIdentifier : string parser =
-    lexeme
-      (implode <$> many1 symbolicIdentifierLetter)
-
-  fun notReserved (reserved : string list) : string parser =
-    try
-      (bind (alphaNumIdentifier <|> symbolicIdentifier <?> "identifier") (fn identName =>
-      if List.exists (fn n => n = identName) reserved
-      then unexpected identName
-      else const identName))
-
-  val identifier : string parser =
-    bind getUserState (fn {infixTable, ...} =>
-    notReserved (infixOps infixTable @ reservedWords))
-
-  val tycon : string parser =
-    bind getUserState (fn st =>
-    notReserved ("*" :: reservedWords))
-
-  fun sepBy1 (p : 'a parser) (sep : 'b parser) : 'a list parser =
-    bind p (fn x =>
-    bind (many (sep >> p)) (fn xs =>
-    const (x :: xs)))
-
-  fun sepBy (p : 'a parser) (sep : 'b parser) : 'a list parser =
-    sepBy1 p sep <|> const []
-
-  fun symbol (s : string) : string parser = lexeme (parseString s)
-
-  val longIdentifier : string list parser = sepBy1 identifier (symbol ".")
-
-  fun notFollowedBy (p : char parser) : unit parser =
-    bind (try p) (fn c => unexpected (str c))
-    <|> const ()
-
-  fun reserved (s : string) : string parser =
-    let
-      val start =
-        if s = ""
-        then raise Fail "reserved was called on an empty string"
-        else String.sub (s, 0)
-      val isSymbolic =
-        List.exists (fn c => c = start) symbolicIdentifierLetters
-    in
-      lexeme
-        (try
-          (parseString s >>
-          notFollowedBy (if isSymbolic then symbolicIdentifierLetter else alphaNumIdentifierLetter) >>
-          const s))
-      <?> s
-    end
-
-  val infixIdentifier : string parser =
-    bind getUserState (fn {infixTable, ...} =>
-    let val ops = map reserved (Vector.foldl (fn ((l, r), acc) => l @ r @ acc) [] infixTable)
-    in
-      case ops of
-        [] => unexpected "infix op"
-      | x :: xs => foldl op <|> x xs <?> "infix op"
-    end)
-
-  val longInfixIdentifier : string list parser =
-    bind (many (bind identifier (fn id => symbol "." >> const id))) (fn idents =>
-    bind infixIdentifier (fn ii =>
-    const (idents @ [ii])))
-
-  val digit : char parser = satisfy Char.isDigit <?> "digit"
-
-  val integer : int parser =
-    lexeme
-      (bind (many1 digit) (fn digits =>
-      const (valOf (Int.fromString (implode digits)))))
-
-  val stringInternalChar : char parser =
-    (parseString "\\" >> (#"\a" <$ parseChar #"a"
-                         <|> #"\b" <$ parseChar #"b"
-                         <|> #"\t" <$ parseChar #"t"
-                         <|> #"\n" <$ parseChar #"n"
-                         <|> #"\v" <$ parseChar #"v"
-                         <|> #"\f" <$ parseChar #"f"
-                         <|> #"\r" <$ parseChar #"r"
-                         <|> parseChar #"\""
-                         <|> parseChar #"\\") <?> "string escape")
-    <|> (satisfy (fn c => c <> #"\"" andalso c <> #"\\") <?> "string character")
-
-  val stringConstant : string parser =
-    lexeme
-      (parseString "\"" >>
-      bind (implode <$> many stringInternalChar) (fn stringContent =>
-      parseString "\"" >>
-      const stringContent))
-
-  val builtin : Syntax.expr parser =
-    reserved "__builtin" >>
-    Syntax.EBuiltin <$> stringConstant
-
-  fun between (left : 'a parser) (right : 'b parser) (p : 'c parser) : 'c parser =
-    left >>
-    bind p (fn x =>
-    right >>
-    const x)
-
-  fun parseTycons (ty : Syntax.etype) : Syntax.etype parser =
-        bind tycon (fn longtycon =>
-        parseTycons (Syntax.Tycon ([ty], longtycon)))
-    <|> const ty
-
-  val rec parseSingleType : Syntax.etype parser = fn st =>
-      (Syntax.Tyvar <$> (tyvar <|> tycon)
-  <|> bind (between (symbol "(") (symbol ")") (sepBy1 parseType (symbol ","))) (fn types =>
-      case types of
-        [x] => const x
-      | _ => bind tycon (fn longtycon =>
-             const (Syntax.Tycon (types, longtycon))))) st
-  and parseTycon : Syntax.etype parser =
-    fn st =>
-      bind parseSingleType parseTycons st
-  and parseTupleType : Syntax.etype parser =
-    fn st =>
-      bind (sepBy1 parseTycon (reserved "*")) (fn types =>
-      const
-        (case types of
-          [ty] => ty
-        | _ => Syntax.TyTuple types)) st
-  and parseType : Syntax.etype parser =
-    fn st =>
-      bind parseTupleType (fn ty =>
-          (reserved "->" >>
-          bind parseType (fn ty' =>
-          const (Syntax.Tyfun (ty, ty'))))
-      <|> const ty) st
-
-  fun leftOp (i : int) : string parser =
-    bind getUserState (fn {infixTable, ...} =>
-    let val (leftOps, _) = Vector.sub (infixTable, i)
-    in
-      case (map reserved leftOps) of
-        [] => unexpected "left-associative operator"
-      | op1 :: ops => (fn x => x) <$> foldl op <|> op1 ops
-    end)
-
-  fun rightOp (i : int) : string parser =
-    bind getUserState (fn {infixTable, ...} =>
-    let val (_, rightOps) = Vector.sub (infixTable, i)
-    in
-      case (map reserved rightOps) of
-        [] => unexpected "right-associative operator"
-      | op1 :: ops => (fn x => x) <$> foldl op <|> op1 ops
-    end)
-
-  val rec atpat : Syntax.pat parser = fn st =>
-      (Syntax.PWild <$ reserved "_"
-  <|> Syntax.PInt <$> integer
-  <|> bind (between (symbol "(") (symbol ")") (sepBy pat (symbol ","))) (fn pats =>
-      const
-        (case pats of
-          [p] => p
-        | _ => Syntax.PTuple pats))
-  <|> bind longIdentifier (fn [i] => const (Syntax.PVar i) | is => const (Syntax.PCon (is, Syntax.PTuple [])))) st
-  and appPat : Syntax.pat parser = fn st =>
-      (bind longIdentifier (fn ident =>
-          bind atpat (fn arg =>
-          const (Syntax.PCon (ident, arg)))
-      <|> const (case ident of
-                  [i] => Syntax.PVar i
-                | _ => Syntax.PCon (ident, Syntax.PTuple [])))
-  <|> atpat) st
-  and pat : Syntax.pat parser = fn st =>
-    foldl
-      (fn (i, patLower) =>
-        let
-          fun patLeft pat1 =
-            bind (leftOp i) (fn opEx =>
-            bind patLower (fn pat2 =>
-            let val app = Syntax.PCon ([opEx], Syntax.PTuple [pat1, pat2])
-            in patLeft app <|> const app
-            end))
-          fun patRight pat1 =
-            bind (rightOp i) (fn opEx =>
-            bind patLower (fn pat2 =>
-            bind (patRight pat2 <|> const pat2) (fn rest =>
-            const (Syntax.PCon ([opEx], Syntax.PTuple [pat1, rest])))))
-        in
-          bind patLower (fn pat1 =>
-          patLeft pat1 <|> patRight pat1 <|> const pat1)
-        end)
-      appPat
-      (List.tabulate (10, fn i => 9 - i)) st
-
-  val rec atom : Syntax.expr parser =
-    fn st =>
-      (Syntax.EInt <$> integer
-      <|> Syntax.EStr <$> stringConstant
-      <|> Syntax.EIdent <$> longIdentifier
-      <|> (reserved "op" >> Syntax.EIdent <$> longInfixIdentifier)
-      <|> builtin
-      <|> (reserved "let" >>
-           bind (many dec) (fn decs =>
-           reserved "in" >>
-           bind expr (fn e =>
-           reserved "end" >>
-           const (Syntax.ELet (List.mapPartial (fn x => x) decs, e)))))
-      <|> (symbol "(" >>
-           bind (sepBy expr (symbol ",")) (fn exprs =>
-           symbol ")" >>
-           const
-             (case exprs of
-               [x] => x
-             | _ => Syntax.ETuple exprs)))) st
-  and appExp : Syntax.expr parser =
-    fn st =>
-      bind atom (fn e0 =>
-      foldl (fn (x, acc) => Syntax.EApp (acc, x)) e0 <$> many atom) st
-  and infixExp : Syntax.expr parser =
-    fn st =>
-      foldl
-        (fn (i, exprLower) =>
-          let
-            fun exprLeft expr1 =
-              bind (leftOp i) (fn opEx =>
-              bind exprLower (fn expr2 =>
-              let val app = Syntax.EApp (Syntax.EIdent [opEx], Syntax.ETuple [expr1, expr2])
-              in exprLeft app <|> const app
-              end))
-            fun exprRight expr1 =
-              bind (rightOp i) (fn opEx =>
-              bind exprLower (fn expr2 =>
-              bind (exprRight expr2 <|> const expr2) (fn rest =>
-              const (Syntax.EApp (Syntax.EIdent [opEx], Syntax.ETuple [expr1, rest])))))
-          in
-            bind exprLower (fn expr1 =>
-            exprLeft expr1 <|> exprRight expr1 <|> const expr1)
-          end)
-        appExp
-        (List.tabulate (10, fn i => 9 - i)) st
-  and typedExp : Syntax.expr parser =
-    fn st =>
-      bind infixExp (fn e =>
-          (reserved ":" >>
-          bind parseType (fn ty =>
-          const (Syntax.ETyped (e, ty))))
-      <|> const e) st
-  and andalsoExp : Syntax.expr parser =
-    fn st =>
-      bind typedExp (fn e1 =>
-          (reserved "andalso" >>
-          bind andalsoExp (fn e2 =>
-          const (Syntax.EAndAlso (e1, e2))))
-      <|> const e1) st
-  and orelseExpr : Syntax.expr parser =
-    fn st =>
-      bind andalsoExp (fn e1 =>
-          (reserved "orelse" >>
-          bind orelseExpr (fn e2 =>
-          const (Syntax.EOrElse (e1, e2))))
-      <|> const e1) st
-  and expr : Syntax.expr parser = fn st =>
-      ((reserved "fn" >>
-      bind pat (fn p =>
-      reserved "=>" >>
-      bind expr (fn e =>
-      const (Syntax.ELambda (p, e)))))
-  <|> (reserved "case" >>
-      bind expr (fn e =>
-      reserved "of" >>
-      bind
-        (sepBy1
-            (bind pat (fn p =>
-            reserved "=>" >>
-            bind expr (fn e =>
-            const (p, e))))
-          (reserved "|")) (fn arms =>
-      const (Syntax.ECase (e, arms)))))
-  <|> orelseExpr) st
-  and dec : Syntax.dec option parser = fn st =>
-      (bind (false <$ reserved "infix" <|> true <$ reserved "infixr") (fn direction =>
-      bind (integer <|> const 0) (fn level =>
-      bind (many1 identifier) (fn ops =>
-      updateUserState
-        (fn {infixTable} =>
-          let val (leftOps, rightOps) = Vector.sub (infixTable, level)
-          in
-            if direction
-            then {infixTable = Vector.update (infixTable, level, (leftOps, ops @ rightOps))}
-            else {infixTable = Vector.update (infixTable, level, (ops @ leftOps, rightOps))}
-          end) >>
-      const NONE)))
-  <|> (reserved "datatype" >>
-          (between (symbol "(") (symbol ")") (sepBy1 tyvar (symbol ","))
-      <|> (fn x => [x]) <$> tyvar
-      <|> const []) >>
-      bind identifier (fn name =>
-      reserved "=" >>
-      bind
-        (sepBy1
-          (bind (infixIdentifier <|> identifier) (fn con =>
-              (reserved "of" >>
-              bind parseType (fn ty =>
-              const (con, SOME ty)))
-          <|> const (con, NONE)))
-          (reserved "|")) (fn cons =>
-      const (SOME (Syntax.DDatatype (name, cons))))))
-  <|> (reserved "val" >>
-      bind (true <$ reserved "rec" <|> const false) (fn isRec =>
-      bind pat (fn p =>
-      reserved "=" >>
-      bind expr (fn e =>
-      const
-        (SOME
-          (if isRec
-          then Syntax.DValRec (p, e)
-          else Syntax.DVal (p, e)))))))
-  <|> (reserved "fun" >>
-      bind
-        (sepBy1
-          (bind (bind atpat (fn pat1 =>
-              bind infixIdentifier (fn infixOp =>
-              bind atpat (fn pat2 =>
-              const (infixOp, [Syntax.PTuple [pat1, pat2]])))
-          <|> (case pat1 of
-                Syntax.PVar name =>
-                  bind (many1 atpat) (fn args =>
-                  const (name, args))
-              | _ => unexpected "pattern"))) (fn (name, args) =>
-          reserved "=" >>
-          bind expr (fn body =>
-          const (name, args, body))))
-          (reserved "|")) (fn cases =>
-      let val (name, _, _) = hd cases
-      in
-        if not (List.all (fn (n, _, _) => n = name) cases)
-        then raise Fail "clauses do not all have same function name"
-        else const (SOME (Syntax.DFun (name, map (fn (_, x, y) => (x, y)) cases)))
-      end))) st
-
-  val rec strdec : Syntax.dec option parser = fn st =>
-      ((reserved "structure" >>
-      bind identifier (fn strID =>
-      reserved "=" >>
-      reserved "struct" >>
-      bind (many strdec) (fn bindings =>
-      reserved "end" >>
-      const (SOME (Syntax.DStruct (strID, List.mapPartial (fn x => x) bindings))))))
-  <|> dec) st
-
-  (* There's ambiguity between pattern variables and constructors that can only
-   * be resolved by checking for constructors in scope *)
-  fun fixPatConstructors (constructors : unit StringMap.map) (Syntax.PVar v) : Syntax.pat =
-        if isSome (StringMap.lookup v constructors)
-        then Syntax.PCon ([v], Syntax.PTuple [])
-        else Syntax.PVar v
-    | fixPatConstructors constructors (Syntax.PTuple pats) = Syntax.PTuple (map (fixPatConstructors constructors) pats)
-    | fixPatConstructors constructors (Syntax.PCon (con, arg)) = Syntax.PCon (con, fixPatConstructors constructors arg)
-    | fixPatConstructors _ pat = pat
-
-  fun findConstructors (Syntax.DDatatype (_, cases)) : string list =
-        List.mapPartial
-          (fn (constructor, NONE) => SOME constructor
-            | _ => NONE)
-          cases
-    | findConstructors _ = []
-
-  fun fixDecConstructors (constructors : unit StringMap.map) (Syntax.DVal (pat, body)) : Syntax.dec =
-        Syntax.DVal (fixPatConstructors constructors pat, fixConstructors constructors body)
-    | fixDecConstructors constructors (Syntax.DValRec (pat, body)) =
-        Syntax.DValRec (fixPatConstructors constructors pat, fixConstructors constructors body)
-    | fixDecConstructors constructors (Syntax.DFun (f, arms)) =
-        Syntax.DFun (f, map (fn (args, body) => (map (fixPatConstructors constructors) args, fixConstructors constructors body)) arms)
-    | fixDecConstructors _ (decl as Syntax.DDatatype _) = decl
-    | fixDecConstructors constructors (Syntax.DStruct (name, decs)) =
-        let
-          val constructors = ref constructors
-          val decs : Syntax.dec list =
-            map
-              (fn dec =>
-                (constructors := foldl (fn (x, acc) => StringMap.insert x () acc) (!constructors) (findConstructors dec) ;
-                fixDecConstructors (!constructors) dec))
-              decs
-        in Syntax.DStruct (name, decs)
-        end
-
-  and fixConstructors (constructors : unit StringMap.map) (Syntax.ETuple exprs) : Syntax.expr =
-        Syntax.ETuple (map (fixConstructors constructors) exprs)
-    | fixConstructors constructors (Syntax.EList exprs) =
-        Syntax.EList (map (fixConstructors constructors) exprs)
-    | fixConstructors constructors (Syntax.EApp (func, arg)) =
-        Syntax.EApp (fixConstructors constructors func, fixConstructors constructors arg)
-    | fixConstructors constructors (Syntax.ETyped (expr, ty)) =
-        Syntax.ETyped (fixConstructors constructors expr, ty)
-    | fixConstructors constructors (Syntax.EAndAlso (e1, e2)) =
-        Syntax.EAndAlso (fixConstructors constructors e1, fixConstructors constructors e2)
-    | fixConstructors constructors (Syntax.EOrElse (e1, e2)) =
-        Syntax.EOrElse (fixConstructors constructors e1, fixConstructors constructors e2)
-    | fixConstructors constructors (Syntax.ELet (decs, body)) =
-        let
-          val constructors = ref constructors
-          val decs =
-            map
-              (fn dec =>
-                (constructors := foldl (fn (x, acc) => StringMap.insert x () acc) (!constructors) (findConstructors dec) ;
-                fixDecConstructors (!constructors) dec))
-              decs
-        in Syntax.ELet (decs, fixConstructors (!constructors) body)
-        end
-    | fixConstructors constructors (Syntax.ELambda (pat, body)) =
-        Syntax.ELambda (fixPatConstructors constructors pat, fixConstructors constructors body)
-    | fixConstructors constructors (Syntax.ECase (expr, arms)) =
-        Syntax.ECase (fixConstructors constructors expr, map (fn (pat, expr) => (fixPatConstructors constructors pat, fixConstructors constructors expr)) arms)
-    | fixConstructors _ expr = expr
-
-  val program : Syntax.expr parser =
-    bind (many strdec) (fn decs =>
-    const (fixConstructors StringMap.empty (Syntax.ELet (List.mapPartial (fn x => x) decs, Syntax.EInt 0))))
-  fun parse (f : string) : (string, Syntax.expr) Result.either = runParser program f
-end