Mercurial > urweb

comparison src/compiler.sml @ 385:1195f6e4d208

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Support for URL prefixes that works with local demo
author Adam Chlipala <adamc@hcoop.net>
date Sun, 19 Oct 2008 15:47:47 -0400
parents 168667cdaa95
children 519366a76603
comparison
equal deleted inserted replaced
384:2a7e7bd7b29f 385:1195f6e4d208
34 structure UrwebP = Join(structure ParserData = UrwebLrVals.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 = { 38 type job = {
39 prefix : string,
39 database : string option, 40 database : string option,
40 sources : string list, 41 sources : string list,
41 exe : string, 42 exe : string,
42 sql : string option, 43 sql : string option,
43 debug : bool 44 debug : bool
196 | _ => absyn 197 | _ => absyn
197 end 198 end
198 handle LrParser.ParseError => [], 199 handle LrParser.ParseError => [],
199 print = SourcePrint.p_file} 200 print = SourcePrint.p_file}
200 201
201 fun p_job {database, exe, sql, sources, debug} = 202 fun p_job {prefix, database, exe, sql, sources, debug} =
202 let 203 let
203 open Print.PD 204 open Print.PD
204 open Print 205 open Print
205 in 206 in
206 box [if debug then 207 box [if debug then
257 end 258 end
258 in 259 in
259 readSources acc 260 readSources acc
260 end 261 end
261 262
262 fun finish (database, exe, sql, debug, sources) = 263 fun finish (prefix, database, exe, sql, debug, sources) =
263 {database = database, 264 {prefix = Option.getOpt (prefix, "/"),
265 database = database,
264 exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename, 266 exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
265 ext = SOME "exe"}), 267 ext = SOME "exe"}),
266 sql = sql, 268 sql = sql,
267 debug = debug, 269 debug = debug,
268 sources = sources} 270 sources = sources}
269 271
270 fun read (database, exe, sql, debug) = 272 fun read (prefix, database, exe, sql, debug) =
271 case TextIO.inputLine inf of 273 case TextIO.inputLine inf of
272 NONE => finish (database, exe, sql, debug, []) 274 NONE => finish (prefix, database, exe, sql, debug, [])
273 | SOME "\n" => finish (database, exe, sql, debug, readSources []) 275 | SOME "\n" => finish (prefix, database, exe, sql, debug, readSources [])
274 | SOME line => 276 | SOME line =>
275 let 277 let
276 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line) 278 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
277 val cmd = Substring.string (trim cmd) 279 val cmd = Substring.string (trim cmd)
278 val arg = Substring.string (trim arg) 280 val arg = Substring.string (trim arg)
279 in 281 in
280 case cmd of 282 case cmd of
281 "database" => 283 "prefix" =>
284 (case prefix of
285 NONE => ()
286 | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
287 read (SOME arg, database, exe, sql, debug))
288 | "database" =>
282 (case database of 289 (case database of
283 NONE => () 290 NONE => ()
284 | SOME _ => ErrorMsg.error "Duplicate 'database' directive"; 291 | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
285 read (SOME arg, exe, sql, debug)) 292 read (prefix, SOME arg, exe, sql, debug))
286 | "exe" => 293 | "exe" =>
287 (case exe of 294 (case exe of
288 NONE => () 295 NONE => ()
289 | SOME _ => ErrorMsg.error "Duplicate 'exe' directive"; 296 | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
290 read (database, SOME (relify arg), sql, debug)) 297 read (prefix, database, SOME (relify arg), sql, debug))
291 | "sql" => 298 | "sql" =>
292 (case sql of 299 (case sql of
293 NONE => () 300 NONE => ()
294 | SOME _ => ErrorMsg.error "Duplicate 'sql' directive"; 301 | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
295 read (database, exe, SOME (relify arg), debug)) 302 read (prefix, database, exe, SOME (relify arg), debug))
296 | "debug" => read (database, exe, sql, true) 303 | "debug" => read (prefix, database, exe, sql, true)
297 | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); 304 | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
298 read (database, exe, sql, debug)) 305 read (prefix, database, exe, sql, debug))
299 end 306 end
300 in 307
301 read (NONE, NONE, NONE, false) 308 val job = read (NONE, NONE, NONE, NONE, false)
302 before TextIO.closeIn inf 309 in
310 TextIO.closeIn inf;
311 Monoize.urlPrefix := #prefix job;
312 job
303 end, 313 end,
304 print = p_job 314 print = p_job
305 } 315 }
306 316
307 val toParseJob = transform parseUrp "parseJob" 317 val toParseJob = transform parseUrp "parseJob"