diff src/elaborate.sml @ 280:fdd7a698be01

Compiling a parametrized query the inefficient way
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 17:31:45 -0400
parents 42dfb0d61cf0
children 77a28e7430bf
line wrap: on
line diff
--- a/src/elaborate.sml	Tue Sep 02 16:18:05 2008 -0400
+++ b/src/elaborate.sml	Tue Sep 02 17:31:45 2008 -0400
@@ -1482,11 +1482,9 @@
 
 fun elabExp (env, denv) (eAll as (e, loc)) =
     let
-        
-    in
-        (*eprefaces "elabExp" [("eAll", SourcePrint.p_exp eAll)];*)
-
-        case e of
+        (*val () = eprefaces "elabExp" [("eAll", SourcePrint.p_exp eAll)];*)
+
+        val r = case e of
             L.EAnnot (e, t) =>
             let
                 val (e', et, gs1) = elabExp (env, denv) e
@@ -1756,6 +1754,12 @@
 
                 ((L'.ECase (e', pes', {disc = et, result = result}), loc), result, enD gs' @ gs)
             end
+
+        (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 r)*)
+    in
+        (*prefaces "elabExp" [("e", SourcePrint.p_exp eAll),
+                            ("|tcs|", PD.string (Int.toString (length tcs)))];*)
+        r
     end
             
 
@@ -2731,7 +2735,7 @@
       | _ => sgnError env (SgnWrongForm (sgn1, sgn2))
 
 
-fun elabDecl ((d, loc), (env, denv, gs : constraint list)) =
+fun elabDecl (dAll as (d, loc), (env, denv, gs : constraint list)) =
     let
         (*val () = preface ("elabDecl", SourcePrint.p_decl (d, loc))*)
 
@@ -2873,7 +2877,7 @@
                                                                      | SOME c => elabCon (env, denv) c
                                             in
                                                 ((x, c', e), enD gs1 @ gs)
-                                            end) [] vis
+                                            end) gs vis
 
                     val (vis, env) = ListUtil.foldlMap (fn ((x, c', e), env) =>
                                                            let
@@ -3103,16 +3107,21 @@
               | L.DClass (x, c) =>
                 let
                     val k = (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc)
-                    val (c', ck, gs) = elabCon (env, denv) c
+                    val (c', ck, gs') = elabCon (env, denv) c
                     val (env, n) = E.pushCNamed env x k (SOME c')
                     val env = E.pushClass env n
                 in
                     checkKind env c' ck k;
-                    ([(L'.DClass (x, n, c'), loc)], (env, denv, []))
+                    ([(L'.DClass (x, n, c'), loc)], (env, denv, enD gs' @ gs))
                 end
 
-              | L.DDatabase s => ([(L'.DDatabase s, loc)], (env, denv, []))
+              | L.DDatabase s => ([(L'.DDatabase s, loc)], (env, denv, gs))
+
+        (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*)
     in
+        (*prefaces "elabDecl" [("e", SourcePrint.p_decl dAll),
+                            ("|tcs|", PD.string (Int.toString (length tcs)))];*)
+
         r
     end