changeset 247:5c50b17f5e4a

Corify tables
author Adam Chlipala <adamc@hcoop.net>
date Sun, 31 Aug 2008 09:00:28 -0400 (2008-08-31)
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