Mercurial > urweb
changeset 247:5c50b17f5e4a
Corify tables
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 31 Aug 2008 09:00:28 -0400 |
| parents | 3aa010e97db9 |
| children | d5b12daa9b47 |
| files | src/core.sml src/core_env.sml src/core_print.sml src/core_util.sml src/corify.sml src/monoize.sml src/shake.sml |
| diffstat | 7 files changed, 54 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- a/src/core.sml Sun Aug 31 08:46:22 2008 -0400 +++ b/src/core.sml Sun Aug 31 09:00:28 2008 -0400 @@ -114,6 +114,7 @@ | 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
--- a/src/core_env.sml Sun Aug 31 08:46:22 2008 -0400 +++ b/src/core_env.sml Sun Aug 31 09:00:28 2008 -0400 @@ -187,6 +187,12 @@ | 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
--- a/src/core_print.sml Sun Aug 31 08:46:22 2008 -0400 +++ b/src/core_print.sml Sun Aug 31 09:00:28 2008 -0400 @@ -331,14 +331,17 @@ 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 @@ 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
--- a/src/core_util.sml Sun Aug 31 08:46:22 2008 -0400 +++ b/src/core_util.sml Sun Aug 31 09:00:28 2008 -0400 @@ -621,6 +621,10 @@ (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 @@ 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 @@ | 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
--- a/src/corify.sml Sun Aug 31 08:46:22 2008 -0400 +++ b/src/corify.sml Sun Aug 31 09:00:28 2008 -0400 @@ -806,7 +806,13 @@ 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
--- a/src/monoize.sml Sun Aug 31 08:46:22 2008 -0400 +++ b/src/monoize.sml Sun Aug 31 09:00:28 2008 -0400 @@ -809,6 +809,7 @@ in SOME (env, fm, (L'.DExport (ek, s, n, ts), loc)) end + | L.DTable _ => raise Fail "Monoize DTable" end fun monoize env ds =
--- a/src/shake.sml Sun Aug 31 08:46:22 2008 -0400 +++ b/src/shake.sml Sun Aug 31 09:00:28 2008 -0400 @@ -41,6 +41,8 @@ exp : IS.set } +val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan) + fun shake file = let val page_es = List.foldl @@ -53,7 +55,9 @@ | ((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 @@ | (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