X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FGenerics.lhs;h=01632d35963183999354deabdd5177da9ec533db;hp=37d9d4a5da2ff186f45ce3965ecbf2d25aaa02bf;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4 diff --git a/compiler/types/Generics.lhs b/compiler/types/Generics.lhs index 37d9d4a..01632d3 100644 --- a/compiler/types/Generics.lhs +++ b/compiler/types/Generics.lhs @@ -3,7 +3,7 @@ % \begin{code} -{-# OPTIONS -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 @@ -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)