From f19ae3bb20fa0c60e737606949b2bec6e3ae04f9 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Tue, 22 Jul 2008 19:12:25 -0400
Subject: gform in proper order

---
 lib/basis.lig   |  5 ++++-
 src/monoize.sml | 11 +++++++++++
 tests/gform.lac |  2 +-
 3 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/lib/basis.lig b/lib/basis.lig
index 3e3950cf..64dee2a3 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -24,7 +24,10 @@ val join : ctx ::: {Unit}
         -> xml ctx use1 bind1
         -> xml ctx (use1 ++ bind1) bind2
         -> xml ctx use1 (bind1 ++ bind2)
-
+val useMore : ctx ::: {Unit} -> use1 ::: {Type} -> use2 ::: {Type} -> bind ::: {Type}
+        -> use1 ~ use2
+        -> xml ctx use1 bind
+        -> xml ctx (use1 ++ use2) bind
 
 con xhtml = xml [Html]
 con page = xhtml [] []
diff --git a/src/monoize.sml b/src/monoize.sml
index e6c6b6c8..505d6d98 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -351,6 +351,17 @@ fun monoExp env (all as (e, loc)) =
                                           (L'.EPrim (Prim.String "</form>"), loc)), loc)), loc)
             end
 
+          | L.EApp ((L.ECApp (
+                     (L.ECApp (
+                      (L.ECApp (
+                       (L.ECApp (
+                        (L.EFfi ("Basis", "useMore"), _), _), _),
+                       _), _),
+                      _), _),
+                     _), _),
+                    xml) => monoExp env xml
+                     
+
           | L.EApp (e1, e2) => (L'.EApp (monoExp env e1, monoExp env e2), loc)
           | L.EAbs (x, dom, ran, e) =>
             (L'.EAbs (x, monoType env dom, monoType env ran, monoExp (Env.pushERel env x dom) e), loc)
diff --git a/tests/gform.lac b/tests/gform.lac
index 4ce75e3e..f9b028fa 100644
--- a/tests/gform.lac
+++ b/tests/gform.lac
@@ -23,7 +23,7 @@ functor F (M : S) : S' where con rs = M.rs = struct
                         {fold [fn rs :: {Unit} => xml lform [] (stringify rs)]
                                 (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} =>
                                         fn frag : xml lform [] (stringify rest) =>
-                                                <lform><li>{frag} <textbox{nm}/></li></lform>)
+                                                <lform><li> <textbox{nm}/></li> {useMore frag}</lform>)
                                 <lform></lform>
                                 [rs]}
 
-- 
cgit v1.2.3