X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FGenerics.lhs;h=01632d35963183999354deabdd5177da9ec533db;hp=bec661c18bbab961d4581d8ea80b3f7a10bf5040;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf diff --git a/compiler/types/Generics.lhs b/compiler/types/Generics.lhs index bec661c..01632d3 100644 --- a/compiler/types/Generics.lhs +++ b/compiler/types/Generics.lhs @@ -3,11 +3,11 @@ % \begin{code} -{-# OPTIONS_GHC -w #-} +{-# OPTIONS -fno-warn-incomplete-patterns #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details module Generics ( canDoGenerics, mkTyConGenericBinds, @@ -392,12 +392,13 @@ splitInHalf list = (left, right) mkGenericLocal :: US -> RdrName mkGenericLocal u = mkVarUnqual (mkFastString ("g" ++ show u)) +mkGenericNames :: TyCon -> (RdrName, RdrName) mkGenericNames tycon = (from_RDR, to_RDR) where tc_name = tyConName tycon tc_occ = nameOccName tc_name - tc_mod = nameModule tc_name + tc_mod = ASSERT( isExternalName tc_name ) nameModule tc_name from_RDR = mkOrig tc_mod (mkGenOcc1 tc_occ) to_RDR = mkOrig tc_mod (mkGenOcc2 tc_occ) \end{code} @@ -532,6 +533,7 @@ bimapTyCon tycon arg_eps ------------------- -- bimapArrow :: [EP a a', EP b b'] -> EP (a->b) (a'->b') +bimapArrow :: [EP (LHsExpr RdrName)] -> EP (LHsExpr RdrName) bimapArrow [ep1, ep2] = EP { fromEP = mkHsLam [nlVarPat a_RDR, nlVarPat b_RDR] from_body, toEP = mkHsLam [nlVarPat a_RDR, nlVarPat b_RDR] to_body } @@ -541,6 +543,7 @@ bimapArrow [ep1, ep2] ------------------- -- bimapTuple :: [EP a1 b1, ... EP an bn] -> EP (a1,...an) (b1,..bn) +bimapTuple :: [EP (LHsExpr RdrName)] -> EP (LHsExpr RdrName) bimapTuple eps = EP { fromEP = mkHsLam [noLoc tuple_pat] (noLoc from_body), toEP = mkHsLam [noLoc tuple_pat] (noLoc to_body) } @@ -553,13 +556,17 @@ bimapTuple eps ------------------- -- bimapList :: EP a b -> EP [a] [b] +bimapList :: [EP (LHsExpr RdrName)] -> EP (LHsExpr RdrName) bimapList [ep] = EP { fromEP = nlHsApp (nlHsVar map_RDR) (fromEP ep), toEP = nlHsApp (nlHsVar map_RDR) (toEP ep) } ------------------- -a_RDR = mkVarUnqual FSLIT("a") -b_RDR = mkVarUnqual FSLIT("b") +a_RDR, b_RDR :: RdrName +a_RDR = mkVarUnqual (fsLit "a") +b_RDR = mkVarUnqual (fsLit "b") + +gs_RDR :: [RdrName] gs_RDR = [ mkVarUnqual (mkFastString ("g"++show i)) | i <- [(1::Int) .. ] ] idEP :: EP (LHsExpr RdrName)