Extend Class.Class to include the TyCons of ATs

[ghc-hetmet.git] / compiler / typecheck / TcSplice.lhs

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index d59b0f8..1d17c4d 100644 (file)
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -567,7 +567,7 @@ reifyThing (AGlobal (ADataCon dc))
        ; fix <- reifyFixity name
        ; return (TH.DataConI (reifyName name) ty (reifyName (dataConTyCon dc)) fix) }
 
-reifyThing (ATcId {tct_id = id, tct_ty = ty}) 
+reifyThing (ATcId {tct_id = id, tct_type = ty}) 
   = do { ty1 <- zonkTcType ty  -- Make use of all the info we have, even
                                -- though it may be incomplete
        ; ty2 <- reifyType ty1
@@ -585,9 +585,12 @@ reifyTyCon tc
   | isFunTyCon tc  = return (TH.PrimTyConI (reifyName tc) 2              False)
   | isPrimTyCon tc = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
   | isSynTyCon tc
-  = do { let (tvs, rhs) = synTyConDefn tc
-       ; rhs' <- reifyType rhs
-       ; return (TH.TyConI $ TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
+  = case synTyConDefn tc of
+      Nothing         -> noTH SLIT("type family") (ppr tc)
+      Just (tvs, rhs) -> 
+        do { rhs' <- reifyType rhs
+          ; return (TH.TyConI $ 
+                      TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
 
 reifyTyCon tc
   = do         { cxt <- reifyCxt (tyConStupidTheta tc)
@@ -628,7 +631,7 @@ reifyClass cls
        ; ops <- mapM reify_op op_stuff
        ; return (TH.ClassI $ TH.ClassD cxt (reifyName cls) (reifyTyVars tvs) fds' ops) }
   where
-    (tvs, fds, theta, _, op_stuff) = classExtraBigSig cls
+    (tvs, fds, theta, _, _, op_stuff) = classExtraBigSig cls
     fds' = map reifyFunDep fds
     reify_op (op, _) = do { ty <- reifyType (idType op)
                          ; return (TH.SigD (reifyName op) ty) }