changeset 1990:7bd2ecf96bb0

Fixed issue with datatype constructors inside functors; now on to some problem with modules inside functors
author Adam Chlipala <adam@chlipala.net>
date Thu, 20 Feb 2014 10:48:17 -0500 (2014-02-20)
parents 210fb3dfc483
children 7db8356caef5
files src/corify.sml src/expl_rename.sml
diffstat 2 files changed, 26 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- 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
--- 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