diff options
Diffstat (limited to 'parser.sml')
| -rw-r--r-- | parser.sml | 55 |
1 files changed, 35 insertions, 20 deletions
@@ -145,7 +145,7 @@ struct fun (f : 'a -> 'b) <$> (p : 'a parser) : 'b parser = bind p (const o f) - fun (p : 'a parser) <$ (x : 'b) : 'b parser = (fn _ => x) <$> p + fun (x : 'a) <$ (p : 'b parser) : 'a parser = (fn _ => x) <$> p fun try (p : 'a parser) : 'a parser = fn st => @@ -174,7 +174,7 @@ struct fun parseString (s : string) : string parser = case explode s of [] => const "" - | c1 :: cs => foldl (fn (c, p) => p >> parseChar c) (parseChar c1) cs <$ s <?> "'" ^ String.toString s ^ "'" + | 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" @@ -201,7 +201,7 @@ struct val space : char parser = satisfy Char.isSpace <?> "space" - val spaces : unit parser = many space <$ () <?> "white space" + val spaces : unit parser = () <$ many space <?> "white space" fun unexpected (s : string) : 'a parser = fn st => (Empty, Result.Left (ParseError (stateLoc st, [Unexpected s]))) @@ -289,13 +289,13 @@ struct const (valOf (Int.fromString (implode digits))))) val stringInternalChar : char parser = - (parseString "\\" >> (parseChar #"a" <$ #"\a" - <|> parseChar #"b" <$ #"\b" - <|> parseChar #"t" <$ #"\t" - <|> parseChar #"n" <$ #"\n" - <|> parseChar #"v" <$ #"\v" - <|> parseChar #"f" <$ #"\f" - <|> parseChar #"r" <$ #"\r" + (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") @@ -311,21 +311,24 @@ struct 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 identifier (fn longtycon => parseTycons (Syntax.Tycon ([ty], longtycon))) <|> const ty - val rec parseSingleType : Syntax.etype parser = - fn st => + val rec parseSingleType : Syntax.etype parser = fn st => (Syntax.Tyvar <$> identifier - <|> (symbol "(" >> - bind (sepBy1 parseType (symbol ",")) (fn types => - symbol ")" >> - (case types of - [x] => const x - | _ => bind identifier (fn longtycon => - const (Syntax.Tycon (types, longtycon))))))) st + <|> bind (between (symbol "(") (symbol ")") (sepBy1 parseType (symbol ","))) (fn types => + case types of + [x] => const x + | _ => bind identifier (fn longtycon => + const (Syntax.Tycon (types, longtycon))))) st and parseTycon : Syntax.etype parser = fn st => bind parseSingleType parseTycons st @@ -344,6 +347,12 @@ struct const (Syntax.Tyfun (ty, ty')))) <|> const ty) st + val rec atpat : Syntax.pat parser = fn st => + (Syntax.PWild <$ reserved "_" + <|> between (symbol "(") (symbol ")") pat + <|> Syntax.PVar <$> identifier) st + and pat : Syntax.pat parser = fn st => atpat st + fun leftOp (i : int) : Syntax.expr parser = bind getUserState (fn UserState (_, opTable) => let val (leftOps, _) = Vector.sub (opTable, i) @@ -430,7 +439,13 @@ struct <|> const e1) st and handleExpr : Syntax.expr parser = fn st => orelseExpr st and raiseExpr : Syntax.expr parser = fn st => handleExpr st - and fnExpr : Syntax.expr parser = fn st => ((reserved "fn" >> reserved "_" >> reserved "=>" >> Syntax.ELambda <$> expr) <|> raiseExpr) st + and fnExpr : Syntax.expr parser = fn st => + ((reserved "fn" >> + bind pat (fn p => + reserved "=>" >> + bind expr (fn e => + const (Syntax.ELambda (p, e))))) + <|> raiseExpr) st and expr : Syntax.expr parser = fn st => fnExpr st and dec : Syntax.dec parser = fn st => (reserved "val" >> reserved "_" >> reserved "=" >> Syntax.DVal <$> expr) st |