diff options
author | Adam Chlipala <adam@chlipala.net> | 2012-04-28 11:35:12 -0400 |
---|---|---|
committer | Adam Chlipala <adam@chlipala.net> | 2012-04-28 11:35:12 -0400 |
commit | 79655cfc46cd36b6c52038cacb33ea5d5adac0fe (patch) | |
tree | 860fa2e6a12e0d8034dc49a91701a8564a5202de /src | |
parent | 4b4301a132b8d1144ed08c79b2ad918d70d5d37c (diff) |
Fix urlification of recursive polymorphic variants
Diffstat (limited to 'src')
-rw-r--r-- | src/monoize.sml | 57 |
1 files changed, 31 insertions, 26 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 99d93ff9..1c11e5c7 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -357,13 +357,15 @@ fun fk2s fk = 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 @@ type t = { 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 @@ fun freshName {count, map, listMap, decls} = 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 @@ fun fooifyExp fk env = 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 @@ fun fooifyExp fk env = 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 |