summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-08-31 08:46:22 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-08-31 08:46:22 -0400
commit773cc619b71ad10b8f21f6941d67947bac86885f (patch)
tree50f9c044e49642dd39c3a7574c193a2470174ca4 /src
parent5c3606a50dbe206eac3660135acba5855000a4ab (diff)
Explify tables
Diffstat (limited to 'src')
-rw-r--r--src/corify.sml5
-rw-r--r--src/expl.sml2
-rw-r--r--src/expl_env.sml13
-rw-r--r--src/expl_print.sml14
-rw-r--r--src/expl_util.sml7
-rw-r--r--src/explify.sml4
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)