diff options
| -rw-r--r-- | lib/basis.lig | 5 | ||||
| -rw-r--r-- | src/monoize.sml | 11 | ||||
| -rw-r--r-- | 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]} |