Mercurial > urweb
changeset 1045:36efaf119b85
Refactor compile functions; allow empty tag contents
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Wed, 25 Nov 2009 08:52:32 -0500 |
| parents | 0d916892e39e |
| children | a5eb8f87bc17 |
| files | src/compiler.sig src/compiler.sml src/main.mlton.sml src/urweb.grm tests/ntags.ur tests/ntags.urp tests/ntags.urs |
| diffstat | 7 files changed, 34 insertions(+), 18 deletions(-) [+] |
line wrap: on
line diff
--- a/src/compiler.sig Wed Nov 25 08:38:12 2009 -0500 +++ b/src/compiler.sig Wed Nov 25 08:52:32 2009 -0500 @@ -53,9 +53,10 @@ protocol : string option, dbms : string option } - val compile : string -> unit + val compile : string -> bool + val compiler : string -> unit val compileC : {cname : string, oname : string, ename : string, libs : string, - profile : bool, debug : bool, link : string list} -> unit + profile : bool, debug : bool, link : string list} -> bool type ('src, 'dst) phase type ('src, 'dst) transform
--- a/src/compiler.sml Wed Nov 25 08:38:12 2009 -0500 +++ b/src/compiler.sml Wed Nov 25 08:52:32 2009 -0500 @@ -927,17 +927,13 @@ val link = foldl (fn (s, link) => link ^ " " ^ s) link link' in - if not (OS.Process.isSuccess (OS.Process.system compile)) then - OS.Process.exit OS.Process.failure - else if not (OS.Process.isSuccess (OS.Process.system link)) then - OS.Process.exit OS.Process.failure - else - () + OS.Process.isSuccess (OS.Process.system compile) + andalso OS.Process.isSuccess (OS.Process.system link) end fun compile job = case run toChecknest job of - NONE => OS.Process.exit OS.Process.failure + NONE => false | SOME file => let val job = valOf (run (transform parseUrp "parseUrp") job) @@ -991,11 +987,17 @@ end; compileC {cname = cname, oname = oname, ename = ename, libs = libs, - profile = #profile job, debug = #debug job, link = #link job}; + profile = #profile job, debug = #debug job, link = #link job} - cleanup () + before cleanup () end handle ex => (((cleanup ()) handle _ => ()); raise ex) end +fun compiler job = + if compile job then + () + else + OS.Process.exit OS.Process.failure + end
--- a/src/main.mlton.sml Wed Nov 25 08:38:12 2009 -0500 +++ b/src/main.mlton.sml Wed Nov 25 08:52:32 2009 -0500 @@ -81,4 +81,4 @@ if !timing then Compiler.time Compiler.toCjrize job else - Compiler.compile job + Compiler.compiler job
--- a/src/urweb.grm Wed Nov 25 08:38:12 2009 -0500 +++ b/src/urweb.grm Wed Nov 25 08:52:32 2009 -0500 @@ -289,6 +289,7 @@ | rexp of (con * exp) list | xml of exp | xmlOne of exp + | xmlOpt of exp | tag of (string * exp) * exp | tagHead of string * exp | bind of string * con option * exp @@ -1294,6 +1295,11 @@ end) | xmlOne (xmlOne) +xmlOpt : xml (xml) + | (EApp ((EVar (["Basis"], "cdata", Infer), dummy), + (EPrim (Prim.String ""), dummy)), + dummy) + xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer), s (NOTAGSleft, NOTAGSright)), (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))), s (NOTAGSleft, NOTAGSright)) @@ -1318,25 +1324,25 @@ (EApp (#2 tag, cdata), pos) end) - | tag GT xml END_TAG (let + | tag GT xmlOpt END_TAG (let val pos = s (tagleft, GTright) val et = tagIn END_TAG in if #1 (#1 tag) = et then if et = "form" then (EApp ((EVar (["Basis"], "form", Infer), pos), - xml), pos) + xmlOpt), pos) else if et = "subform" then (EApp ((EDisjointApp (#2 (#1 tag)), pos), - xml), pos) + xmlOpt), pos) else if et = "subforms" then (EApp ((EDisjointApp (#2 (#1 tag)), pos), - xml), pos) + xmlOpt), pos) else if et = "entry" then (EApp ((EVar (["Basis"], "entry", Infer), pos), - xml), pos) + xmlOpt), pos) else - (EApp (#2 tag, xml), pos) + (EApp (#2 tag, xmlOpt), pos) else (if ErrorMsg.anyErrors () then ()
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/ntags.ur Wed Nov 25 08:52:32 2009 -0500 @@ -0,0 +1,4 @@ +fun main () = return <xml><body> + <div></div> + <div><div></div></div> +</body></xml>