diff options
author | 2008-07-29 13:16:21 -0400 | |
---|---|---|
committer | 2008-07-29 13:16:21 -0400 | |
commit | 4b511aa7ed5b36cb0a9adb898f881d6db0a89996 (patch) | |
tree | 116bd8e11b341df6999ea79432cb4386a48ca9fc /src/corify.sml | |
parent | 4cbbb0bb751dd9e9dae9d6b621e563ee5c7ae1b4 (diff) |
Datatypes through corify
Diffstat (limited to 'src/corify.sml')
-rw-r--r-- | src/corify.sml | 60 |
1 files changed, 58 insertions, 2 deletions
diff --git a/src/corify.sml b/src/corify.sml index 0f98e99c..7332395c 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -75,6 +75,7 @@ structure St : sig ENormal of int | EFfi of string * L'.con val bindVal : t -> string -> int -> t * int + val bindConstructor : t -> string -> int -> t val lookupValById : t -> int -> int option val lookupValByName : t -> string -> core_val @@ -182,6 +183,25 @@ fun bindVal {cons, vals, strs, funs, current, nested} s n = n') end +fun bindConstructor {cons, vals, strs, funs, current, nested} s n = + let + val current = + case current of + FFfi _ => raise Fail "Binding inside FFfi" + | FNormal {cons, vals, strs, funs} => + FNormal {cons = cons, + vals = SM.insert (vals, s, n), + strs = strs, + funs = funs} + in + {cons = cons, + vals = IM.insert (vals, n, n), + strs = strs, + funs = funs, + current = current, + nested = nested} + end + fun lookupValById ({vals, ...} : t) n = IM.find (vals, n) fun lookupValByName ({current, ...} : t) x = @@ -384,8 +404,44 @@ fun corifyDecl ((d, loc : EM.span), st) = in ([(L'.DCon (x, n, corifyKind k, corifyCon st c), loc)], st) end - | L.DDatatype _ => raise Fail "Corify DDatatype" - | L.DDatatypeImp _ => raise Fail "Corify DDatatypeImp" + | L.DDatatype (x, n, xncs) => + let + val (st, n) = St.bindCon st x n + val (xncs, st) = ListUtil.foldlMap (fn ((x, n, co), st) => + let + val st = St.bindConstructor st x n + val co = Option.map (corifyCon st) co + in + ((x, n, co), st) + end) st xncs + in + ([(L'.DDatatype (x, n, xncs), loc)], st) + end + | L.DDatatypeImp (x, n, m1, ms, s, xncs) => + let + val (st, n) = St.bindCon st x n + val c = corifyCon st (L.CModProj (m1, ms, s), loc) + + val (xncs, st) = ListUtil.foldlMap (fn ((x, n, co), st) => + let + val (st, n) = St.bindVal st x n + val co = Option.map (corifyCon st) co + in + ((x, n, co), st) + end) st xncs + + val cds = map (fn (x, n, co) => + let + val t = case co of + NONE => c + | SOME t' => (L'.TFun (t', c), loc) + val e = corifyExp st (L.EModProj (m1, ms, x), loc) + in + (L'.DVal (x, n, t, e, x), loc) + end) xncs + in + ((L'.DCon (x, n, (L'.KType, loc), c), loc) :: cds, st) + end | L.DVal (x, n, t, e) => let val (st, n) = St.bindVal st x n |