Mercurial > urweb

diff src/elab_ops.sml @ 1034:a779402841f6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Hooks for measuring how much interesting proving is going on in elaboration
author Adam Chlipala <adamc@hcoop.net>
date Tue, 17 Nov 2009 12:44:14 -0500
parents 46803e668a89
children c7b9a33c26c8
line wrap: on
line diff
--- a/src/elab_ops.sml	Sun Nov 08 12:26:03 2009 -0500
+++ b/src/elab_ops.sml	Tue Nov 17 12:44:14 2009 -0500
@@ -143,6 +143,13 @@
                                | _ => n}
                   0
 
+val identity = ref 0
+val distribute = ref 0
+val fuse = ref 0
+
+fun reset () = (identity := 0;
+                distribute := 0;
+                fuse := 0)
 
 fun hnormCon env (cAll as (c, loc)) =
     case c of
@@ -219,6 +226,8 @@
                                       (TDisjoint (_, _, c), _) => unconstraint c
                                     | c => c
 
+                              fun inc r = r := !r + 1
+
                               fun tryDistributivity () =
                                   case hnormCon env c2 of
                                       (CConcat (c1, c2'), _) =>
@@ -230,6 +239,7 @@
                                           val c2 = (CApp (c, c2'), loc)
                                           val c = (CConcat (c1, c2), loc)
                                       in
+                                          inc distribute;
                                           hnormCon env c
                                       end
                                     | _ => default ()
@@ -253,6 +263,7 @@
                                                     val c = (CApp (c, f'), loc)
                                                     val c = (CApp (c, r'), loc)
                                                 in
+                                                    inc fuse;
                                                     hnormCon env c
                                                 end
                                               | _ => tryDistributivity ())
@@ -275,7 +286,8 @@
                                       case unconstraint c of
                                           (CUnif (_, _, _, vR'), _) =>
                                           if vR' = vR then
-                                              hnormCon env c2
+                                              (inc identity;
+                                               hnormCon env c2)
                                           else
                                               tryFusion ()
                                         | _ => tryFusion ()