Mercurial > urweb
diff src/compiler.sml @ 55:5c97b7cd912b
Parsing signature files
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 22 Jun 2008 11:04:10 -0400 |
parents | 02f42e9a1825 |
children | d3cc191cb25f |
line wrap: on
line diff
--- a/src/compiler.sml Sun Jun 22 10:53:11 2008 -0400 +++ b/src/compiler.sml Sun Jun 22 11:04:10 2008 -0400 @@ -35,6 +35,46 @@ structure Lex = Lex structure LrParser = LrParser) +fun parseLig filename = + let + val fname = OS.FileSys.tmpName () + val outf = TextIO.openOut fname + val () = TextIO.output (outf, "sig\n") + val inf = TextIO.openIn filename + fun loop () = + case TextIO.inputLine inf of + NONE => () + | SOME line => (TextIO.output (outf, line); + loop ()) + val () = loop () + val () = TextIO.closeIn inf + val () = TextIO.closeOut outf + + val () = (ErrorMsg.resetErrors (); + ErrorMsg.resetPositioning filename) + val file = TextIO.openIn fname + fun get _ = TextIO.input file + fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s + val lexer = LrParser.Stream.streamify (Lex.makeLexer get) + val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ()) + in + TextIO.closeIn file; + if ErrorMsg.anyErrors () then + NONE + else + case absyn of + [(Source.DSgn ("?", (Source.SgnConst sgis, _)), _)] => SOME sgis + | _ => NONE + end + handle LrParser.ParseError => NONE + +fun testLig fname = + case parseLig fname of + NONE => () + | SOME sgis => + app (fn sgi => (Print.print (SourcePrint.p_sgn_item sgi); + print "\n")) sgis + (* The main parsing routine *) fun parse filename = let @@ -50,7 +90,11 @@ if ErrorMsg.anyErrors () then NONE else - SOME absyn + case absyn of + [(Source.DSgn ("?", _), _)] => + (ErrorMsg.error "File starts with 'sig'"; + NONE) + | _ => SOME absyn end handle LrParser.ParseError => NONE