Mercurial > urweb

comparison src/compiler.sml @ 244:71bafe66dbe1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Laconic -> Ur
author Adam Chlipala <adamc@hcoop.net>
date Sun, 31 Aug 2008 08:32:18 -0400
parents af5bd54cbbd7
children 40c33706d887
comparison
equal deleted inserted replaced
243:2b9dfaffb008 244:71bafe66dbe1
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
25 * POSSIBILITY OF SUCH DAMAGE. 25 * POSSIBILITY OF SUCH DAMAGE.
26 *) 26 *)
27 27
28 (* Laconic/Web language parser *) 28 (* Ur/Web language parser *)
29 29
30 structure Compiler :> COMPILER = struct 30 structure Compiler :> COMPILER = struct
31 31
32 structure LacwebLrVals = LacwebLrValsFn(structure Token = LrParser.Token) 32 structure UrwebLrVals = UrwebLrValsFn(structure Token = LrParser.Token)
33 structure Lex = LacwebLexFn(structure Tokens = LacwebLrVals.Tokens) 33 structure Lex = UrwebLexFn(structure Tokens = UrwebLrVals.Tokens)
34 structure LacwebP = Join(structure ParserData = LacwebLrVals.ParserData 34 structure UrwebP = Join(structure ParserData = UrwebLrVals.ParserData
35 structure Lex = Lex 35 structure Lex = Lex
36 structure LrParser = LrParser) 36 structure LrParser = LrParser)
37 37
38 type job = string list 38 type job = string list
39 39
121 (print "Success\n"; 121 (print "Success\n";
122 Print.print (#print tr v); 122 Print.print (#print tr v);
123 print "\n") 123 print "\n")
124 end 124 end
125 125
126 val parseLig = 126 val parseUrs =
127 {func = fn filename => let 127 {func = fn filename => let
128 val fname = OS.FileSys.tmpName () 128 val fname = OS.FileSys.tmpName ()
129 val outf = TextIO.openOut fname 129 val outf = TextIO.openOut fname
130 val () = TextIO.output (outf, "sig\n") 130 val () = TextIO.output (outf, "sig\n")
131 val inf = TextIO.openIn filename 131 val inf = TextIO.openIn filename
143 Lex.UserDeclarations.initialize ()) 143 Lex.UserDeclarations.initialize ())
144 val file = TextIO.openIn fname 144 val file = TextIO.openIn fname
145 fun get _ = TextIO.input file 145 fun get _ = TextIO.input file
146 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s 146 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
147 val lexer = LrParser.Stream.streamify (Lex.makeLexer get) 147 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
148 val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ()) 148 val (absyn, _) = UrwebP.parse (30, lexer, parseerror, ())
149 in 149 in
150 TextIO.closeIn file; 150 TextIO.closeIn file;
151 case absyn of 151 case absyn of
152 [(Source.DSgn ("?", (Source.SgnConst sgis, _)), _)] => sgis 152 [(Source.DSgn ("?", (Source.SgnConst sgis, _)), _)] => sgis
153 | _ => (ErrorMsg.errorAt {file = filename, 153 | _ => (ErrorMsg.errorAt {file = filename,
159 end 159 end
160 handle LrParser.ParseError => [], 160 handle LrParser.ParseError => [],
161 print = Print.p_list_sep Print.PD.newline SourcePrint.p_sgn_item} 161 print = Print.p_list_sep Print.PD.newline SourcePrint.p_sgn_item}
162 162
163 (* The main parsing routine *) 163 (* The main parsing routine *)
164 val parseLac = { 164 val parseUr = {
165 func = fn filename => 165 func = fn filename =>
166 let 166 let
167 val () = (ErrorMsg.resetErrors (); 167 val () = (ErrorMsg.resetErrors ();
168 ErrorMsg.resetPositioning filename; 168 ErrorMsg.resetPositioning filename;
169 Lex.UserDeclarations.initialize ()) 169 Lex.UserDeclarations.initialize ())
170 val file = TextIO.openIn filename 170 val file = TextIO.openIn filename
171 fun get _ = TextIO.input file 171 fun get _ = TextIO.input file
172 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s 172 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
173 val lexer = LrParser.Stream.streamify (Lex.makeLexer get) 173 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
174 val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ()) 174 val (absyn, _) = UrwebP.parse (30, lexer, parseerror, ())
175 in 175 in
176 TextIO.closeIn file; 176 TextIO.closeIn file;
177 case absyn of 177 case absyn of
178 [(Source.DSgn ("?", _), _)] => 178 [(Source.DSgn ("?", _), _)] =>
179 (ErrorMsg.errorAt {file = filename, 179 (ErrorMsg.errorAt {file = filename,
196 fun nameOf fname = capitalize (OS.Path.file fname) 196 fun nameOf fname = capitalize (OS.Path.file fname)
197 197
198 fun parseOne fname = 198 fun parseOne fname =
199 let 199 let
200 val mname = nameOf fname 200 val mname = nameOf fname
201 val lac = OS.Path.joinBaseExt {base = fname, ext = SOME "lac"} 201 val ur = OS.Path.joinBaseExt {base = fname, ext = SOME "ur"}
202 val lig = OS.Path.joinBaseExt {base = fname, ext = SOME "lig"} 202 val urs = OS.Path.joinBaseExt {base = fname, ext = SOME "urs"}
203 203
204 val sgnO = 204 val sgnO =
205 if Posix.FileSys.access (lig, []) then 205 if Posix.FileSys.access (urs, []) then
206 SOME (Source.SgnConst (#func parseLig lig), 206 SOME (Source.SgnConst (#func parseUrs urs),
207 {file = lig, 207 {file = urs,
208 first = ErrorMsg.dummyPos, 208 first = ErrorMsg.dummyPos,
209 last = ErrorMsg.dummyPos}) 209 last = ErrorMsg.dummyPos})
210 else 210 else
211 NONE 211 NONE
212 212
213 val loc = {file = lac, 213 val loc = {file = ur,
214 first = ErrorMsg.dummyPos, 214 first = ErrorMsg.dummyPos,
215 last = ErrorMsg.dummyPos} 215 last = ErrorMsg.dummyPos}
216 216
217 val ds = #func parseLac lac 217 val ds = #func parseUr ur
218 in 218 in
219 (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc) 219 (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
220 end 220 end
221 221
222 val ds = map parseOne fnames 222 val ds = map parseOne fnames
232 232
233 val toParse = transform parse "parse" 233 val toParse = transform parse "parse"
234 234
235 val elaborate = { 235 val elaborate = {
236 func = fn file => let 236 func = fn file => let
237 val basis = #func parseLig "lib/basis.lig" 237 val basis = #func parseUrs "lib/basis.urs"
238 in 238 in
239 Elaborate.elabFile basis ElabEnv.empty file 239 Elaborate.elabFile basis ElabEnv.empty file
240 end, 240 end,
241 print = ElabPrint.p_file ElabEnv.empty 241 print = ElabPrint.p_file ElabEnv.empty
242 } 242 }
332 val toCjrize = toMono_opt2 o transform cjrize "cjrize" 332 val toCjrize = toMono_opt2 o transform cjrize "cjrize"
333 333
334 fun compileC {cname, oname, ename} = 334 fun compileC {cname, oname, ename} =
335 let 335 let
336 val compile = "gcc -O3 -I include -c " ^ cname ^ " -o " ^ oname 336 val compile = "gcc -O3 -I include -c " ^ cname ^ " -o " ^ oname
337 val link = "gcc -pthread -O3 clib/lacweb.o " ^ oname ^ " clib/driver.o -o " ^ ename 337 val link = "gcc -pthread -O3 clib/urweb.o " ^ oname ^ " clib/driver.o -o " ^ ename
338 in 338 in
339 if not (OS.Process.isSuccess (OS.Process.system compile)) then 339 if not (OS.Process.isSuccess (OS.Process.system compile)) then
340 print "C compilation failed\n" 340 print "C compilation failed\n"
341 else if not (OS.Process.isSuccess (OS.Process.system link)) then 341 else if not (OS.Process.isSuccess (OS.Process.system link)) then
342 print "C linking failed\n" 342 print "C linking failed\n"
344 print "Success\n" 344 print "Success\n"
345 end 345 end
346 346
347 fun compile job = 347 fun compile job =
348 case run toCjrize job of 348 case run toCjrize job of
349 NONE => print "Laconic compilation failed\n" 349 NONE => print "Ur compilation failed\n"
350 | SOME file => 350 | SOME file =>
351 let 351 let
352 val cname = "/tmp/lacweb.c" 352 val cname = "/tmp/urweb.c"
353 val oname = "/tmp/lacweb.o" 353 val oname = "/tmp/urweb.o"
354 val ename = "/tmp/webapp" 354 val ename = "/tmp/webapp"
355 355
356 val outf = TextIO.openOut cname 356 val outf = TextIO.openOut cname
357 val s = TextIOPP.openOut {dst = outf, wid = 80} 357 val s = TextIOPP.openOut {dst = outf, wid = 80}
358 in 358 in