diff options
Diffstat (limited to 'parser.sml')
| -rw-r--r-- | parser.sml | 74 |
1 files changed, 37 insertions, 37 deletions
@@ -14,7 +14,7 @@ struct datatype message = Unexpected of string | Expected of string datatype parseError = ParseError of sourceLoc * message list datatype hints = Hints of string list - type 'a parser = state -> response * (parseError, 'a * state * hints) Either.either + type 'a parser = state -> response * (parseError, 'a * state * hints) Result.either val reservedWords = [ "abstype", "and", "andalso", "as", "case", "datatype", "do", "else" @@ -60,12 +60,12 @@ struct fun stateLoc (State (_, loc, _)) : sourceLoc = loc - fun unpackParserResponse (_ : response, Either.Left err : (parseError, 'a * state * hints) Either.either) : (string, 'a) Either.either = - Either.Left (printError err) - | unpackParserResponse (_, Either.Right (a, st, _)) = + 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 (stateStream st) - then Either.Right a - else Either.Left (printSourceLoc (stateLoc st) ^ " Syntax error: trailing characters") + then Result.Right a + else Result.Left (printSourceLoc (stateLoc st) ^ " Syntax error: trailing characters") fun newLoc (fileName : string) : sourceLoc = SourceLoc (fileName, 1, 1) @@ -81,18 +81,18 @@ struct fun updateUserState (f : userState -> userState) : userState parser = fn State (stream, loc, us) => let val st' = f us - in (Empty, Either.Right (st', State (stream, loc, st'), Hints [])) + in (Empty, Result.Right (st', State (stream, loc, st'), Hints [])) end val getUserState : userState parser = updateUserState (fn x => x) - fun runParser (p : 'a parser) (fileName : string) : (string, 'a) Either.either = + 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 - Either.Right x => x - | Either.Left e => raise Fail ("Parse failed: " ^ e) + Result.Right x => x + | Result.Left e => raise Fail ("Parse failed: " ^ e) fun mergeHints (Hints a) (Hints b) : hints = Hints (a @ b) @@ -115,33 +115,33 @@ struct fun bind (p : 'a parser) (f : 'a -> 'b parser) : 'b parser = fn st => case p st of - (consumed1, Either.Right (a, st', hints)) => + (consumed1, Result.Right (a, st', hints)) => (case (f a) st' of - (Consumed, Either.Right success) => (Consumed, Either.Right success) - | (Empty, Either.Right (b, st'', hints')) => (consumed1, Either.Right (b, st'', mergeHints hints hints')) - | (Consumed, Either.Left err) => (Consumed, Either.Left (withHints hints err)) - | (Empty, Either.Left err) => (consumed1, Either.Left (withHints hints err))) - | (consumed, Either.Left err) => (consumed, Either.Left err) + (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, Either.Right (a, st', _)) => (consumed, Either.Right (a, st', Hints [msg])) - | (consumed, Either.Left (ParseError (loc, _))) => (consumed, Either.Left (ParseError (loc, [Expected msg]))) + (consumed, Result.Right (a, st', _)) => (consumed, Result.Right (a, st', Hints [msg])) + | (consumed, Result.Left (ParseError (loc, _))) => (consumed, Result.Left (ParseError (loc, [Expected msg]))) fun (p1 : 'a parser) <|> (p2 : 'a parser) : 'a parser = fn st => case p1 st of - (Empty, Either.Left err) => + (Empty, Result.Left err) => (case p2 st of - (Empty, Either.Right (a, st', hints)) => (Empty, Either.Right (a, st', mergeHints (errToHints err) hints)) - | (Empty, Either.Left err') => (Empty, Either.Left (mergeError err err')) + (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, Either.Right (x, st, Hints [])) + 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) @@ -150,7 +150,7 @@ struct fun try (p : 'a parser) : 'a parser = fn st => case p st of - (Consumed, Either.Left err) => (Empty, Either.Left err) + (Consumed, Result.Left err) => (Empty, Result.Left err) | res => res fun updatePosChar (SourceLoc (file, row, column)) (c : char) : sourceLoc = @@ -162,11 +162,11 @@ struct fun satisfy (pred : char -> bool) : char parser = fn State (stream, loc, us) => case TextIO.StreamIO.input1 stream of - NONE => (Empty, Either.Left (ParseError (loc, [Expected "UNKNOWN"]))) + NONE => (Empty, Result.Left (ParseError (loc, [Expected "UNKNOWN"]))) | SOME (c, stream') => if pred c - then (Consumed, Either.Right (c, State (stream', updatePosChar loc c, us), Hints [])) - else (Empty, Either.Left (ParseError (loc, [Expected "UNKNOWN"]))) + then (Consumed, Result.Right (c, State (stream', updatePosChar loc c, us), Hints [])) + else (Empty, Result.Left (ParseError (loc, [Expected "UNKNOWN"]))) fun parseChar (c : char) : char parser = satisfy (fn c' => c = c') <?> str c @@ -182,16 +182,16 @@ struct fn st => let fun walk xs s' = case p s' of - (Consumed, Either.Right (x, s'', _)) => walk (x :: xs) s'' - | (Consumed, Either.Left err) => (Consumed, Either.Left err) - | (Empty, Either.Right _) => manyErr () - | (Empty, Either.Left err) => (Consumed, Either.Right (rev xs, s', errToHints err)) + (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, Either.Right (x, s', _)) => walk [x] s' - | (Consumed, Either.Left err) => (Consumed, Either.Left err) - | (Empty, Either.Right _) => manyErr () - | (Empty, Either.Left err) => (Empty, Either.Right ([], st, errToHints err)) + (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 = @@ -204,7 +204,7 @@ struct val spaces : unit parser = many space <$ () <?> "white space" fun unexpected (s : string) : 'a parser = - fn st => (Empty, Either.Left (ParseError (stateLoc st, [Unexpected s]))) + fn st => (Empty, Result.Left (ParseError (stateLoc st, [Unexpected s]))) val letter : char parser = satisfy Char.isAlpha <?> "letter" @@ -431,6 +431,6 @@ struct and expr : Syntax.expr parser = fn st => typedExp st and dec : Syntax.dec parser = fn st => (reserved "val" >> reserved "_" >> reserved "=" >> Syntax.DVal <$> expr) st - val program : Syntax.expr parser = (fn decs => Syntax.ELet (decs, Syntax.ETuple [])) <$> many dec - fun parse (f : string) : (string, Syntax.expr) Either.either = runParser program f + val program : Syntax.expr parser = (fn decs => Syntax.ELet (decs, Syntax.EInt 0)) <$> many dec + fun parse (f : string) : (string, Syntax.expr) Result.either = runParser program f end |