Add missing cases in TcUnify.uUnfilledVars
authorSimon Peyton Jones <simonpj@microsoft.com>
Sat, 26 Nov 2011 21:47:39 +0000 (21:47 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Sat, 26 Nov 2011 21:47:39 +0000 (21:47 +0000)
These missing cases dealt with unifying a meta type variable with a
skolem when the kinds match -- a pretty common case.  The missing
cases meant that instead of directly solving on the fly (which is easy
in this situation) we were generating an equality constraint viat
`utype_defer`.  This isn't *wrong*, but it's a lot less efficient than
it could be!

All this arose from investigating #5631.  This one change does this
to the compiler allocation

Before:
     821,257,552 bytes allocated in the heap
              94 MB total memory in use (0 MB lost due to fragmentation)

  MUT     time    1.54s  (  1.67s elapsed)
  GC      time    1.36s  (  1.60s elapsed)
  Total   time    2.93s  (  3.27s elapsed)

After:
     424,244,124 bytes allocated in the heap
              49 MB total memory in use (0 MB lost due to fragmentation)

  MUT     time    0.64s  (  0.89s elapsed)
  GC      time    0.83s  (  0.77s elapsed)
  Total   time    1.47s  (  1.66s elapsed)

Not bad for a 3-line change!

compiler/typecheck/TcUnify.lhs

index e049a87..f3117fa 100644 (file)
@@ -843,16 +843,22 @@ uUnfilledVars origin swapped tv1 details1 tv2 details2
        ; sub_kind <- addErrCtxtM ctxt $ unifyKind k1 k2
 
        ; case (sub_kind, details1, details2) of
-           -- k1 <= k2, so update tv2
+           -- k1 < k2, so update tv2
            (LT, _, MetaTv _ ref2) -> updateMeta tv2 ref2 ty1
-           -- k2 <= k1, so update tv1
+
+           -- k2 < k1, so update tv1
            (GT, MetaTv _ ref1, _) -> updateMeta tv1 ref1 ty2
+
+          -- k1 = k2, so we are free to update either way
            (EQ, MetaTv i1 ref1, MetaTv i2 ref2)
                 | nicer_to_update_tv1 i1 i2 -> updateMeta tv1 ref1 ty2
                 | otherwise                 -> updateMeta tv2 ref2 ty1
+           (EQ, MetaTv _ ref1, _)  -> updateMeta tv1 ref1 ty2
+           (EQ, _, MetaTv _ ref2) -> updateMeta tv2 ref2 ty1
 
+          -- Can't do it in-place, so defer
+          -- This happens for skolems of all sorts
            (_, _, _) -> unSwap swapped (uType_defer origin) ty1 ty2 } 
-                        -- Defer for skolems of all sorts
   where
     k1       = tyVarKind tv1
     k2       = tyVarKind tv2