summaryrefslogtreecommitdiff
path: root/src/core_util.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-05-16 15:45:12 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-05-16 15:45:12 -0400
commit41f7bb23ff2a9598f8f3bff1487f39f9e91f9f05 (patch)
treec5073d9b7f368aa38bb4d146c0a6b21900ef1f79 /src/core_util.sml
parent6cb3888614811abc30c6a00a1644e256d1d1c780 (diff)
Mutual datatypes through Effectize
Diffstat (limited to 'src/core_util.sml')
-rw-r--r--src/core_util.sml87
1 files changed, 46 insertions, 41 deletions
diff --git a/src/core_util.sml b/src/core_util.sml
index 96a05b2d..db1eab1a 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -910,21 +910,23 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} =
S.map2 (mfc ctx c,
fn c' =>
(DCon (x, n, k', c'), loc)))
- | DDatatype (x, n, xs, xncs) =>
- let
- val k = (KType, loc)
- val k' = foldl (fn (_, k') => (KArrow (k, k'), loc)) k xs
- val ctx' = bind (ctx, NamedC (x, n, k', NONE))
- in
- S.map2 (ListUtil.mapfold (fn (x, n, c) =>
- case c of
- NONE => S.return2 (x, n, c)
- | SOME c =>
- S.map2 (mfc ctx' c,
- fn c' => (x, n, SOME c'))) xncs,
- fn xncs' =>
- (DDatatype (x, n, xs, xncs'), loc))
- end
+ | DDatatype dts =>
+ S.map2 (ListUtil.mapfold (fn (x, n, xs, xncs) =>
+ let
+ val k = (KType, loc)
+ val k' = foldl (fn (_, k') => (KArrow (k, k'), loc)) k xs
+ val ctx' = bind (ctx, NamedC (x, n, k', NONE))
+ in
+ S.map2 (ListUtil.mapfold (fn (x, n, c) =>
+ case c of
+ NONE => S.return2 (x, n, c)
+ | SOME c =>
+ S.map2 (mfc ctx' c,
+ fn c' => (x, n, SOME c'))) xncs,
+ fn xncs' => (x, n, xs, xncs'))
+ end) dts,
+ fn dts' =>
+ (DDatatype dts', loc))
| DVal vi =>
S.map2 (mfvi ctx vi,
fn vi' =>
@@ -1059,29 +1061,32 @@ fun mapfoldB (all as {bind, ...}) =
val ctx' =
case #1 d' of
DCon (x, n, k, c) => bind (ctx, NamedC (x, n, k, SOME c))
- | DDatatype (x, n, xs, xncs) =>
- let
- val loc = #2 d'
- val k = (KType, loc)
- val k' = foldl (fn (_, k') => (KArrow (k, k'), loc)) k xs
-
- val ctx = bind (ctx, NamedC (x, n, k', NONE))
- val t = (CNamed n, #2 d')
- val t = ListUtil.foldli (fn (i, _, t) => (CApp (t, (CRel i, loc)), loc))
- t xs
- in
- foldl (fn ((x, n, to), ctx) =>
- let
- val t = case to of
- NONE => t
- | SOME t' => (TFun (t', t), #2 d')
- val t = foldr (fn (x, t) => (TCFun (x, k, t), loc))
- t xs
- in
- bind (ctx, NamedE (x, n, t, NONE, ""))
- end)
- ctx xncs
- end
+ | DDatatype dts =>
+ foldl (fn ((x, n, xs, xncs), ctx) =>
+ let
+ val loc = #2 d'
+ val k = (KType, loc)
+ val k' = foldl (fn (_, k') => (KArrow (k, k'), loc)) k xs
+
+ val ctx = bind (ctx, NamedC (x, n, k', NONE))
+ val t = (CNamed n, #2 d')
+ val t = ListUtil.foldli (fn (i, _, t) =>
+ (CApp (t, (CRel i, loc)), loc))
+ t xs
+ in
+ foldl (fn ((x, n, to), ctx) =>
+ let
+ val t = case to of
+ NONE => t
+ | SOME t' => (TFun (t', t), #2 d')
+ val t = foldr (fn (x, t) => (TCFun (x, k, t), loc))
+ t xs
+ in
+ bind (ctx, NamedE (x, n, t, NONE, ""))
+ end)
+ ctx xncs
+ end)
+ ctx dts
| DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s))
| DValRec vis =>
foldl (fn ((x, n, t, e, s), ctx) => bind (ctx, NamedE (x, n, t, NONE, s)))
@@ -1174,9 +1179,9 @@ fun foldMap {kind, con, exp, decl} s d =
val maxName = foldl (fn ((d, _) : decl, count) =>
case d of
DCon (_, n, _, _) => Int.max (n, count)
- | DDatatype (_, n, _, ns) =>
- foldl (fn ((_, n', _), m) => Int.max (n', m))
- (Int.max (n, count)) ns
+ | DDatatype dts => foldl (fn ((_, n, _, ns), count) =>
+ foldl (fn ((_, n', _), m) => Int.max (n', m))
+ (Int.max (n, count)) ns) count dts
| DVal (_, n, _, _, _) => Int.max (n, count)
| DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis
| DExport _ => count