changeset 1730:02533f681ad2

Fix urlification of recursive polymorphic variants
author Adam Chlipala <adam@chlipala.net>
date Sat, 28 Apr 2012 11:35:12 -0400
parents 6817ddd6cf1f
children 27e731a65934
files src/monoize.sml tests/urlifyVariant.ur
diffstat 2 files changed, 36 insertions(+), 26 deletions(-) [+]
line wrap: on
line diff
--- a/src/monoize.sml	Fri Apr 27 09:52:16 2012 -0400
+++ b/src/monoize.sml	Sat Apr 28 11:35:12 2012 -0400
@@ -357,13 +357,15 @@
         Attr => "attr"
       | Url => "url"
 
+type vr = string * int * L'.typ * L'.exp * string
+
 structure Fm :> sig
     type t
 
     val empty : int -> t
 
-    val lookup : t -> foo_kind -> int -> (int -> t -> L'.decl * t) -> t * int
-    val lookupList : t -> foo_kind -> L'.typ -> (int -> t -> L'.decl * t) -> t * int
+    val lookup : t -> foo_kind -> int -> (int -> t -> vr * t) -> t * int
+    val lookupList : t -> foo_kind -> L'.typ -> (int -> t -> vr * t) -> t * int
     val enter : t -> t
     val decls : t -> L'.decl list
 
@@ -390,7 +392,7 @@
      count : int,
      map : int IM.map M.map,
      listMap : int TM.map M.map,
-     decls : L'.decl list
+     decls : vr list
 }
 
 fun empty count = {
@@ -418,7 +420,10 @@
     in
         (next, {count = count , map = map, listMap = listMap, decls = decls})
     end
-fun decls ({decls, ...} : t) = decls
+fun decls ({decls, ...} : t) =
+    case decls of
+        [] => []
+      | _ => [(L'.DValRec decls, ErrorMsg.dummySpan)]
 
 fun lookup (t as {count, map, listMap, decls}) k n thunk =
     let
@@ -567,17 +572,17 @@
                                 val dom = tAll
                                 val ran = (L'.TFfi ("Basis", "string"), loc)
                             in
-                                ((L'.DValRec [(fk2s fk ^ "ify_" ^ x,
-                                               n,
-                                               (L'.TFun (dom, ran), loc),
-                                               (L'.EAbs ("x",
-                                                         dom,
-                                                         ran,
-                                                         (L'.ECase ((L'.ERel 0, loc),
-                                                                    branches,
-                                                                    {disc = dom,
-                                                                     result = ran}), loc)), loc),
-                                               "")], loc),
+                                ((fk2s fk ^ "ify_" ^ x,
+                                  n,
+                                  (L'.TFun (dom, ran), loc),
+                                  (L'.EAbs ("x",
+                                            dom,
+                                            ran,
+                                            (L'.ECase ((L'.ERel 0, loc),
+                                                       branches,
+                                                       {disc = dom,
+                                                        result = ran}), loc)), loc),
+                                  ""),
                                  fm)
                             end
 
@@ -618,17 +623,17 @@
                                 val dom = tAll
                                 val ran = (L'.TFfi ("Basis", "string"), loc)
                             in
-                                ((L'.DValRec [(fk2s fk ^ "ify_list",
-                                               n,
-                                               (L'.TFun (dom, ran), loc),
-                                               (L'.EAbs ("x",
-                                                         dom,
-                                                         ran,
-                                                         (L'.ECase ((L'.ERel 0, loc),
-                                                                    branches,
-                                                                    {disc = dom,
-                                                                     result = ran}), loc)), loc),
-                                               "")], loc),
+                                ((fk2s fk ^ "ify_list",
+                                  n,
+                                  (L'.TFun (dom, ran), loc),
+                                  (L'.EAbs ("x",
+                                            dom,
+                                            ran,
+                                            (L'.ECase ((L'.ERel 0, loc),
+                                                       branches,
+                                                       {disc = dom,
+                                                        result = ran}), loc)), loc),
+                                  ""),
                                  fm)
                             end
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/urlifyVariant.ur	Sat Apr 28 11:35:12 2012 -0400
@@ -0,0 +1,5 @@
+datatype t = T of variant [A = t]
+
+fun main (x : t) : transaction page = return <xml><body>
+  <a link={main x}>Go</a>
+</body></xml>