diff options
| -rw-r--r-- | src/compiler.sig | 5 | ||||
| -rw-r--r-- | src/compiler.sml | 20 | ||||
| -rw-r--r-- | src/main.mlton.sml | 2 | ||||
| -rw-r--r-- | src/urweb.grm | 18 | ||||
| -rw-r--r-- | tests/ntags.ur | 4 | ||||
| -rw-r--r-- | tests/ntags.urp | 2 | ||||
| -rw-r--r-- | tests/ntags.urs | 1 |
7 files changed, 34 insertions, 18 deletions
diff --git a/src/compiler.sig b/src/compiler.sig index 3f04801f..28a5a5d5 100644 --- a/src/compiler.sig +++ b/src/compiler.sig @@ -53,9 +53,10 @@ signature COMPILER = sig 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 diff --git a/src/compiler.sml b/src/compiler.sml index c4000e84..dcb5fdad 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -927,17 +927,13 @@ fun compileC {cname, oname, ename, libs, profile, debug, link = link'} = 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 @@ fun compile job = 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 diff --git a/src/main.mlton.sml b/src/main.mlton.sml index b2d49438..ff54a7fa 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -81,4 +81,4 @@ val () = if !timing then Compiler.time Compiler.toCjrize job else - Compiler.compile job + Compiler.compiler job diff --git a/src/urweb.grm b/src/urweb.grm index 38d7d60d..2251dde7 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -289,6 +289,7 @@ fun patType loc (p : pat) = | 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 @@ xml : xmlOne xml (let 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 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer) (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 () diff --git a/tests/ntags.ur b/tests/ntags.ur new file mode 100644 index 00000000..74a78d85 --- /dev/null +++ b/tests/ntags.ur @@ -0,0 +1,4 @@ +fun main () = return <xml><body> + <div></div> + <div><div></div></div> +</body></xml> diff --git a/tests/ntags.urp b/tests/ntags.urp new file mode 100644 index 00000000..786f0bd2 --- /dev/null +++ b/tests/ntags.urp @@ -0,0 +1,2 @@ + +ntags diff --git a/tests/ntags.urs b/tests/ntags.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/ntags.urs @@ -0,0 +1 @@ +val main : unit -> transaction page |