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

1 files changed, 12 insertions, 7 deletions

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index eb5db548cc..f2d6f7e39a 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}