Mercurial > urweb
diff src/monoize.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 | 260b680a6a04 |
| children | 7abb28e9d51f |
line wrap: on
line diff
--- a/src/monoize.sml Sun Oct 19 15:19:41 2008 -0400 +++ b/src/monoize.sml Sun Oct 19 15:47:47 2008 -0400 @@ -35,6 +35,8 @@ structure IM = IntBinaryMap +val urlPrefix = ref "/" + val dummyTyp = (L'.TDatatype (0, ref (L'.Enum, [])), E.dummySpan) structure U = MonoUtil @@ -264,7 +266,7 @@ let val (_, _, _, s) = Env.lookupENamed env fnam in - ((L'.EPrim (Prim.String ("/" ^ s)), loc), fm) + ((L'.EPrim (Prim.String (!urlPrefix ^ s)), loc), fm) end | L'.EClosure (fnam, args) => let @@ -287,7 +289,7 @@ | _ => (E.errorAt loc "Type mismatch encoding attribute"; (e, fm)) in - attrify (args, ft, (L'.EPrim (Prim.String ("/" ^ s)), loc), fm) + attrify (args, ft, (L'.EPrim (Prim.String (!urlPrefix ^ s)), loc), fm) end | _ => case t of @@ -1283,8 +1285,6 @@ val xp = " " ^ lowercaseFirst x ^ "=\"" - - val (e, fm) = fooify env fm (e, t) in ((L'.EStrcat (s, @@ -1677,6 +1677,15 @@ fun monoize env ds = let + val p = !urlPrefix + val () = + if p = "" then + urlPrefix := "/" + else if String.sub (p, size p - 1) <> #"/" then + urlPrefix := p ^ "/" + else + () + val (_, _, ds) = List.foldl (fn (d, (env, fm, ds)) => case monoDecl (env, fm) d of NONE => (env, fm, ds)