diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-08-09 16:48:32 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-08-09 16:48:32 -0400 |
| commit | 3e59b823392701f538f972d689d04b0182696e51 (patch) | |
| tree | 5a4f935084c734ee1634b76abe5d2d5f1abf8bcc /src/core_util.sml | |
| parent | e699687ba2ff0cc2c7c185c4d99669f77093473b (diff) | |
Lists all the way through
Diffstat (limited to 'src/core_util.sml')
| -rw-r--r-- | src/core_util.sml | 22 |
1 files changed, 14 insertions, 8 deletions
diff --git a/src/core_util.sml b/src/core_util.sml index 3fc57739..e89a579b 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -571,14 +571,20 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} = fn c' => (DCon (x, n, k', c'), loc))) | DDatatype (x, n, xs, xncs) => - 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)) + 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 | DVal vi => S.map2 (mfvi ctx vi, fn vi' => |