# HG changeset patch # User Adam Chlipala # Date 1392911297 18000 # Node ID 7bd2ecf96bb0e5b5a80dc9fbde78d0227e3134f1 # Parent 210fb3dfc483246f3f7694e6847587f46bfd59bb Fixed issue with datatype constructors inside functors; now on to some problem with modules inside functors diff -r 210fb3dfc483 -r 7bd2ecf96bb0 src/corify.sml --- a/src/corify.sml Thu Feb 20 10:27:15 2014 -0500 +++ b/src/corify.sml Thu Feb 20 10:48:17 2014 -0500 @@ -99,6 +99,7 @@ val lookupConstructorByNameOpt : t -> string -> L'.patCon option val lookupConstructorByName : t -> string -> L'.patCon val lookupConstructorById : t -> int -> L'.patCon + val lookupConstructorByIdOpt : t -> int -> L'.patCon option datatype core_val = ENormal of int @@ -320,6 +321,9 @@ NONE => raise Fail "Corify.St.lookupConstructorById" | SOME x => x +fun lookupConstructorByIdOpt ({constructors, ...} : t) n = + IM.find (constructors, n) + fun lookupConstructorByNameOpt ({current, ...} : t) x = case current of FFfi {mod = m, constructors, ...} => @@ -744,6 +748,18 @@ in ((L'.DCon (x, n, k', cBase), loc) :: cds, st) end + | L.DVal (x, n, t, e as (L.ENamed n', _)) => + let + val st = + case St.lookupConstructorByIdOpt st n' of + SOME pc => St.bindConstructorAs st x n pc + | _ => st + + val (st, n) = St.bindVal st x n + val s = doRestify Settings.Url (mods, x) + in + ([(L'.DVal (x, n, corifyCon st t, corifyExp st e, s), loc)], st) + end | L.DVal (x, n, t, e) => let val (st, n) = St.bindVal st x n diff -r 210fb3dfc483 -r 7bd2ecf96bb0 src/expl_rename.sml --- a/src/expl_rename.sml Thu Feb 20 10:27:15 2014 -0500 +++ b/src/expl_rename.sml Thu Feb 20 10:48:17 2014 -0500 @@ -252,6 +252,12 @@ end | DDatatype dts => let + val d = (DDatatype (map (fn (x, n, xs, cns) => + (x, n, xs, + map (fn (x, n, co) => + (x, n, Option.map (renameCon st) co)) cns)) dts), + loc) + val (dts', st) = ListUtil.foldlMap (fn ((x, n, xs, cns), st) => let val (st, n') = St.bind (st, n) @@ -268,12 +274,6 @@ ((x, n, length xs, n', cns'), st) end) st dts - val d = (DDatatype (map (fn (x, n, xs, cns) => - (x, n, xs, - map (fn (x, n, co) => - (x, n, Option.map (renameCon st) co)) cns)) dts), - loc) - val env = E.declBinds E.empty d in (d @@ -287,6 +287,10 @@ end | DDatatypeImp (x, n, n', xs, x', xs', cns) => let + val d = (DDatatypeImp (x, n, n', xs, x', xs', + map (fn (x, n, co) => + (x, n, Option.map (renameCon st) co)) cns), loc) + val (cns', st) = ListUtil.foldlMap (fn ((x, n, _), st) => let @@ -298,10 +302,6 @@ val (st, n') = St.bind (st, n) - val d = (DDatatypeImp (x, n, n', xs, x', xs', - map (fn (x, n, co) => - (x, n, Option.map (renameCon st) co)) cns), loc) - val env = E.declBinds E.empty d in (d