changeset 1325:fdf48f6ba418

More hnorm during type class resolution
author Adam Chlipala <adam@chlipala.net>
date Thu, 02 Dec 2010 12:24:09 -0500
parents d596c7002ad8
children d91f84599693
files src/elab_env.sml
diffstat 1 files changed, 6 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
--- a/src/elab_env.sml	Sun Nov 28 15:06:11 2010 -0500
+++ b/src/elab_env.sml	Thu Dec 02 12:24:09 2010 -0500
@@ -559,10 +559,10 @@
 
       | _ => raise Unify
 
-fun unifyCons rs =
+fun unifyCons (hnorm : con -> con) rs =
     let
         fun unify d (c1, c2) =
-            case (#1 c1, #1 c2) of
+            case (#1 (hnorm c1), #1 (hnorm c2)) of
                 (CUnif (nl, _, _, _, ref (SOME c1)), _) => unify d (mliftConInCon nl c1, c2)
               | (_, CUnif (nl, _, _, _, ref (SOME c2))) => unify d (c1, mliftConInCon nl c2)
 
@@ -623,11 +623,11 @@
         unify
     end
 
-fun tryUnify nRs (c1, c2) =
+fun tryUnify hnorm nRs (c1, c2) =
     let
         val rs = List.tabulate (nRs, fn _ => ref NONE)
     in
-        (unifyCons rs 0 (c1, c2);
+        (unifyCons hnorm rs 0 (c1, c2);
          SOME (map (fn r => case !r of
                                 NONE => raise Unify
                               | SOME c => c) rs))
@@ -712,7 +712,7 @@
                                 case rules of
                                     [] => NONE
                                   | (nRs, cs, c', e) :: rules' =>
-                                    case tryUnify nRs (c, c') of
+                                    case tryUnify hnorm nRs (c, c') of
                                         NONE => tryRules rules'
                                       | SOME rs =>
                                         let
@@ -739,7 +739,7 @@
                                 case ces of
                                     [] => rules ()
                                   | (c', e) :: ces' =>
-                                    case tryUnify 0 (c, c') of
+                                    case tryUnify hnorm 0 (c, c') of
                                         NONE => tryGrounds ces'
                                       | SOME _ => SOME e
                         in