Refactor compile functions; allow empty tag contents

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