Add support for comments

1 files changed, 14 insertions, 9 deletions

diff --git a/Parser.sml b/Parser.sml
index e464332..f632380 100644
--- a/Parser.sml
+++ b/Parser.sml
@@ -186,7 +186,7 @@ struct
   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 ^ "'"
+    | c1 :: cs => s <$ try (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"
 
@@ -213,8 +213,6 @@ struct
 
   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]})
 
@@ -225,8 +223,18 @@ struct
   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 notFollowedBy (p : char parser) : unit parser =
+    try (bind (try p) (fn c => unexpected (str c)) <|> const ())
+
+  val comment : unit parser =
+    parseString "(*" >>
+    (* TODO: support nested comments (really?) *)
+    many (() <$ satisfy (fn c => c <> #"*") <|> try (satisfy (fn _ => true) >> notFollowedBy (parseChar #")"))) >>
+    parseString "*)" >>
+    const ()
+
+  (* some day, whiteSpace will support comments - that day is today *)
+  val whiteSpace = many (() <$ space <|> comment) <?> "white space"
 
   fun lexeme (p : 'a parser) : 'a parser =
     bind p (fn x =>
@@ -286,10 +294,6 @@ struct
 
   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 =
@@ -666,6 +670,7 @@ struct
     | fixConstructors _ expr = expr
 
   val program : Syntax.expr parser =
+    whiteSpace >>
     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