Parsing has never been this much fun

[hcoop/domtool2.git] / src / parse.sml

diff --git a/src/parse.sml b/src/parse.sml
new file mode 100644 (file)
index 0000000..5a5ce3f
--- /dev/null
+++ b/src/parse.sml
@@ -0,0 +1,43 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program 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 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+*)
+
+(* Domtool configuration language parser *)
+
+structure Parse :> PARSE =
+  struct 
+
+    structure DomtoolLrVals = DomtoolLrValsFn(structure Token = LrParser.Token)
+    structure Lex = DomtoolLexFn(structure Tokens = DomtoolLrVals.Tokens)
+    structure DomtoolP = Join(structure ParserData = DomtoolLrVals.ParserData
+                           structure Lex = Lex
+                           structure LrParser = LrParser)
+
+  (* The main parsing routine *)
+  fun parse filename =
+    let val _ = (ErrorMsg.reset(); ErrorMsg.fileName := filename)
+       val file = TextIO.openIn filename
+       fun get _ = TextIO.input file
+       fun parseerror(s,p1,p2) = ErrorMsg.error (SOME (p1,p2)) s
+       val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
+       val (absyn, _) = DomtoolP.parse(30,lexer, parseerror, ())
+    in
+      TextIO.closeIn file;
+      absyn
+    end
+      handle LrParser.ParseError => raise ErrorMsg.Error
+end