[commit: ghc] master: Assert that matcher-derived PatSyn types match the (redundant) stored types in IfacePatSyn (fb74d71)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/fb74d71756042fe954b2a82d208041df56a08377/ghc

>---------------------------------------------------------------

commit fb74d71756042fe954b2a82d208041df56a08377
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Tue May 27 21:48:42 2014 +0800

    Assert that matcher-derived PatSyn types match the (redundant) stored types in IfacePatSyn


>---------------------------------------------------------------

fb74d71756042fe954b2a82d208041df56a08377
 compiler/iface/BuildTyCl.lhs | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index eb5db54..f2d6f7e 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -193,7 +193,14 @@ buildPatSyn :: Name -> Bool
             -> PatSyn
 buildPatSyn src_name declared_infix matcher wrapper
             args univ_tvs ex_tvs prov_theta req_theta pat_ty
-  = mkPatSyn src_name declared_infix
+  = ASSERT((and [ univ_tvs == univ_tvs'
+                , ex_tvs == ex_tvs'
+                , pat_ty `eqType` pat_ty'
+                , prov_theta `eqTypes` prov_theta'
+                , req_theta `eqTypes` req_theta'
+                , args `eqTypes` args'
+                ]))
+    mkPatSyn src_name declared_infix
              args
              univ_tvs ex_tvs
              prov_theta req_theta
@@ -201,12 +208,10 @@ buildPatSyn src_name declared_infix matcher wrapper
              matcher
              wrapper
   where
-    -- TODO: assert that these match the ones in the parameters
-    ((_:_univ_tvs'), _req_theta', tau) = tcSplitSigmaTy $ idType matcher
-    ([_pat_ty', cont_sigma, _], _) = tcSplitFunTys tau
-    (_ex_tvs', _prov_theta', cont_tau) = tcSplitSigmaTy cont_sigma
-    (_args', _) = tcSplitFunTys cont_tau
-
+    ((_:univ_tvs'), req_theta', tau) = tcSplitSigmaTy $ idType matcher
+    ([pat_ty', cont_sigma, _], _) = tcSplitFunTys tau
+    (ex_tvs', prov_theta', cont_tau) = tcSplitSigmaTy cont_sigma
+    (args', _) = tcSplitFunTys cont_tau
 \end{code}