# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1259157152 18000
# Node ID 36efaf119b8513d114b731e984a0e0cedb46275c
# Parent  0d916892e39eb634232dfbad2d275270bc68690e
Refactor compile functions; allow empty tag contents

diff -r 0d916892e39e -r 36efaf119b85 src/compiler.sig
--- 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
diff -r 0d916892e39e -r 36efaf119b85 src/compiler.sml
--- 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
diff -r 0d916892e39e -r 36efaf119b85 src/main.mlton.sml
--- 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
diff -r 0d916892e39e -r 36efaf119b85 src/urweb.grm
--- 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
                                                       ()
diff -r 0d916892e39e -r 36efaf119b85 tests/ntags.ur
--- /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>
diff -r 0d916892e39e -r 36efaf119b85 tests/ntags.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/ntags.urp	Wed Nov 25 08:52:32 2009 -0500
@@ -0,0 +1,2 @@
+
+ntags
diff -r 0d916892e39e -r 36efaf119b85 tests/ntags.urs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/ntags.urs	Wed Nov 25 08:52:32 2009 -0500
@@ -0,0 +1,1 @@
+val main : unit -> transaction page