summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-11-25 08:52:32 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-11-25 08:52:32 -0500
commit92ef621511425ae4ffb2873f4ce9d31ad0f0ed5d (patch)
treec04288b7d24fcc901df4cf0fb8aa42263d3f585f
parentc88ae0814f322f82e8daf53b19086326bbca0327 (diff)
Refactor compile functions; allow empty tag contents
-rw-r--r--src/compiler.sig5
-rw-r--r--src/compiler.sml20
-rw-r--r--src/main.mlton.sml2
-rw-r--r--src/urweb.grm18
-rw-r--r--tests/ntags.ur4
-rw-r--r--tests/ntags.urp2
-rw-r--r--tests/ntags.urs1
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