Mercurial > urweb

comparison src/compiler.sml @ 55:5c97b7cd912b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Parsing signature files
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Jun 2008 11:04:10 -0400
parents 02f42e9a1825
children d3cc191cb25f
comparison
equal deleted inserted replaced
54:a6e185c7c428 55:5c97b7cd912b
33 structure Lex = LacwebLexFn(structure Tokens = LacwebLrVals.Tokens) 33 structure Lex = LacwebLexFn(structure Tokens = LacwebLrVals.Tokens)
34 structure LacwebP = Join(structure ParserData = LacwebLrVals.ParserData 34 structure LacwebP = Join(structure ParserData = LacwebLrVals.ParserData
35 structure Lex = Lex 35 structure Lex = Lex
36 structure LrParser = LrParser) 36 structure LrParser = LrParser)
37 37
38 fun parseLig filename =
39 let
40 val fname = OS.FileSys.tmpName ()
41 val outf = TextIO.openOut fname
42 val () = TextIO.output (outf, "sig\n")
43 val inf = TextIO.openIn filename
44 fun loop () =
45 case TextIO.inputLine inf of
46 NONE => ()
47 | SOME line => (TextIO.output (outf, line);
48 loop ())
49 val () = loop ()
50 val () = TextIO.closeIn inf
51 val () = TextIO.closeOut outf
52
53 val () = (ErrorMsg.resetErrors ();
54 ErrorMsg.resetPositioning filename)
55 val file = TextIO.openIn fname
56 fun get _ = TextIO.input file
57 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
58 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
59 val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ())
60 in
61 TextIO.closeIn file;
62 if ErrorMsg.anyErrors () then
63 NONE
64 else
65 case absyn of
66 [(Source.DSgn ("?", (Source.SgnConst sgis, _)), _)] => SOME sgis
67 | _ => NONE
68 end
69 handle LrParser.ParseError => NONE
70
71 fun testLig fname =
72 case parseLig fname of
73 NONE => ()
74 | SOME sgis =>
75 app (fn sgi => (Print.print (SourcePrint.p_sgn_item sgi);
76 print "\n")) sgis
77
38 (* The main parsing routine *) 78 (* The main parsing routine *)
39 fun parse filename = 79 fun parse filename =
40 let 80 let
41 val () = (ErrorMsg.resetErrors (); 81 val () = (ErrorMsg.resetErrors ();
42 ErrorMsg.resetPositioning filename) 82 ErrorMsg.resetPositioning filename)
48 in 88 in
49 TextIO.closeIn file; 89 TextIO.closeIn file;
50 if ErrorMsg.anyErrors () then 90 if ErrorMsg.anyErrors () then
51 NONE 91 NONE
52 else 92 else
53 SOME absyn 93 case absyn of
94 [(Source.DSgn ("?", _), _)] =>
95 (ErrorMsg.error "File starts with 'sig'";
96 NONE)
97 | _ => SOME absyn
54 end 98 end
55 handle LrParser.ParseError => NONE 99 handle LrParser.ParseError => NONE
56 100
57 fun elaborate env filename = 101 fun elaborate env filename =
58 case parse filename of 102 case parse filename of