Mercurial > urweb

comparison src/compiler.sml @ 765:a28982de5645

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Successfully influenced effectful-ness status of FFI func
author Adam Chlipala <adamc@hcoop.net>
date Sat, 02 May 2009 11:27:26 -0400
parents 7f653298dd66
children df09c95085f8
comparison
equal deleted inserted replaced
764:7f653298dd66 765:a28982de5645
42 debug : bool, 42 debug : bool,
43 profile : bool, 43 profile : bool,
44 timeout : int, 44 timeout : int,
45 ffi : string list, 45 ffi : string list,
46 link : string list, 46 link : string list,
47 headers : string list 47 headers : string list,
48 clientToServer : Settings.ffi list,
49 effectful : Settings.ffi list,
50 clientOnly : Settings.ffi list,
51 serverOnly : Settings.ffi list,
52 jsFuncs : (Settings.ffi * string) list
48 } 53 }
49 54
50 type ('src, 'dst) phase = { 55 type ('src, 'dst) phase = {
51 func : 'src -> 'dst, 56 func : 'src -> 'dst,
52 print : 'dst -> Print.PD.pp_desc 57 print : 'dst -> Print.PD.pp_desc
200 | _ => absyn 205 | _ => absyn
201 end 206 end
202 handle LrParser.ParseError => [], 207 handle LrParser.ParseError => [],
203 print = SourcePrint.p_file} 208 print = SourcePrint.p_file}
204 209
205 fun p_job {prefix, database, exe, sql, sources, debug, profile, timeout, ffi, link, headers} = 210 fun p_job {prefix, database, exe, sql, sources, debug, profile,
211 timeout, ffi, link, headers,
212 clientToServer, effectful, clientOnly, serverOnly, jsFuncs} =
206 let 213 let
207 open Print.PD 214 open Print.PD
208 open Print 215 open Print
216
217 fun p_ffi name = p_list_sep (box []) (fn (m, s) =>
218 box [string name, space, string m, string ".", string s, newline])
209 in 219 in
210 box [if debug then 220 box [if debug then
211 box [string "DEBUG", newline] 221 box [string "DEBUG", newline]
212 else 222 else
213 box [], 223 box [],
230 string (Int.toString timeout), 240 string (Int.toString timeout),
231 newline, 241 newline,
232 p_list_sep (box []) (fn s => box [string "Ffi", space, string s, newline]) ffi, 242 p_list_sep (box []) (fn s => box [string "Ffi", space, string s, newline]) ffi,
233 p_list_sep (box []) (fn s => box [string "Header", space, string s, newline]) headers, 243 p_list_sep (box []) (fn s => box [string "Header", space, string s, newline]) headers,
234 p_list_sep (box []) (fn s => box [string "Link", space, string s, newline]) link, 244 p_list_sep (box []) (fn s => box [string "Link", space, string s, newline]) link,
245 p_ffi "ClientToServer" clientToServer,
246 p_ffi "Effectful" effectful,
247 p_ffi "ClientOnly" clientOnly,
248 p_ffi "ServerOnly" serverOnly,
249 p_list_sep (box []) (fn ((m, s), s') =>
250 box [string "JsFunc", space, string m, string ".", string s,
251 space, string "=", space, string s', newline]) jsFuncs,
235 string "Sources:", 252 string "Sources:",
236 p_list string sources, 253 p_list string sources,
237 newline] 254 newline]
238 end 255 end
239 256
286 val profile = ref false 303 val profile = ref false
287 val timeout = ref NONE 304 val timeout = ref NONE
288 val ffi = ref [] 305 val ffi = ref []
289 val link = ref [] 306 val link = ref []
290 val headers = ref [] 307 val headers = ref []
308 val clientToServer = ref []
309 val effectful = ref []
310 val clientOnly = ref []
311 val serverOnly = ref []
312 val jsFuncs = ref []
291 313
292 fun finish sources = 314 fun finish sources =
293 {prefix = Option.getOpt (!prefix, "/"), 315 {prefix = Option.getOpt (!prefix, "/"),
294 database = !database, 316 database = !database,
295 exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename, 317 exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
296 ext = SOME "exe"}), 318 ext = SOME "exe"}),
297 sql = !sql, 319 sql = !sql,
298 debug = !debug, 320 debug = !debug,
299 profile = !profile, 321 profile = !profile,
300 timeout = Option.getOpt (!timeout, 60), 322 timeout = Option.getOpt (!timeout, 60),
301 ffi = !ffi, 323 ffi = rev (!ffi),
302 link = !link, 324 link = rev (!link),
303 headers = !headers, 325 headers = rev (!headers),
326 clientToServer = rev (!clientToServer),
327 effectful = rev (!effectful),
328 clientOnly = rev (!clientOnly),
329 serverOnly = rev (!serverOnly),
330 jsFuncs = rev (!jsFuncs),
304 sources = sources} 331 sources = sources}
305 332
306 fun read () = 333 fun read () =
307 case TextIO.inputLine inf of 334 case TextIO.inputLine inf of
308 NONE => finish [] 335 NONE => finish []
310 | SOME line => 337 | SOME line =>
311 let 338 let
312 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line) 339 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
313 val cmd = Substring.string (trim cmd) 340 val cmd = Substring.string (trim cmd)
314 val arg = Substring.string (trim arg) 341 val arg = Substring.string (trim arg)
342
343 fun ffiS () =
344 case String.fields (fn ch => ch = #".") arg of
345 [m, x] => (m, x)
346 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func");
347 ("", ""))
348
349 fun ffiM () =
350 case String.fields (fn ch => ch = #"=") arg of
351 [f, s] =>
352 (case String.fields (fn ch => ch = #".") f of
353 [m, x] => ((m, x), s)
354 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
355 (("", ""), "")))
356 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
357 (("", ""), ""))
315 in 358 in
316 case cmd of 359 case cmd of
317 "prefix" => 360 "prefix" =>
318 (case !prefix of 361 (case !prefix of
319 NONE => () 362 NONE => ()
342 | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive"; 385 | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
343 timeout := SOME (valOf (Int.fromString arg))) 386 timeout := SOME (valOf (Int.fromString arg)))
344 | "ffi" => ffi := relify arg :: !ffi 387 | "ffi" => ffi := relify arg :: !ffi
345 | "link" => link := relifyA arg :: !link 388 | "link" => link := relifyA arg :: !link
346 | "include" => headers := relifyA arg :: !headers 389 | "include" => headers := relifyA arg :: !headers
390 | "clientToServer" => clientToServer := ffiS () :: !clientToServer
391 | "effectful" => effectful := ffiS () :: !effectful
392 | "clientOnly" => clientOnly := ffiS () :: !clientOnly
393 | "serverOnly" => serverOnly := ffiS () :: !serverOnly
394 | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
347 | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); 395 | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
348 read () 396 read ()
349 end 397 end
350 398
351 val job = read () 399 val job = read ()
352 in 400 in
353 TextIO.closeIn inf; 401 TextIO.closeIn inf;
354 Settings.setUrlPrefix (#prefix job); 402 Settings.setUrlPrefix (#prefix job);
355 Settings.setTimeout (#timeout job); 403 Settings.setTimeout (#timeout job);
356 Settings.setHeaders (#headers job); 404 Settings.setHeaders (#headers job);
405 Settings.setClientToServer (#clientToServer job);
406 Settings.setEffectful (#effectful job);
407 Settings.setClientOnly (#clientOnly job);
408 Settings.setServerOnly (#serverOnly job);
409 Settings.setJsFuncs (#jsFuncs job);
357 job 410 job
358 end, 411 end,
359 print = p_job 412 print = p_job
360 } 413 }
361 414