summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2014-02-20 10:48:17 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2014-02-20 10:48:17 -0500
commit023d9ecbbc2bd1fc14098e84f5b0216da12a48a0 (patch)
tree9d0092264594ba927fc2e1977d7173d5297545c0
parente76ee80695acce02b283d12eedc26477ace15b1f (diff)
Fixed issue with datatype constructors inside functors; now on to some problem with modules inside functors
-rw-r--r--src/corify.sml16
-rw-r--r--src/expl_rename.sml20
2 files changed, 26 insertions, 10 deletions
diff --git a/src/corify.sml b/src/corify.sml
index 7fda1034..085b2eb8 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -99,6 +99,7 @@ structure St : sig
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 @@ fun lookupConstructorById ({constructors, ...} : t) n =
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 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
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 --git a/src/expl_rename.sml b/src/expl_rename.sml
index 751c22e8..a17e0a3b 100644
--- a/src/expl_rename.sml
+++ b/src/expl_rename.sml
@@ -252,6 +252,12 @@ fun dupDecl (all as (d, loc), st) =
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 @@ fun dupDecl (all as (d, loc), st) =
((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 @@ fun dupDecl (all as (d, loc), st) =
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 @@ fun dupDecl (all as (d, loc), st) =
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