diff src/compiler.sml @ 385:1195f6e4d208

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
line wrap: on
line diff
--- a/src/compiler.sml	Sun Oct 19 15:19:41 2008 -0400
+++ b/src/compiler.sml	Sun Oct 19 15:47:47 2008 -0400
@@ -36,6 +36,7 @@
                          structure LrParser = LrParser)
 
 type job = {
+     prefix : string,
      database : string option,
      sources : string list,
      exe : string,
@@ -198,7 +199,7 @@
               handle LrParser.ParseError => [],
      print = SourcePrint.p_file}    
 
-fun p_job {database, exe, sql, sources, debug} =
+fun p_job {prefix, database, exe, sql, sources, debug} =
     let
         open Print.PD
         open Print
@@ -259,18 +260,19 @@
                               readSources acc
                           end
 
-                  fun finish (database, exe, sql, debug, sources) =
-                      {database = database,
+                  fun finish (prefix, database, exe, sql, debug, sources) =
+                      {prefix = Option.getOpt (prefix, "/"),
+                       database = database,
                        exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
                                                                       ext = SOME "exe"}),
                        sql = sql,
                        debug = debug,
                        sources = sources}
 
-                  fun read (database, exe, sql, debug) =
+                  fun read (prefix, database, exe, sql, debug) =
                       case TextIO.inputLine inf of
-                          NONE => finish (database, exe, sql, debug, [])
-                        | SOME "\n" => finish (database, exe, sql, debug, readSources [])
+                          NONE => finish (prefix, database, exe, sql, debug, [])
+                        | SOME "\n" => finish (prefix, database, exe, sql, debug, readSources [])
                         | SOME line =>
                           let
                               val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
@@ -278,28 +280,36 @@
                               val arg = Substring.string (trim arg)
                           in
                               case cmd of
-                                  "database" =>
+                                  "prefix" =>
+                                  (case prefix of
+                                       NONE => ()
+                                     | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
+                                   read (SOME arg, database, exe, sql, debug))
+                                | "database" =>
                                   (case database of
                                        NONE => ()
                                      | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
-                                   read (SOME arg, exe, sql, debug))
+                                   read (prefix, SOME arg, exe, sql, debug))
                                 | "exe" =>
                                   (case exe of
                                        NONE => ()
                                      | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
-                                   read (database, SOME (relify arg), sql, debug))
+                                   read (prefix, database, SOME (relify arg), sql, debug))
                                 | "sql" =>
                                   (case sql of
                                        NONE => ()
                                      | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
-                                   read (database, exe, SOME (relify arg), debug))
-                                | "debug" => read (database, exe, sql, true)
+                                   read (prefix, database, exe, SOME (relify arg), debug))
+                                | "debug" => read (prefix, database, exe, sql, true)
                                 | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
-                                        read (database, exe, sql, debug))
+                                        read (prefix, database, exe, sql, debug))
                           end
+
+                  val job = read (NONE, NONE, NONE, NONE, false)
               in
-                  read (NONE, NONE, NONE, false)
-                  before TextIO.closeIn inf
+                  TextIO.closeIn inf;
+                  Monoize.urlPrefix := #prefix job;
+                  job
               end,
     print = p_job
 }