diff options
| -rw-r--r-- | src/corify.sml | 5 | ||||
| -rw-r--r-- | src/expl.sml | 2 | ||||
| -rw-r--r-- | src/expl_env.sml | 13 | ||||
| -rw-r--r-- | src/expl_print.sml | 14 | ||||
| -rw-r--r-- | src/expl_util.sml | 7 | ||||
| -rw-r--r-- | src/explify.sml | 4 |
6 files changed, 41 insertions, 4 deletions
diff --git a/src/corify.sml b/src/corify.sml index 60baf903..6e893da2 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -806,6 +806,8 @@ structure St : sig end | _ => raise Fail "Non-const signature for 'export'") + | L.DTable _ => raise Fail "Corify DTable" + and corifyStr ((str, _), st) = case str of L.StrConst ds => @@ -855,7 +857,8 @@ fun maxName ds = foldl (fn ((d, _), n) => | L.DSgn (_, n', _) => Int.max (n, n') | L.DStr (_, n', _, str) => Int.max (n, Int.max (n', maxNameStr str)) | L.DFfiStr (_, n', _) => Int.max (n, n') - | L.DExport _ => n) + | L.DExport _ => n + | L.DTable (_, _, n', _) => Int.max (n, n')) 0 ds and maxNameStr (str, _) = diff --git a/src/expl.sml b/src/expl.sml index 0edff46b..bbc18097 100644 --- a/src/expl.sml +++ b/src/expl.sml @@ -107,6 +107,7 @@ datatype sgn_item' = | SgiVal of string * int * con | SgiSgn of string * int * sgn | SgiStr of string * int * sgn + | SgiTable of int * string * int * con and sgn' = SgnConst of sgn_item list @@ -128,6 +129,7 @@ datatype decl' = | DStr of string * int * sgn * str | DFfiStr of string * int * sgn | DExport of int * sgn * str + | DTable of int * string * int * con and str' = StrConst of decl list diff --git a/src/expl_env.sml b/src/expl_env.sml index 9d715c1b..b2146474 100644 --- a/src/expl_env.sml +++ b/src/expl_env.sml @@ -282,6 +282,12 @@ fun declBinds env (d, loc) = | DStr (x, n, sgn, _) => pushStrNamed env x n sgn | DFfiStr (x, n, sgn) => pushStrNamed env x n sgn | DExport _ => env + | DTable (tn, x, n, c) => + let + val t = (CApp ((CModProj (tn, [], "table"), loc), c), loc) + in + pushENamed env x n t + end fun sgiBinds env (sgi, loc) = case sgi of @@ -328,4 +334,11 @@ fun sgiBinds env (sgi, loc) = | SgiSgn (x, n, sgn) => pushSgnNamed env x n sgn | SgiStr (x, n, sgn) => pushStrNamed env x n sgn + | SgiTable (tn, x, n, c) => + let + val t = (CApp ((CModProj (tn, [], "table"), loc), c), loc) + in + pushENamed env x n t + end + end diff --git a/src/expl_print.sml b/src/expl_print.sml index ded90ada..7b34c9c3 100644 --- a/src/expl_print.sml +++ b/src/expl_print.sml @@ -417,6 +417,13 @@ fun p_sgn_item env (sgi, _) = string "=", space, p_sgn env sgn] + | SgiTable (_, x, n, c) => box [string "table", + space, + p_named x n, + space, + string ":", + space, + p_con env c] and p_sgn env (sgn, loc) = case sgn of @@ -558,6 +565,13 @@ fun p_decl env (dAll as (d, _) : decl) = string ":", space, p_sgn env sgn] + | DTable (_, x, n, c) => box [string "table", + space, + p_named x n, + space, + string ":", + space, + p_con env c] and p_str env (str, _) = case str of diff --git a/src/expl_util.sml b/src/expl_util.sml index a90e6bed..ee4b6dc2 100644 --- a/src/expl_util.sml +++ b/src/expl_util.sml @@ -412,6 +412,10 @@ fun mapfoldB {kind, con, sgn_item, sgn, bind} = S.map2 (sg ctx s, fn s' => (SgiSgn (x, n, s'), loc)) + | SgiTable (tn, x, n, c) => + S.map2 (con ctx c, + fn c' => + (SgiTable (tn, x, n, c'), loc)) and sg ctx s acc = S.bindP (sg' ctx s acc, sgn ctx) @@ -433,7 +437,8 @@ fun mapfoldB {kind, con, sgn_item, sgn, bind} = | SgiStr (x, _, sgn) => bind (ctx, Str (x, sgn)) | SgiSgn (x, _, sgn) => - bind (ctx, Sgn (x, sgn)), + bind (ctx, Sgn (x, sgn)) + | SgiTable _ => ctx, sgi ctx si)) ctx sgis, fn sgis' => (SgnConst sgis', loc)) diff --git a/src/explify.sml b/src/explify.sml index 530f4b5f..689c18ca 100644 --- a/src/explify.sml +++ b/src/explify.sml @@ -129,7 +129,7 @@ fun explifySgi (sgi, loc) = | L.SgiStr (x, n, sgn) => SOME (L'.SgiStr (x, n, explifySgn sgn), loc) | L.SgiSgn (x, n, sgn) => SOME (L'.SgiSgn (x, n, explifySgn sgn), loc) | L.SgiConstraint _ => NONE - | L.SgiTable _ => raise Fail "Explify SgiTable" + | L.SgiTable (nt, x, n, c) => SOME (L'.SgiTable (nt, x, n, explifyCon c), loc) | L.SgiClassAbs (x, n) => SOME (L'.SgiConAbs (x, n, (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc)), loc) | L.SgiClass (x, n, c) => SOME (L'.SgiCon (x, n, (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc), explifyCon c), loc) @@ -161,7 +161,7 @@ fun explifyDecl (d, loc : EM.span) = | L.DFfiStr (x, n, sgn) => SOME (L'.DFfiStr (x, n, explifySgn sgn), loc) | L.DConstraint (c1, c2) => NONE | L.DExport (en, sgn, str) => SOME (L'.DExport (en, explifySgn sgn, explifyStr str), loc) - | L.DTable _ => raise Fail "Explify DTable" + | L.DTable (nt, x, n, c) => SOME (L'.DTable (nt, x, n, explifyCon c), loc) | L.DClass (x, n, c) => SOME (L'.DCon (x, n, (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc), explifyCon c), loc) |