Mercurial > urweb

comparison src/compiler.sml @ 109:813e5a52063d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove closure conversion in favor of zany fun with modules, which also replaces 'page'
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Jul 2008 10:17:06 -0400
parents 5f04adf47f48
children 3739af9e727a
comparison
equal deleted inserted replaced
108:f59553dc1b6a 109:813e5a52063d
109 fun capitalize "" = "" 109 fun capitalize "" = ""
110 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) 110 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
111 111
112 fun parse fnames = 112 fun parse fnames =
113 let 113 let
114 fun nameOf fname = capitalize (OS.Path.file fname)
115
114 fun parseOne fname = 116 fun parseOne fname =
115 let 117 let
116 val mname = capitalize (OS.Path.file fname) 118 val mname = nameOf fname
117 val lac = OS.Path.joinBaseExt {base = fname, ext = SOME "lac"} 119 val lac = OS.Path.joinBaseExt {base = fname, ext = SOME "lac"}
118 val lig = OS.Path.joinBaseExt {base = fname, ext = SOME "lig"} 120 val lig = OS.Path.joinBaseExt {base = fname, ext = SOME "lig"}
119 121
120 val sgnO = 122 val sgnO =
121 if Posix.FileSys.access (lig, []) then 123 if Posix.FileSys.access (lig, []) then
135 NONE => NONE 137 NONE => NONE
136 | SOME ds => 138 | SOME ds =>
137 SOME (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc) 139 SOME (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
138 end 140 end
139 141
140 val ds = List.mapPartial parseOne fnames 142 val ds = List.mapPartial parseOne fnames
143 val ds =
144 let
145 val final = nameOf (List.last fnames)
146 in
147 ds @ [(Source.DExport (Source.StrVar final, ErrorMsg.dummySpan), ErrorMsg.dummySpan)]
148 end handle Empty => ds
141 in 149 in
142 if ErrorMsg.anyErrors () then 150 if ErrorMsg.anyErrors () then
143 NONE 151 NONE
144 else 152 else
145 SOME ds 153 SOME ds
222 if ErrorMsg.anyErrors () then 230 if ErrorMsg.anyErrors () then
223 NONE 231 NONE
224 else 232 else
225 SOME (MonoOpt.optimize file) 233 SOME (MonoOpt.optimize file)
226 234
227 fun cloconv job = 235 fun cjrize job =
228 case mono_opt job of 236 case mono_opt job of
229 NONE => NONE
230 | SOME file =>
231 if ErrorMsg.anyErrors () then
232 NONE
233 else
234 SOME (Cloconv.cloconv file)
235
236 fun cjrize job =
237 case cloconv job of
238 NONE => NONE 237 NONE => NONE
239 | SOME file => 238 | SOME file =>
240 if ErrorMsg.anyErrors () then 239 if ErrorMsg.anyErrors () then
241 NONE 240 NONE
242 else 241 else
318 NONE => print "Failed\n" 317 NONE => print "Failed\n"
319 | SOME file => 318 | SOME file =>
320 (Print.print (MonoPrint.p_file MonoEnv.empty file); 319 (Print.print (MonoPrint.p_file MonoEnv.empty file);
321 print "\n")) 320 print "\n"))
322 handle MonoEnv.UnboundNamed n => 321 handle MonoEnv.UnboundNamed n =>
323 print ("Unbound named " ^ Int.toString n ^ "\n")
324
325 fun testCloconv job =
326 (case cloconv job of
327 NONE => print "Failed\n"
328 | SOME file =>
329 (Print.print (FlatPrint.p_file FlatEnv.empty file);
330 print "\n"))
331 handle FlatEnv.UnboundNamed n =>
332 print ("Unbound named " ^ Int.toString n ^ "\n") 322 print ("Unbound named " ^ Int.toString n ^ "\n")
333 323
334 fun testCjrize job = 324 fun testCjrize job =
335 (case cjrize job of 325 (case cjrize job of
336 NONE => print "Failed\n" 326 NONE => print "Failed\n"