diff options
| -rw-r--r-- | src/core.sml | 1 | ||||
| -rw-r--r-- | src/core_env.sml | 6 | ||||
| -rw-r--r-- | src/core_print.sml | 26 | ||||
| -rw-r--r-- | src/core_util.sml | 13 | ||||
| -rw-r--r-- | src/corify.sml | 8 | ||||
| -rw-r--r-- | src/monoize.sml | 1 | ||||
| -rw-r--r-- | src/shake.sml | 9 |
7 files changed, 54 insertions, 10 deletions
diff --git a/src/core.sml b/src/core.sml index 30bd8b76..a5af04cc 100644 --- a/src/core.sml +++ b/src/core.sml @@ -114,6 +114,7 @@ datatype decl' = | DVal of string * int * con * exp * string | DValRec of (string * int * con * exp * string) list | DExport of export_kind * int + | DTable of string * int * con * string withtype decl = decl' located diff --git a/src/core_env.sml b/src/core_env.sml index d59e3d3d..d0ae8a86 100644 --- a/src/core_env.sml +++ b/src/core_env.sml @@ -187,6 +187,12 @@ fun declBinds env (d, loc) = | DVal (x, n, t, e, s) => pushENamed env x n t (SOME e) s | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis | DExport _ => env + | DTable (x, n, c, s) => + let + val t = (CApp ((CFfi ("Basis", "table"), loc), c), loc) + in + pushENamed env x n t NONE s + end fun patBinds env (p, loc) = case p of diff --git a/src/core_print.sml b/src/core_print.sml index b03b25f6..a5d3df95 100644 --- a/src/core_print.sml +++ b/src/core_print.sml @@ -331,14 +331,17 @@ fun p_exp' par env (e, _) = and p_exp env = p_exp' false env +fun p_named x n = + if !debug then + box [string x, + string "__", + string (Int.toString n)] + else + string x + fun p_vali env (x, n, t, e, s) = let - val xp = if !debug then - box [string x, - string "__", - string (Int.toString n)] - else - string x + val xp = p_named x n in box [xp, space, @@ -432,6 +435,17 @@ fun p_decl env (dAll as (d, _) : decl) = string "as", space, p_con env (#2 (E.lookupENamed env n))] + | DTable (x, n, c, s) => box [string "table", + space, + p_named x n, + space, + string "as", + space, + string s, + space, + string ":", + space, + p_con env c] fun p_file env file = let diff --git a/src/core_util.sml b/src/core_util.sml index 3403a9d1..609152ec 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -621,6 +621,10 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} = (DValRec vis', loc)) end | DExport _ => S.return2 dAll + | DTable (x, n, c, s) => + S.map2 (mfc ctx c, + fn c' => + (DTable (x, n, c', s), loc)) and mfvi ctx (x, n, t, e, s) = S.bind2 (mfc ctx t, @@ -703,6 +707,12 @@ fun mapfoldB (all as {bind, ...}) = foldl (fn ((x, n, t, e, s), ctx) => bind (ctx, NamedE (x, n, t, NONE, s))) ctx vis | DExport _ => ctx + | DTable (x, n, c, s) => + let + val t = (CApp ((CFfi ("Basis", "table"), #2 d'), c), #2 d') + in + bind (ctx, NamedE (x, n, t, NONE, s)) + end in S.map2 (mff ctx' ds', fn ds' => @@ -750,7 +760,8 @@ val maxName = foldl (fn ((d, _) : decl, count) => | DDatatype (_, n, _, _) => Int.max (n, count) | DVal (_, n, _, _, _) => Int.max (n, count) | DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis - | DExport _ => count) 0 + | DExport _ => count + | DTable (_, n, _, _) => Int.max (n, count)) 0 end diff --git a/src/corify.sml b/src/corify.sml index 6e893da2..b20a1136 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -806,7 +806,13 @@ structure St : sig end | _ => raise Fail "Non-const signature for 'export'") - | L.DTable _ => raise Fail "Corify DTable" + | L.DTable (_, x, n, c) => + let + val (st, n) = St.bindVal st x n + val s = x + in + ([(L'.DTable (x, n, corifyCon st c, s), loc)], st) + end and corifyStr ((str, _), st) = case str of diff --git a/src/monoize.sml b/src/monoize.sml index ba9c2087..9142e63c 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -809,6 +809,7 @@ fun monoDecl (env, fm) (all as (d, loc)) = in SOME (env, fm, (L'.DExport (ek, s, n, ts), loc)) end + | L.DTable _ => raise Fail "Monoize DTable" end fun monoize env ds = diff --git a/src/shake.sml b/src/shake.sml index 5b3a1bce..015d2f11 100644 --- a/src/shake.sml +++ b/src/shake.sml @@ -41,6 +41,8 @@ type free = { exp : IS.set } +val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan) + fun shake file = let val page_es = List.foldl @@ -53,7 +55,9 @@ fun shake file = | ((DVal (_, n, t, e, _), _), (cdef, edef)) => (cdef, IM.insert (edef, n, (t, e))) | ((DValRec vis, _), (cdef, edef)) => (cdef, foldl (fn ((_, n, t, e, _), edef) => IM.insert (edef, n, (t, e))) edef vis) - | ((DExport _, _), acc) => acc) + | ((DExport _, _), acc) => acc + | ((DTable (_, n, c, _), _), (cdef, edef)) => + (cdef, IM.insert (edef, n, (c, dummye)))) (IM.empty, IM.empty) file fun kind (_, s) = s @@ -105,7 +109,8 @@ fun shake file = | (DDatatype (_, n, _, _), _) => IS.member (#con s, n) | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis - | (DExport _, _) => true) file + | (DExport _, _) => true + | (DTable _, _) => true) file end end |