diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 35 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 274 |
2 files changed, 12 insertions, 297 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 2739e10fb2..b88a3b1bf8 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -841,10 +841,9 @@ topdecl :: { OrdList (LHsDecl RdrName) } | inst_decl { unitOL (sL1 $1 (InstD (unLoc $1))) } | stand_alone_deriving { unitOL (sLL $1 $> (DerivD (unLoc $1))) } | role_annot { unitOL (sL1 $1 (RoleAnnotD (unLoc $1))) } - | 'default' '(' comma_types0 ')' {% do { def <- checkValidDefaults $3 - ; amsu (sLL $1 $> (DefD def)) + | 'default' '(' comma_types0 ')' {% amsu (sLL $1 $> (DefD (DefaultDecl $3))) [mj AnnDefault $1 - ,mop $2,mcp $4] }} + ,mop $2,mcp $4] } | 'foreign' fdecl {% amsu (sLL $1 $> (snd $ unLoc $2)) (mj AnnForeign $1:(fst $ unLoc $2)) } | '{-# DEPRECATED' deprecations '#-}' {% amsu (sLL $1 $> $ WarningD (Warnings (getDEPRECATED_PRAGs $1) (fromOL $2))) @@ -950,12 +949,6 @@ inst_decl :: { LInstDecl RdrName } , cid_sigs = sigs, cid_tyfam_insts = ats , cid_overlap_mode = $2 , cid_datafam_insts = adts } - ; let err = text "In instance head:" <+> ppr $3 - ; checkNoPartialType err $3 - ; sequence_ [ checkNoPartialType err ty - | sig@(L _ (TypeSig _ ty _ )) <- sigs - , let err = text "in instance signature" <> colon - <+> quotes (ppr sig) ] ; ams (L (comb3 $1 $3 $4) (ClsInstD { cid_inst = cid })) (mj AnnInstance $1 : (fst $ unLoc $4)) } } @@ -1138,7 +1131,6 @@ stand_alone_deriving :: { LDerivDecl RdrName } {% do { let err = text "in the stand-alone deriving instance" <> colon <+> quotes (ppr $4) - ; checkNoPartialType err $4 ; ams (sLL $1 $> (DerivDecl $4 $3)) [mj AnnDeriving $1,mj AnnInstance $2] }} @@ -1204,7 +1196,6 @@ pattern_synonym_sig :: { LSig RdrName } : 'pattern' con '::' ptype {% do { let (flag, qtvs, prov, req, ty) = snd $ unLoc $4 ; let sig = PatSynSig $2 (flag, mkHsQTvs qtvs) prov req ty - ; checkValidPatSynSig sig ; ams (sLL $1 $> $ sig) (mj AnnPattern $1:mj AnnDcolon $3:(fst $ unLoc $4)) } } @@ -1239,7 +1230,6 @@ decl_cls : at_decl_cls { sLL $1 $> (unitOL $1) } {% do { (TypeSig l ty _) <- checkValSig $2 $4 ; let err = text "in default signature" <> colon <+> quotes (ppr ty) - ; checkNoPartialType err ty ; ams (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (GenericSig l ty))) [mj AnnDefault $1,mj AnnDcolon $3] } } @@ -1657,10 +1647,10 @@ btype :: { LHsType RdrName } atype :: { LHsType RdrName } : ntgtycon { sL1 $1 (HsTyVar (unLoc $1)) } -- Not including unit tuples - | tyvar {% do { nwc <- namedWildcardsEnabled -- (See Note [Unit tuples]) + | tyvar {% do { nwc <- namedWildCardsEnabled -- (See Note [Unit tuples]) ; let tv@(Unqual name) = unLoc $1 ; return $ if (startsWithUnderscore name && nwc) - then (sL1 $1 (HsNamedWildcardTy tv)) + then (sL1 $1 (mkNamedWildCardTy tv)) else (sL1 $1 (HsTyVar tv)) } } | strict_mark atype {% ams (sLL $1 $> (HsBangTy (snd $ unLoc $1) $2)) @@ -1717,7 +1707,7 @@ atype :: { LHsType RdrName } (getINTEGER $1) } | STRING { sLL $1 $> $ HsTyLit $ HsStrTy (getSTRINGs $1) (getSTRING $1) } - | '_' { sL1 $1 $ HsWildcardTy } + | '_' { sL1 $1 $ mkAnonWildCardTy } -- An inst_type is what occurs in the head of an instance decl -- e.g. (Foo a, Gaz b) => Wibble a b @@ -2039,14 +2029,12 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } : -- See Note [Declaration/signature overlap] for why we need infixexp here infixexp '::' sigtypedoc - {% do ty <- checkPartialTypeSignature $3 - ; s <- checkValSig $1 ty + {% do s <- checkValSig $1 $3 ; _ <- ams (sLL $1 $> ()) [mj AnnDcolon $2] ; return (sLL $1 $> $ unitOL (sLL $1 $> $ SigD s)) } | var ',' sig_vars '::' sigtypedoc - {% do { ty <- checkPartialTypeSignature $5 - ; let sig = TypeSig ($1 : reverse (unLoc $3)) ty PlaceHolder + {% do { let sig = TypeSig ($1 : reverse (unLoc $3)) $5 PlaceHolder ; addAnnotation (gl $1) AnnComma (gl $2) ; ams (sLL $1 $> $ toOL [ sLL $1 $> $ SigD sig ]) [mj AnnDcolon $4] } } @@ -2318,10 +2306,7 @@ aexp2 :: { LHsExpr RdrName } | TH_TY_QUOTE gtycon {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } | '[|' exp '|]' {% ams (sLL $1 $> $ HsBracket (ExpBr $2)) [mo $1,mc $3] } | '[||' exp '||]' {% ams (sLL $1 $> $ HsBracket (TExpBr $2)) [mo $1,mc $3]} - | '[t|' ctype '|]' {% checkNoPartialType - (text "in type brackets" <> colon - <+> quotes (text "[t|" <+> ppr $2 <+> text "|]")) $2 >> - ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] } + | '[t|' ctype '|]' {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] } | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p -> ams (sLL $1 $> $ HsBracket (PatBr p)) [mo $1,mc $3] } @@ -3301,8 +3286,8 @@ hintExplicitForall span = do , text "extension to enable explicit-forall syntax: \x2200 <tvs>. <type>" ] -namedWildcardsEnabled :: P Bool -namedWildcardsEnabled = liftM ((Opt_NamedWildCards `xopt`) . dflags) getPState +namedWildCardsEnabled :: P Bool +namedWildCardsEnabled = liftM ((Opt_NamedWildCards `xopt`) . dflags) getPState {- %************************************************************************ diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 98fa8f7608..d7af65da8e 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -49,12 +49,8 @@ module RdrHsSyn ( checkCommand, -- LHsExpr RdrName -> P (LHsCmd RdrName) checkValDef, -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl checkValSig, -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl - checkPartialTypeSignature, - checkNoPartialType, - checkValidPatSynSig, checkDoAndIfThenElse, checkRecordSyntax, - checkValidDefaults, parseErrorSDoc, -- Help with processing exports @@ -101,8 +97,6 @@ import Text.ParserCombinators.ReadP as ReadP import Data.Char import Data.Data ( dataTypeOf, fromConstr, dataTypeConstrs ) -import Data.List ( partition ) -import qualified Data.Set as Set ( fromList, difference, member ) #include "HsVersions.h" @@ -140,8 +134,6 @@ mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls ; let cxt = fromMaybe (noLoc []) mcxt ; (cls, tparams,ann) <- checkTyClHdr True tycl_hdr ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan - -- Partial type signatures are not allowed in a class definition - ; checkNoPartialSigs sigs cls ; tyvars <- checkTyVarsP (ptext (sLit "class")) whereDots cls tparams ; at_defs <- mapM (eitherToP . mkATDefault) at_insts ; return (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tyvars, @@ -165,104 +157,6 @@ mkATDefault (L loc (TyFamInstDecl { tfid_eqn = L _ e })) , tfe_pats = tvs , tfe_rhs = rhs })) } --- | Check that none of the given type signatures of the class definition --- ('Located RdrName') are partial type signatures. An error will be reported --- for each wildcard found in a (partial) type signature. We do this check --- because we want the signatures in a class definition to be fully specified. -checkNoPartialSigs :: [LSig RdrName] -> Located RdrName -> P () -checkNoPartialSigs sigs cls_name = - sequence_ [ whenIsJust mb_loc $ \loc -> parseErrorSDoc loc $ err sig - | L _ sig@(TypeSig _ ty _) <- sigs - , let mb_loc = maybeLocation $ findWildcards ty ] - where err sig = - vcat [ text "The type signature of a class method cannot be partial:" - , ppr sig - , text "In the class declaration for " <> quotes (ppr cls_name) ] - --- | Check that none of the given constructors contain a wildcard (like in a --- partial type signature). An error will be reported for each wildcard found --- in a (partial) constructor definition. We do this check because we want the --- type of a constructor to be fully specified. -checkNoPartialCon :: [LConDecl RdrName] -> P () -checkNoPartialCon con_decls = - sequence_ [ whenIsJust mb_loc $ \loc -> parseErrorSDoc loc $ err cd - | L _ cd@(ConDecl { con_cxt = cxt, con_res = res, - con_details = details }) <- con_decls - , let mb_loc = maybeLocation $ - concatMap findWildcards (unLoc cxt) ++ - containsWildcardRes res ++ - concatMap findWildcards - (hsConDeclArgTys details) ] - where err con_decl = text "A constructor cannot have a partial type:" $$ - ppr con_decl - containsWildcardRes (ResTyGADT _ ty) = findWildcards ty - containsWildcardRes ResTyH98 = notFound - --- | Check that the given type does not contain wildcards, and is thus not a --- partial type. If it contains wildcards, report an error with the given --- message. -checkNoPartialType :: SDoc -> LHsType RdrName -> P () -checkNoPartialType context_msg ty = - whenFound (findWildcards ty) $ \loc -> parseErrorSDoc loc err - where err = text "Wildcard not allowed" $$ context_msg - --- | Represent wildcards found in a type. Used for reporting errors for types --- that mustn't contain wildcards. -data FoundWildcard = Found { location :: SrcSpan } - | FoundNamed { location :: SrcSpan, _name :: RdrName } - --- | Indicate that no wildcards were found. -notFound :: [FoundWildcard] -notFound = [] - --- | Call the function (second argument), accepting the location of the --- wildcard, on the first wildcard that was found, if any. -whenFound :: [FoundWildcard] -> (SrcSpan -> P ()) -> P () -whenFound (Found loc:_) f = f loc -whenFound (FoundNamed loc _:_) f = f loc -whenFound _ _ = return () - --- | Extract the location of the first wildcard, if any. -maybeLocation :: [FoundWildcard] -> Maybe SrcSpan -maybeLocation fws = location <$> listToMaybe fws - --- | Extract the named wildcards from the wildcards that were found. -namedWildcards :: [FoundWildcard] -> [RdrName] -namedWildcards fws = [name | FoundNamed _ name <- fws] - --- | Split the found wildcards into a list of found unnamed wildcard and found --- named wildcards. -splitUnnamedNamed :: [FoundWildcard] -> ([FoundWildcard], [FoundWildcard]) -splitUnnamedNamed = partition (\f -> case f of { Found _ -> True ; _ -> False}) - --- | Return a list of the wildcards found while traversing the given type. -findWildcards :: LHsType RdrName -> [FoundWildcard] -findWildcards (L l ty) = case ty of - (HsForAllTy _ xtr _ (L _ ctxt) x) -> (map Found $ maybeToList xtr) ++ - concatMap go ctxt ++ go x - (HsAppTy x y) -> go x ++ go y - (HsFunTy x y) -> go x ++ go y - (HsListTy x) -> go x - (HsPArrTy x) -> go x - (HsTupleTy _ xs) -> concatMap go xs - (HsOpTy x _ y) -> go x ++ go y - (HsParTy x) -> go x - (HsIParamTy _ x) -> go x - (HsEqTy x y) -> go x ++ go y - (HsKindSig x y) -> go x ++ go y - (HsDocTy x _) -> go x - (HsBangTy _ x) -> go x - (HsRecTy xs) -> - concatMap (go . getBangType . cd_fld_type . unLoc) xs - (HsExplicitListTy _ xs) -> concatMap go xs - (HsExplicitTupleTy _ xs) -> concatMap go xs - (HsWrapTy _ x) -> go (noLoc x) - HsWildcardTy -> [Found l] - (HsNamedWildcardTy n) -> [FoundNamed l n] - -- HsTyVar, HsQuasiQuoteTy, HsSpliceTy, HsCoreTy, HsTyLit - _ -> notFound - where go = findWildcards - mkTyData :: SrcSpan -> NewOrData -> Maybe (Located CType) @@ -289,17 +183,12 @@ mkDataDefn :: NewOrData -> P (HsDataDefn RdrName) mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv = do { checkDatatypeContext mcxt - ; checkNoPartialCon data_cons - ; whenIsJust maybe_deriv $ - \(L _ deriv) -> mapM_ (checkNoPartialType (errDeriv deriv)) deriv ; let cxt = fromMaybe (noLoc []) mcxt ; return (HsDataDefn { dd_ND = new_or_data, dd_cType = cType , dd_ctxt = cxt , dd_cons = data_cons , dd_kindSig = ksig , dd_derivs = maybe_deriv }) } - where errDeriv deriv = text "In the deriving items:" <+> - pprHsContextNoArrow deriv mkTySynonym :: SrcSpan @@ -310,9 +199,6 @@ mkTySynonym loc lhs rhs = do { (tc, tparams,ann) <- checkTyClHdr False lhs ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan ; tyvars <- checkTyVarsP (ptext (sLit "type")) equalsDots tc tparams - ; let err = text "In type synonym" <+> quotes (ppr tc) <> - colon <+> ppr rhs - ; checkNoPartialType err rhs ; return (L loc (SynDecl { tcdLName = tc, tcdTyVars = tyvars , tcdRhs = rhs, tcdFVs = placeHolderNames })) } @@ -320,12 +206,7 @@ mkTyFamInstEqn :: LHsType RdrName -> LHsType RdrName -> P (TyFamInstEqn RdrName,[AddAnn]) mkTyFamInstEqn lhs rhs - = do { (tc, tparams,ann) <- checkTyClHdr False lhs - ; let err xhs = hang (text "In type family instance equation of" <+> - quotes (ppr tc) <> colon) - 2 (ppr xhs) - ; checkNoPartialType (err lhs) lhs - ; checkNoPartialType (err rhs) rhs + = do { (tc, tparams, ann) <- checkTyClHdr False lhs ; return (TyFamEqn { tfe_tycon = tc , tfe_pats = mkHsWithBndrs tparams , tfe_rhs = rhs }, @@ -637,11 +518,7 @@ mkGadtDecl' :: [Located RdrName] -- and expand it as if it had been -- C :: ty; D :: ty -- (Just like type signatures in general.) -mkGadtDecl' _ ty@(L _ (HsForAllTy _ (Just l) _ _ _)) - = parseErrorSDoc l $ - text "A constructor cannot have a partial type:" $$ - ppr ty -mkGadtDecl' names (L ls (HsForAllTy imp Nothing qvars cxt tau)) +mkGadtDecl' names (L ls (HsForAllTy imp _ qvars cxt tau)) = return $ mk_gadt_con names where (details, res_ty) -- See Note [Sorting out the result type] @@ -822,8 +699,6 @@ checkDatatypeContext (Just (L loc c)) parseErrorSDoc loc (text "Illegal datatype context (use DatatypeContexts):" <+> pprHsContext c) - mapM_ (checkNoPartialType err) c - where err = text "In the context:" <+> pprHsContextNoArrow c checkRecordSyntax :: Outputable a => Located a -> P (Located a) checkRecordSyntax lr@(L loc r) @@ -1096,144 +971,6 @@ checkValSig lhs@(L l _) ty default_RDR = mkUnqual varName (fsLit "default") --- | Check that the default declarations do not contain wildcards in their --- types, which we do not want as the types in the default declarations must --- be fully specified. -checkValidDefaults :: [LHsType RdrName] -> P (DefaultDecl RdrName) -checkValidDefaults tys = mapM_ (checkNoPartialType err) tys >> return ret - where ret = DefaultDecl tys - err = text "In declaration:" <+> ppr ret - --- | Check that the pattern synonym type signature does not contain wildcards. -checkValidPatSynSig :: Sig RdrName -> P (Sig RdrName) -checkValidPatSynSig psig@(PatSynSig _ _ prov req ty) - = mapM_ (checkNoPartialType err) (unLoc prov ++ unLoc req ++ [ty]) - >> return psig - where err = hang (text "In pattern synonym type signature: ") - 2 (ppr psig) -checkValidPatSynSig sig = return sig --- Should only be called with a pattern synonym type signature - --- | Check the validity of a partial type signature. We check the following --- things: --- --- * There should only be one extra-constraints wildcard in the type --- signature, i.e. the @_@ in @_ => a -> String@. --- This would be invalid: @(Eq a, _) => a -> (Num a, _) => a -> Bool@. --- Extra-constraints wildcards are only allowed in the top-level context. --- --- * Named extra-constraints wildcards aren't allowed, --- e.g. invalid: @(Show a, _x) => a -> String@. --- --- * There is only one extra-constraints wildcard in the context and it must --- come last, e.g. invalid: @(_, Show a) => a -> String@ --- or @(_, Show a, _) => a -> String@. --- --- * There should be no unnamed wildcards in the context. --- --- * Named wildcards occurring in the context must also occur in the monotype. --- --- An error is reported when an invalid wildcard is found. -checkPartialTypeSignature :: LHsType RdrName -> P (LHsType RdrName) -checkPartialTypeSignature fullTy = case fullTy of - - (L l (HsForAllTy flag extra bndrs (L lc ctxtP) ty)) -> do - -- Remove parens around types in the context - let ctxt = map ignoreParens ctxtP - -- Check that the type doesn't contain any more extra-constraints wildcards - checkNoExtraConstraintsWildcard ty - -- Named extra-constraints wildcards aren't allowed - whenIsJust (firstMatch isNamedWildcardTy ctxt) $ - \(L l _) -> err hintNamed l fullTy - -- There should be no more (extra-constraints) wildcards in the context. - -- If there was one at the end of the context, it is by now already - -- removed from the context and stored in the @extra@ field of the - -- 'HsForAllTy' by 'HsTypes.mkHsForAllTy'. - whenIsJust (firstMatch isWildcardTy ctxt) $ - \(L l _) -> err hintLast l fullTy - -- Find all wildcards in the context and the monotype, then divide - -- them in unnamed and named wildcards - let (unnamedInCtxt, namedInCtxt) = splitUnnamedNamed $ - concatMap findWildcards ctxt - (_ , namedInTy) = splitUnnamedNamed $ - findWildcards ty - -- Unnamed wildcards aren't allowed in the context - case unnamedInCtxt of - (Found lc : _) -> err hintUnnamedConstraint lc fullTy - _ -> return () - -- Calculcate the set of named wildcards in the context that aren't in the - -- monotype (tau) - let namedWildcardsNotInTau = Set.fromList (namedWildcards namedInCtxt) - `Set.difference` - Set.fromList (namedWildcards namedInTy) - -- Search for the first named wildcard that we encountered in the - -- context that isn't present in the monotype (we lose the order - -- in which they occur when using the Set directly). - case filter (\(FoundNamed _ name) -> Set.member name namedWildcardsNotInTau) - namedInCtxt of - (FoundNamed lc name:_) -> err (hintNamedNotInMonotype name) lc fullTy - _ -> return () - - -- Return the checked type - return $ L l (HsForAllTy flag extra bndrs (L lc ctxtP) ty) - - - ty -> do - checkNoExtraConstraintsWildcard ty - return ty - - where - ignoreParens (L _ (HsParTy ty)) = ty - ignoreParens ty = ty - - firstMatch :: (HsType a -> Bool) -> HsContext a -> Maybe (LHsType a) - firstMatch pred ctxt = listToMaybe (filter (pred . unLoc) ctxt) - - err hintSDoc lc ty = parseErrorSDoc lc $ - text "Invalid partial type signature:" $$ - ppr ty $$ hintSDoc - hintLast = sep [ text "An extra-constraints wildcard is only allowed" - , text "at the end of the constraints" ] - hintNamed = text "A named wildcard cannot occur as a constraint" - hintNested = sep [ text "An extra-constraints wildcard is only allowed" - , text "at the top-level of the signature" ] - hintUnnamedConstraint - = text "Wildcards are not allowed within the constraints" - hintNamedNotInMonotype name - = sep [ text "The named wildcard" <+> quotes (ppr name) <+> - text "is only allowed in the constraints" - , text "when it also occurs in the (mono)type" ] - - checkNoExtraConstraintsWildcard (L _ ty) = go ty - where - -- Report nested (named) extra-constraints wildcards - go' = go . unLoc - go (HsAppTy x y) = go' x >> go' y - go (HsFunTy x y) = go' x >> go' y - go (HsListTy x) = go' x - go (HsPArrTy x) = go' x - go (HsTupleTy _ xs) = mapM_ go' xs - go (HsOpTy x _ y) = go' x >> go' y - go (HsParTy x) = go' x - go (HsIParamTy _ x) = go' x - go (HsEqTy x y) = go' x >> go' y - go (HsKindSig x y) = go' x >> go' y - go (HsDocTy x _) = go' x - go (HsBangTy _ x) = go' x - go (HsRecTy xs) = mapM_ (go' . getBangType . cd_fld_type . unLoc) xs - go (HsExplicitListTy _ xs) = mapM_ go' xs - go (HsExplicitTupleTy _ xs) = mapM_ go' xs - go (HsWrapTy _ x) = go' (noLoc x) - go (HsForAllTy _ (Just l) _ _ _) = err hintNested l ty - go (HsForAllTy _ Nothing _ (L _ ctxt) x) - | Just (L l _) <- firstMatch isWildcardTy ctxt - = err hintNested l ty - | Just (L l _) <- firstMatch isNamedWildcardTy ctxt - = err hintNamed l ty - | otherwise = go' x - go _ = return () - - checkDoAndIfThenElse :: LHsExpr RdrName -> Bool -> LHsExpr RdrName @@ -1475,11 +1212,6 @@ mkImport :: Located CCallConv -> (Located (SourceText,FastString), Located RdrName, LHsType RdrName) -> P (HsDecl RdrName) mkImport (L lc cconv) (L ls safety) (L loc (esrc,entity), v, ty) - | Just loc <- maybeLocation $ findWildcards ty - = parseErrorSDoc loc $ - text "Wildcard not allowed" $$ - text "In foreign import declaration" <+> - quotes (ppr v) $$ ppr ty | cconv == PrimCallConv = do let funcTarget = CFunction (StaticTarget esrc entity Nothing True) importSpec = CImport (L lc PrimCallConv) (L ls safety) Nothing funcTarget @@ -1559,8 +1291,6 @@ mkExport :: Located CCallConv -> (Located (SourceText,FastString), Located RdrName, LHsType RdrName) -> P (HsDecl RdrName) mkExport (L lc cconv) (L le (esrc,entity), v, ty) = do - checkNoPartialType (ptext (sLit "In foreign export declaration") <+> - quotes (ppr v) $$ ppr ty) ty return $ ForD (ForeignExport v ty noForeignExportCoercionYet (CExport (L lc (CExportStatic esrc entity' cconv)) (L le (unpackFS entity)))) |