From c2bb80335b590c9118bad0da1d4407942b3765de Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rosehogenson@posteo.net>
Date: Fri, 16 May 2025 18:05:33 -0700
Subject: Add support for comments

---
 Parser.sml          | 23 ++++++++++++++---------
 tests/01-simple.sml |  9 +++++++++
 2 files changed, 23 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
diff --git a/tests/01-simple.sml b/tests/01-simple.sml
index 3e87f14..e41f9b4 100644
--- a/tests/01-simple.sml
+++ b/tests/01-simple.sml
@@ -1 +1,10 @@
+(*
+  This file is part of Foobar.
+
+  Foobar is free software: you can redistribute it and/or modify it under the
+  terms of the GNU General Public License as published by the Free Software
+  Foundation, either version 3 of the License, or (at your option) any
+  later version.
+*)
+
 val _ = __builtin "exit" 42
-- 
cgit v1.3.1