Mercurial > urweb

comparison src/compiler.sml @ 201:f2cac0dba9bf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Consolidating compiler phase interface and adding timing
author Adam Chlipala <adamc@hcoop.net>
date Tue, 12 Aug 2008 14:40:07 -0400
parents 8a70e2919e86
children af5bd54cbbd7
comparison
equal deleted inserted replaced
200:5dbba661deab 201:f2cac0dba9bf
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 = 38 type job = string list
39
40 type ('src, 'dst) phase = {
41 func : 'src -> 'dst,
42 print : 'dst -> Print.PD.pp_desc
43 }
44
45 type pmap = (string * Time.time) list
46
47 type ('src, 'dst) transform = {
48 func : 'src -> 'dst option,
49 print : 'dst -> Print.PD.pp_desc,
50 time : 'src * pmap -> 'dst option * pmap
51 }
52
53 fun transform (ph : ('src, 'dst) phase) name = {
54 func = fn input => let
55 val v = #func ph input
56 in
57 if ErrorMsg.anyErrors () then
58 NONE
59 else
60 SOME v
61 end,
62 print = #print ph,
63 time = fn (input, pmap) => let
64 val befor = Time.now ()
65 val v = #func ph input
66 val elapsed = Time.- (Time.now (), befor)
67 in
68 (if ErrorMsg.anyErrors () then
69 NONE
70 else
71 SOME v,
72 (name, elapsed) :: pmap)
73 end
74 }
75
76 fun op o (tr1 : ('a, 'b) transform, tr2 : ('b, 'c) transform) = {
77 func = fn input => case #func tr1 input of
78 NONE => NONE
79 | SOME v => #func tr2 v,
80 print = #print tr2,
81 time = fn (input, pmap) => let
82 val (ro, pmap) = #time tr1 (input, pmap)
83 in
84 case ro of
85 NONE => (NONE, pmap)
86 | SOME v => #time tr2 (v, pmap)
87 end
88 }
89
90 fun run (tr : ('src, 'dst) transform) = #func tr
91
92 fun runPrint (tr : ('src, 'dst) transform) input =
93 case #func tr input of
94 NONE => print "Failure\n"
95 | SOME v =>
96 (print "Success\n";
97 Print.print (#print tr v);
98 print "\n")
99
100 fun time (tr : ('src, 'dst) transform) input =
39 let 101 let
40 val fname = OS.FileSys.tmpName () 102 val (_, pmap) = #time tr (input, [])
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 Lex.UserDeclarations.initialize ())
56 val file = TextIO.openIn fname
57 fun get _ = TextIO.input file
58 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
59 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
60 val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ())
61 in 103 in
62 TextIO.closeIn file; 104 app (fn (name, time) =>
63 if ErrorMsg.anyErrors () then 105 print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
64 NONE 106 print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
65 else 107 print "\n"
66 case absyn of
67 [(Source.DSgn ("?", (Source.SgnConst sgis, _)), _)] => SOME sgis
68 | _ => NONE
69 end 108 end
70 handle LrParser.ParseError => NONE 109
71 110 fun timePrint (tr : ('src, 'dst) transform) input =
72 fun testLig fname = 111 let
73 case parseLig fname of 112 val (ro, pmap) = #time tr (input, [])
74 NONE => () 113 in
75 | SOME sgis => 114 app (fn (name, time) =>
76 app (fn sgi => (Print.print (SourcePrint.p_sgn_item sgi); 115 print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
77 print "\n")) sgis 116 print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
117 print "\n";
118 case ro of
119 NONE => print "Failure\n"
120 | SOME v =>
121 (print "Success\n";
122 Print.print (#print tr v);
123 print "\n")
124 end
125
126 val parseLig =
127 {func = fn filename => let
128 val fname = OS.FileSys.tmpName ()
129 val outf = TextIO.openOut fname
130 val () = TextIO.output (outf, "sig\n")
131 val inf = TextIO.openIn filename
132 fun loop () =
133 case TextIO.inputLine inf of
134 NONE => ()
135 | SOME line => (TextIO.output (outf, line);
136 loop ())
137 val () = loop ()
138 val () = TextIO.closeIn inf
139 val () = TextIO.closeOut outf
140
141 val () = (ErrorMsg.resetErrors ();
142 ErrorMsg.resetPositioning filename;
143 Lex.UserDeclarations.initialize ())
144 val file = TextIO.openIn fname
145 fun get _ = TextIO.input file
146 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
147 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
148 val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ())
149 in
150 TextIO.closeIn file;
151 case absyn of
152 [(Source.DSgn ("?", (Source.SgnConst sgis, _)), _)] => sgis
153 | _ => (ErrorMsg.errorAt {file = filename,
154 first = {line = 0,
155 char = 0},
156 last = {line = 0,
157 char = 0}} "Not a signature";
158 [])
159 end
160 handle LrParser.ParseError => [],
161 print = Print.p_list_sep Print.PD.newline SourcePrint.p_sgn_item}
78 162
79 (* The main parsing routine *) 163 (* The main parsing routine *)
80 fun parseLac filename = 164 val parseLac = {
81 let 165 func = fn filename =>
82 val () = (ErrorMsg.resetErrors (); 166 let
83 ErrorMsg.resetPositioning filename; 167 val () = (ErrorMsg.resetErrors ();
84 Lex.UserDeclarations.initialize ()) 168 ErrorMsg.resetPositioning filename;
85 val file = TextIO.openIn filename 169 Lex.UserDeclarations.initialize ())
86 fun get _ = TextIO.input file 170 val file = TextIO.openIn filename
87 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s 171 fun get _ = TextIO.input file
88 val lexer = LrParser.Stream.streamify (Lex.makeLexer get) 172 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
89 val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ()) 173 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
90 in 174 val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ())
91 TextIO.closeIn file; 175 in
92 if ErrorMsg.anyErrors () then 176 TextIO.closeIn file;
93 NONE 177 case absyn of
94 else 178 [(Source.DSgn ("?", _), _)] =>
95 case absyn of 179 (ErrorMsg.errorAt {file = filename,
96 [(Source.DSgn ("?", _), _)] => 180 first = {line = 0,
97 (ErrorMsg.error "File starts with 'sig'"; 181 char = 0},
98 NONE) 182 last = {line = 0,
99 | _ => SOME absyn 183 char = 0}} "File starts with 'sig'";
100 end 184 [])
101 handle LrParser.ParseError => NONE 185 | _ => absyn
102 186 end
103 fun testLac fname = 187 handle LrParser.ParseError => [],
104 case parseLac fname of 188 print = SourcePrint.p_file}
105 NONE => ()
106 | SOME file => (Print.print (SourcePrint.p_file file);
107 print "\n")
108
109 type job = string list
110 189
111 fun capitalize "" = "" 190 fun capitalize "" = ""
112 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) 191 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
113 192
114 fun parse fnames = 193 val parse = {
115 let 194 func = fn fnames =>
116 fun nameOf fname = capitalize (OS.Path.file fname) 195 let
117 196 fun nameOf fname = capitalize (OS.Path.file fname)
118 fun parseOne fname = 197
119 let 198 fun parseOne fname =
120 val mname = nameOf fname 199 let
121 val lac = OS.Path.joinBaseExt {base = fname, ext = SOME "lac"} 200 val mname = nameOf fname
122 val lig = OS.Path.joinBaseExt {base = fname, ext = SOME "lig"} 201 val lac = OS.Path.joinBaseExt {base = fname, ext = SOME "lac"}
123 202 val lig = OS.Path.joinBaseExt {base = fname, ext = SOME "lig"}
124 val sgnO = 203
125 if Posix.FileSys.access (lig, []) then 204 val sgnO =
126 case parseLig lig of 205 if Posix.FileSys.access (lig, []) then
127 NONE => NONE 206 SOME (Source.SgnConst (#func parseLig lig),
128 | SOME sgis => SOME (Source.SgnConst sgis, {file = lig, 207 {file = lig,
129 first = ErrorMsg.dummyPos, 208 first = ErrorMsg.dummyPos,
130 last = ErrorMsg.dummyPos}) 209 last = ErrorMsg.dummyPos})
131 else 210 else
132 NONE 211 NONE
133 212
134 val loc = {file = lac, 213 val loc = {file = lac,
135 first = ErrorMsg.dummyPos, 214 first = ErrorMsg.dummyPos,
136 last = ErrorMsg.dummyPos} 215 last = ErrorMsg.dummyPos}
137 in 216
138 case parseLac lac of 217 val ds = #func parseLac lac
139 NONE => NONE 218 in
140 | SOME ds => 219 (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
141 SOME (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc) 220 end
142 end 221
143 222 val ds = map parseOne fnames
144 val ds = List.mapPartial parseOne fnames 223 in
145 val ds = 224 let
146 let 225 val final = nameOf (List.last fnames)
147 val final = nameOf (List.last fnames) 226 in
148 in 227 ds @ [(Source.DExport (Source.StrVar final, ErrorMsg.dummySpan), ErrorMsg.dummySpan)]
149 ds @ [(Source.DExport (Source.StrVar final, ErrorMsg.dummySpan), ErrorMsg.dummySpan)] 228 end handle Empty => ds
150 end handle Empty => ds 229 end,
151 in 230 print = SourcePrint.p_file
152 if ErrorMsg.anyErrors () then 231 }
153 NONE 232
154 else 233 val toParse = transform parse "parse"
155 SOME ds 234
156 end 235 val elaborate = {
157 236 func = fn file => let
158 fun elaborate job = 237 val basis = #func parseLig "lib/basis.lig"
159 case parseLig "lib/basis.lig" of 238 in
160 NONE => NONE 239 Elaborate.elabFile basis ElabEnv.empty file
161 | SOME empty => 240 end,
162 case parse job of 241 print = ElabPrint.p_file ElabEnv.empty
163 NONE => NONE 242 }
164 | SOME file => 243
165 let 244 val toElaborate = toParse o transform elaborate "elaborate"
166 val out = Elaborate.elabFile empty ElabEnv.empty file 245
167 in 246 val explify = {
168 if ErrorMsg.anyErrors () then 247 func = Explify.explify,
169 NONE 248 print = ExplPrint.p_file ExplEnv.empty
170 else 249 }
171 SOME out 250
172 end 251 val toExplify = toElaborate o transform explify "explify"
173 252
174 fun explify job = 253 val corify = {
175 case elaborate job of 254 func = Corify.corify,
176 NONE => NONE 255 print = CorePrint.p_file CoreEnv.empty
177 | SOME file => 256 }
178 if ErrorMsg.anyErrors () then 257
179 NONE 258 val toCorify = toExplify o transform corify "corify"
180 else 259
181 SOME (Explify.explify file) 260 (*fun shake' job =
182
183 fun corify job =
184 case explify job of
185 NONE => NONE
186 | SOME file =>
187 if ErrorMsg.anyErrors () then
188 NONE
189 else
190 SOME (Corify.corify file)
191
192 fun shake' job =
193 case corify job of 261 case corify job of
194 NONE => NONE 262 NONE => NONE
195 | SOME file => 263 | SOME file =>
196 if ErrorMsg.anyErrors () then 264 if ErrorMsg.anyErrors () then
197 NONE 265 NONE
436 NONE => print "Failed\n" 504 NONE => print "Failed\n"
437 | SOME file => 505 | SOME file =>
438 (Print.print (CjrPrint.p_file CjrEnv.empty file); 506 (Print.print (CjrPrint.p_file CjrEnv.empty file);
439 print "\n")) 507 print "\n"))
440 handle CjrEnv.UnboundNamed n => 508 handle CjrEnv.UnboundNamed n =>
441 print ("Unbound named " ^ Int.toString n ^ "\n") 509 print ("Unbound named " ^ Int.toString n ^ "\n")*)
442 510
443 fun compileC {cname, oname, ename} = 511 fun compileC {cname, oname, ename} =
444 let 512 let
445 val compile = "gcc -O3 -I include -c " ^ cname ^ " -o " ^ oname 513 val compile = "gcc -O3 -I include -c " ^ cname ^ " -o " ^ oname
446 val link = "gcc -pthread -O3 clib/lacweb.o " ^ oname ^ " clib/driver.o -o " ^ ename 514 val link = "gcc -pthread -O3 clib/lacweb.o " ^ oname ^ " clib/driver.o -o " ^ ename
451 print "C linking failed\n" 519 print "C linking failed\n"
452 else 520 else
453 print "Success\n" 521 print "Success\n"
454 end 522 end
455 523
456 fun compile job = 524 (*fun compile job =
457 case cjrize job of 525 case cjrize job of
458 NONE => print "Laconic compilation failed\n" 526 NONE => print "Laconic compilation failed\n"
459 | SOME file => 527 | SOME file =>
460 if ErrorMsg.anyErrors () then 528 if ErrorMsg.anyErrors () then
461 print "Laconic compilation failed\n" 529 print "Laconic compilation failed\n"
470 in 538 in
471 Print.fprint s (CjrPrint.p_file CjrEnv.empty file); 539 Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
472 TextIO.closeOut outf; 540 TextIO.closeOut outf;
473 541
474 compileC {cname = cname, oname = oname, ename = ename} 542 compileC {cname = cname, oname = oname, ename = ename}
475 end 543 end*)
476 544
477 end 545 end