From 474b582b68ea9289f3da4355da816164138604b0 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 9 Aug 2007 15:34:37 +0000 Subject: [PATCH] Tidy up the treatment of newtypes, refactor, and fix Trac #736 I've forgotten the precise details already, but this patch significantly refactors the way newtypes are handled, fixes the foreign-export problem Trac #736 (which concerned newtypes), and gets rid of a bogus unsafeCoerce in the foreign export desugaring. --- compiler/basicTypes/DataCon.lhs | 5 ++- compiler/coreSyn/CoreUtils.lhs | 10 +++-- compiler/deSugar/DsCCall.lhs | 90 ++++++++++++++++++++------------------ compiler/deSugar/DsForeign.lhs | 42 ++++++++---------- compiler/typecheck/TcForeign.lhs | 2 +- compiler/typecheck/TcType.lhs | 29 +++++++----- compiler/types/Coercion.lhs | 36 ++++++++++----- compiler/types/TyCon.lhs | 28 ++++++------ compiler/types/Type.lhs | 24 ++++------ 9 files changed, 143 insertions(+), 123 deletions(-) diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index 9ce966e..dbc6355 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -766,8 +766,9 @@ splitProductType str ty deepSplitProductType_maybe ty = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty ; let {result - | isClosedNewTyCon tycon && not (isRecursiveTyCon tycon) - = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args) + | Just (ty', _co) <- instNewTyCon_maybe tycon tycon_args + , not (isRecursiveTyCon tycon) + = deepSplitProductType_maybe ty' -- Ignore the coercion? | isNewTyCon tycon = Nothing -- cannot unbox through recursive -- newtypes nor through families | otherwise = Just res} diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index d08a6c9..cb6770e 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -8,7 +8,7 @@ Utility functions on @Core@ syntax \begin{code} module CoreUtils ( -- Construction - mkInlineMe, mkSCC, mkCoerce, + mkInlineMe, mkSCC, mkCoerce, mkCoerceI, bindNonRec, needsCaseBinding, mkIfThenElse, mkAltExpr, mkPiType, mkPiTypes, @@ -194,6 +194,10 @@ mkInlineMe e = Note InlineMe e \begin{code} +mkCoerceI :: CoercionI -> CoreExpr -> CoreExpr +mkCoerceI IdCo e = e +mkCoerceI (ACo co) e = mkCoerce co e + mkCoerce :: Coercion -> CoreExpr -> CoreExpr mkCoerce co (Cast expr co2) = ASSERT(let { (from_ty, _to_ty) = coercionKind co; @@ -1159,8 +1163,8 @@ eta_expand n us expr ty -- coerce T (\x::[T] -> (coerce ([T]->Int) e) x) case splitNewTypeRepCo_maybe ty of { - Just(ty1,co) -> - mkCoerce (mkSymCoercion co) (eta_expand n us (mkCoerce co expr) ty1) ; + Just(ty1,co) -> mkCoerce (mkSymCoercion co) + (eta_expand n us (mkCoerce co expr) ty1) ; Nothing -> -- We have an expression of arity > 0, but its type isn't a function diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs index fca20df..5bcea3c 100644 --- a/compiler/deSugar/DsCCall.lhs +++ b/compiler/deSugar/DsCCall.lhs @@ -91,9 +91,9 @@ dsCCall :: CLabelString -- C routine to invoke -> DsM CoreExpr -- Result, of type ??? dsCCall lbl args may_gc result_ty - = mapAndUnzipDs unboxArg args `thenDs` \ (unboxed_args, arg_wrappers) -> + = mapAndUnzipDs unboxArg args `thenDs` \ (unboxed_args, arg_wrappers) -> boxResult id Nothing result_ty `thenDs` \ (ccall_result_ty, res_wrapper) -> - newUnique `thenDs` \ uniq -> + newUnique `thenDs` \ uniq -> let target = StaticTarget lbl the_fcall = CCall (CCallSpec target CCallConv may_gc) @@ -182,6 +182,7 @@ unboxArg arg ) + ----- Cases for .NET; almost certainly bit-rotted --------- | Just (tc, [arg_ty]) <- splitTyConApp_maybe arg_ty, tc == listTyCon, Just (cc,[]) <- splitTyConApp_maybe arg_ty, @@ -193,7 +194,7 @@ unboxArg arg \ body -> let io_ty = exprType body - Just (_,io_arg) = tcSplitIOType_maybe io_ty + Just (_,io_arg,_) = tcSplitIOType_maybe io_ty in mkApps (Var unpack_id) [ Type io_arg @@ -209,13 +210,14 @@ unboxArg arg \ body -> let io_ty = exprType body - Just (_,io_arg) = tcSplitIOType_maybe io_ty + Just (_,io_arg,_) = tcSplitIOType_maybe io_ty in mkApps (Var unpack_id) [ Type io_arg , arg , Lam prim_obj body ]) + --------------- End of cases for .NET -------------------- | otherwise = getSrcSpanDs `thenDs` \ l -> @@ -235,7 +237,8 @@ unboxArg arg \begin{code} -boxResult :: ((Maybe Type, CoreExpr -> CoreExpr) -> (Maybe Type, CoreExpr -> CoreExpr)) +boxResult :: ((Maybe Type, CoreExpr -> CoreExpr) + -> (Maybe Type, CoreExpr -> CoreExpr)) -> Maybe Id -> Type -> DsM (Type, CoreExpr -> CoreExpr) @@ -255,45 +258,45 @@ boxResult :: ((Maybe Type, CoreExpr -> CoreExpr) -> (Maybe Type, CoreExpr -> Cor -- It looks a mess: I wonder if it could be refactored. boxResult augment mbTopCon result_ty - | Just (io_tycon, io_res_ty) <- tcSplitIOType_maybe result_ty + | Just (io_tycon, io_res_ty, co) <- tcSplitIOType_maybe result_ty -- isIOType_maybe handles the case where the type is a -- simple wrapping of IO. E.g. -- newtype Wrap a = W (IO a) - -- No coercion necessay because its a non-recursive newtype + -- No coercion necessary because its a non-recursive newtype -- (If we wanted to handle a *recursive* newtype too, we'd need -- another case, and a coercion.) - = -- The result is IO t, so wrap the result in an IO constructor - - resultWrapper io_res_ty `thenDs` \ res -> - let aug_res = augment res - extra_result_tys = case aug_res of - (Just ty,_) - | isUnboxedTupleType ty - -> let (Just (_, ls)) = splitTyConApp_maybe ty in tail ls - _ -> [] - - return_result state anss - = mkConApp (tupleCon Unboxed (2 + length extra_result_tys)) - (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys) - ++ (state : anss)) - in - mk_alt return_result aug_res `thenDs` \ (ccall_res_ty, the_alt) -> - newSysLocalDs realWorldStatePrimTy `thenDs` \ state_id -> - let - io_data_con = head (tyConDataCons io_tycon) - toIOCon = case mbTopCon of - Nothing -> dataConWrapId io_data_con - Just x -> x - wrap = \ the_call -> mkApps (Var toIOCon) - [ Type io_res_ty, - Lam state_id $ - Case (App the_call (Var state_id)) - (mkWildId ccall_res_ty) - (coreAltType the_alt) - [the_alt] - ] - in - returnDs (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap) + -- The result is IO t, so wrap the result in an IO constructor + = do { res <- resultWrapper io_res_ty + ; let aug_res = augment res + extra_result_tys + = case aug_res of + (Just ty,_) + | isUnboxedTupleType ty + -> let (Just (_, ls)) = splitTyConApp_maybe ty in tail ls + _ -> [] + + return_result state anss + = mkConApp (tupleCon Unboxed (2 + length extra_result_tys)) + (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys) + ++ (state : anss)) + + ; (ccall_res_ty, the_alt) <- mk_alt return_result aug_res + + ; state_id <- newSysLocalDs realWorldStatePrimTy + ; let io_data_con = head (tyConDataCons io_tycon) + toIOCon = mbTopCon `orElse` dataConWrapId io_data_con + + wrap the_call = mkCoerceI (mkSymCoI co) $ + mkApps (Var toIOCon) + [ Type io_res_ty, + Lam state_id $ + Case (App the_call (Var state_id)) + (mkWildId ccall_res_ty) + (coreAltType the_alt) + [the_alt] + ] + + ; return (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap) } boxResult augment mbTopCon result_ty = -- It isn't IO, so do unsafePerformIO @@ -302,9 +305,9 @@ boxResult augment mbTopCon result_ty mk_alt return_result (augment res) `thenDs` \ (ccall_res_ty, the_alt) -> let wrap = \ the_call -> Case (App the_call (Var realWorldPrimId)) - (mkWildId ccall_res_ty) - (coreAltType the_alt) - [the_alt] + (mkWildId ccall_res_ty) + (coreAltType the_alt) + [the_alt] in returnDs (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap) where @@ -360,6 +363,9 @@ mk_alt return_result (Just prim_res_ty, wrap_result) resultWrapper :: Type -> DsM (Maybe Type, -- Type of the expected result, if any CoreExpr -> CoreExpr) -- Wrapper for the result +-- resultWrapper deals with the result *value* +-- E.g. foreign import foo :: Int -> IO T +-- Then resultWrapper deals with marshalling the 'T' part resultWrapper result_ty -- Base case 1: primitive types | isPrimitiveType result_ty diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index e7d5c39..10e072e 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -282,8 +282,9 @@ dsFExport fn_id ty ext_name cconv isDyn -- If it's IO t, return (t, True) -- If it's plain t, return (t, False) (case tcSplitIOType_maybe orig_res_ty of - Just (ioTyCon, res_ty) -> returnDs (res_ty, True) + Just (ioTyCon, res_ty, co) -> returnDs (res_ty, True) -- The function already returns IO t + -- ToDo: what about the coercion? Nothing -> returnDs (orig_res_ty, False) -- The function returns t ) `thenDs` \ (res_ty, -- t @@ -339,7 +340,6 @@ dsFExportDynamic id cconv dsLookupGlobalId newStablePtrName `thenDs` \ newStablePtrId -> dsLookupTyCon stablePtrTyConName `thenDs` \ stable_ptr_tycon -> let - mk_stbl_ptr_app = mkApps (Var newStablePtrId) [ Type arg_ty, Var cback ] stable_ptr_ty = mkTyConApp stable_ptr_tycon [arg_ty] export_ty = mkFunTy stable_ptr_ty arg_ty in @@ -348,12 +348,6 @@ dsFExportDynamic id cconv dsFExport id export_ty fe_nm cconv True `thenDs` \ (h_code, c_code, arg_reps, args_size) -> let - stbl_app cont ret_ty = mkApps (Var bindIOId) - [ Type stable_ptr_ty - , Type ret_ty - , mk_stbl_ptr_app - , cont - ] {- The arguments to the external function which will create a little bit of (template) code on the fly @@ -384,18 +378,19 @@ dsFExportDynamic id cconv _ -> Nothing in - dsCCall adjustor adj_args PlayRisky io_res_ty `thenDs` \ ccall_adj -> + dsCCall adjustor adj_args PlayRisky (mkTyConApp io_tc [res_ty]) `thenDs` \ ccall_adj -> -- PlayRisky: the adjustor doesn't allocate in the Haskell heap or do a callback - let ccall_adj_ty = exprType ccall_adj - ccall_io_adj = mkLams [stbl_value] $ -#ifdef DEBUG - pprTrace "DsForeign: why is there an unsafeCoerce here?" (text "") $ -#endif - (Cast ccall_adj (mkUnsafeCoercion ccall_adj_ty io_res_ty )) - io_app = mkLams tvs $ - mkLams [cback] $ - stbl_app ccall_io_adj res_ty + let io_app = mkLams tvs $ + Lam cback $ + mkCoerceI (mkSymCoI co) $ + mkApps (Var bindIOId) + [ Type stable_ptr_ty + , Type res_ty + , mkApps (Var newStablePtrId) [ Type arg_ty, Var cback ] + , Lam stbl_value ccall_adj + ] + fed = (id `setInlinePragma` NeverActive, io_app) -- Never inline the f.e.d. function, because the litlit -- might not be in scope in other modules. @@ -403,11 +398,12 @@ dsFExportDynamic id cconv returnDs ([fed], h_code, c_code) where - ty = idType id - (tvs,sans_foralls) = tcSplitForAllTys ty - ([arg_ty], io_res_ty) = tcSplitFunTys sans_foralls - [res_ty] = tcTyConAppArgs io_res_ty - -- Must use tcSplit* to see the (IO t), which is a newtype + ty = idType id + (tvs,sans_foralls) = tcSplitForAllTys ty + ([arg_ty], fn_res_ty) = tcSplitFunTys sans_foralls + Just (io_tc, res_ty, co) = tcSplitIOType_maybe fn_res_ty + -- Must have an IO type; hence Just + -- co : fn_res_ty ~ IO res_ty toCName :: Id -> String toCName i = showSDoc (pprCode CStyle (ppr (idName i))) diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index a710111..49ecffc 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -263,7 +263,7 @@ mustBeIO = False checkForeignRes non_io_result_ok pred_res_ty ty -- (IO t) is ok, and so is any newtype wrapping thereof - | Just (io, res_ty) <- tcSplitIOType_maybe ty, + | Just (io, res_ty, _) <- tcSplitIOType_maybe ty, pred_res_ty res_ty = returnM () diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 3271ec2..50659d5 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -140,6 +140,7 @@ import ForeignCall import Unify import VarSet import Type +import Coercion import TyCon -- others: @@ -840,6 +841,7 @@ tcSplitPredTy_maybe other = Nothing predTyUnique :: PredType -> Unique predTyUnique (IParam n _) = getUnique (ipNameName n) predTyUnique (ClassP clas tys) = getUnique clas +predTyUnique (EqPred a b) = pprPanic "predTyUnique" (ppr (EqPred a b)) \end{code} @@ -1050,6 +1052,7 @@ exactTyVarsOfType ty go (AppTy fun arg) = go fun `unionVarSet` go arg go (ForAllTy tyvar ty) = delVarSet (go ty) tyvar `unionVarSet` go_tv tyvar + go (NoteTy _ _) = panic "exactTyVarsOfType" -- Handled by tcView go_pred (IParam _ ty) = go ty go_pred (ClassP _ tys) = exactTyVarsOfTypes tys @@ -1103,22 +1106,28 @@ restricted set of types as arguments and results (the restricting factor being the ) \begin{code} -tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type) --- (isIOType t) returns (Just (IO,t')) if t is of the form (IO t'), or --- some newtype wrapping thereof +tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type, CoercionI) +-- (isIOType t) returns Just (IO,t',co) +-- if co : t ~ IO t' -- returns Nothing otherwise tcSplitIOType_maybe ty - | Just (io_tycon, [io_res_ty]) <- tcSplitTyConApp_maybe ty, + = case tcSplitTyConApp_maybe ty of -- This split absolutely has to be a tcSplit, because we must -- see the IO type; and it's a newtype which is transparent to splitTyConApp. - io_tycon `hasKey` ioTyConKey - = Just (io_tycon, io_res_ty) - | Just ty' <- coreView ty -- Look through non-recursive newtypes - = tcSplitIOType_maybe ty' + Just (io_tycon, [io_res_ty]) + | io_tycon `hasKey` ioTyConKey + -> Just (io_tycon, io_res_ty, IdCo) - | otherwise - = Nothing + Just (tc, tys) + | not (isRecursiveTyCon tc) + , Just (ty, co1) <- instNewTyCon_maybe tc tys + -- Newtypes that require a coercion are ok + -> case tcSplitIOType_maybe ty of + Nothing -> Nothing + Just (tc, ty', co2) -> Just (tc, ty', co1 `mkTransCoI` co2) + + other -> Nothing isFFITy :: Type -> Bool -- True for any TyCon that can possibly be an arg or result of an FFI call diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index 1e071eb..02d92d7 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -27,7 +27,7 @@ module Coercion ( mkForAllCoercion, mkFunCoercion, mkInstsCoercion, mkUnsafeCoercion, mkNewTypeCoercion, mkFamInstCoercion, mkAppsCoercion, - splitNewTypeRepCo_maybe, decomposeCo, + splitNewTypeRepCo_maybe, instNewTyCon_maybe, decomposeCo, unsafeCoercionTyCon, symCoercionTyCon, transCoercionTyCon, leftCoercionTyCon, @@ -413,24 +413,37 @@ unsafeCoercionTyConName = mkCoConName FSLIT("CoUnsafe") unsafeCoercionTyConKey u +instNewTyCon_maybe :: TyCon -> [Type] -> Maybe (Type, CoercionI) +-- instNewTyCon_maybe T ts +-- = Just (rep_ty, co) if co : T ts ~ rep_ty +instNewTyCon_maybe tc tys + | Just (tvs, ty, mb_co_tc) <- unwrapNewTyCon_maybe tc + = ASSERT( tys `lengthIs` tyConArity tc ) + Just (substTyWith tvs tys ty, + case mb_co_tc of + Nothing -> IdCo + Just co_tc -> ACo (mkTyConApp co_tc tys)) + | otherwise + = Nothing + -- this is here to avoid module loops splitNewTypeRepCo_maybe :: Type -> Maybe (Type, Coercion) -- Sometimes we want to look through a newtype and get its associated coercion -- It only strips *one layer* off, so the caller will usually call itself recursively -- Only applied to types of kind *, hence the newtype is always saturated +-- splitNewTypeRepCo_maybe ty +-- = Just (ty', co) if co : ty ~ ty' +-- Returns Nothing for non-newtypes or fully-transparent newtypes splitNewTypeRepCo_maybe ty | Just ty' <- coreView ty = splitNewTypeRepCo_maybe ty' splitNewTypeRepCo_maybe (TyConApp tc tys) - | isClosedNewTyCon tc - = ASSERT( tys `lengthIs` tyConArity tc ) -- splitNewTypeRepCo_maybe only be applied - -- to *types* (of kind *) - case newTyConRhs tc of - (tvs, rep_ty) -> - ASSERT( length tvs == length tys ) - Just (substTyWith tvs tys rep_ty, mkTyConApp co_con tys) - where - co_con = maybe (pprPanic "splitNewTypeRepCo_maybe" (ppr tc)) id (newTyConCo_maybe tc) -splitNewTypeRepCo_maybe other = Nothing + | Just (ty', coi) <- instNewTyCon_maybe tc tys + = case coi of + ACo co -> Just (ty', co) + IdCo -> panic "splitNewTypeRepCo_maybe" + -- This case handled by coreView +splitNewTypeRepCo_maybe other + = Nothing \end{code} @@ -440,7 +453,6 @@ splitNewTypeRepCo_maybe other = Nothing \begin{code} - -- CoercionI is either -- (a) proper coercion -- (b) the identity coercion diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 9aa0fe5..1471f57 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -18,8 +18,10 @@ module TyCon( SynTyConRhs(..), isFunTyCon, isUnLiftedTyCon, isProductTyCon, - isAlgTyCon, isDataTyCon, isNewTyCon, isClosedNewTyCon, isSynTyCon, - isClosedSynTyCon, isPrimTyCon, + isAlgTyCon, isDataTyCon, + isNewTyCon, unwrapNewTyCon_maybe, + isSynTyCon, isClosedSynTyCon, + isPrimTyCon, isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon, assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity, @@ -642,19 +644,15 @@ isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity isDataTyCon other = False isNewTyCon :: TyCon -> Bool -isNewTyCon (AlgTyCon {algTcRhs = rhs}) = - case rhs of - NewTyCon {} -> True - _ -> False -isNewTyCon other = False - --- This is an important refinement as typical newtype optimisations do *not* --- hold for newtype families. Why? Given a type `T a', if T is a newtype --- family, there is no unique right hand side by which `T a' can be replaced --- by a cast. --- -isClosedNewTyCon :: TyCon -> Bool -isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon) +isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True +isNewTyCon other = False + +unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, Maybe TyCon) +unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs, + algTcRhs = NewTyCon { nt_co = mb_co, + nt_rhs = rhs }}) + = Just (tvs, rhs, mb_co) +unwrapNewTyCon_maybe other = Nothing isProductTyCon :: TyCon -> Bool -- A "product" tycon diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index a5ff5ad..8f23a35 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -407,8 +407,6 @@ splitNewTyConApp_maybe (TyConApp tc tys) = Just (tc, tys) splitNewTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res]) splitNewTyConApp_maybe other = Nothing --- get instantiated newtype rhs, the arguments had better saturate --- the constructor newTyConInstRhs :: TyCon -> [Type] -> Type newTyConInstRhs tycon tys = let (tvs, ty) = newTyConRhs tycon in substTyWith tvs tys ty @@ -450,12 +448,15 @@ repType :: Type -> Type repType ty | Just ty' <- coreView ty = repType ty' repType (ForAllTy _ ty) = repType ty repType (TyConApp tc tys) - | isClosedNewTyCon tc = -- Recursive newtypes are opaque to coreView - -- but we must expand them here. Sure to - -- be saturated because repType is only applied - -- to types of kind * - ASSERT( {- isRecursiveTyCon tc && -} tys `lengthIs` tyConArity tc ) - repType (new_type_rep tc tys) + | isNewTyCon tc + , (tvs, rep_ty) <- newTyConRep tc + = -- Recursive newtypes are opaque to coreView + -- but we must expand them here. Sure to + -- be saturated because repType is only applied + -- to types of kind * + ASSERT( tys `lengthIs` tyConArity tc ) + repType (substTyWith tvs tys rep_ty) + repType ty = ty -- repType' aims to be a more thorough version of repType @@ -468,12 +469,6 @@ repType' ty -- | pprTrace "repType'" (ppr ty $$ ppr (go1 ty)) False = undefined go ty = ty --- new_type_rep doesn't ask any questions: --- it just expands newtype, whether recursive or not -new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon ) - case newTyConRep new_tycon of - (tvs, rep_ty) -> substTyWith tvs tys rep_ty - -- ToDo: this could be moved to the code generator, using splitTyConApp instead -- of inspecting the type directly. typePrimRep :: Type -> PrimRep @@ -488,7 +483,6 @@ typePrimRep ty = case repType ty of -- The reason is that f must have kind *->*, not *->*#, because -- (we claim) there is no way to constrain f's kind any other -- way. - \end{code} -- 1.7.10.4