From 994019420daa6226ac33a52fdb063d56b46ef066 Mon Sep 17 00:00:00 2001 From: simonpj Date: Thu, 19 Mar 1998 23:59:20 +0000 Subject: [PATCH] [project @ 1998-03-19 23:59:17 by simonpj] oops.. forgot the adds/removes --- ghc/compiler/basicTypes/MkId.hi-boot | 7 + ghc/compiler/basicTypes/MkId.lhs | 387 ++++++++++++++++++++++++++++++++ ghc/compiler/basicTypes/PragmaInfo.lhs | 23 -- ghc/compiler/prelude/StdIdInfo.hi-boot | 5 - ghc/compiler/prelude/StdIdInfo.lhs | 260 --------------------- 5 files changed, 394 insertions(+), 288 deletions(-) create mode 100644 ghc/compiler/basicTypes/MkId.hi-boot create mode 100644 ghc/compiler/basicTypes/MkId.lhs delete mode 100644 ghc/compiler/basicTypes/PragmaInfo.lhs delete mode 100644 ghc/compiler/prelude/StdIdInfo.hi-boot delete mode 100644 ghc/compiler/prelude/StdIdInfo.lhs diff --git a/ghc/compiler/basicTypes/MkId.hi-boot b/ghc/compiler/basicTypes/MkId.hi-boot new file mode 100644 index 0000000..924c378 --- /dev/null +++ b/ghc/compiler/basicTypes/MkId.hi-boot @@ -0,0 +1,7 @@ +_interface_ MkId 1 +_exports_ +MkId mkDataCon mkTupleCon ; +_declarations_ +1 mkDataCon _:_ Name.Name -> [Id!StrictnessMark] -> [FieldLabel!FieldLabel] -> [TyVar.TyVar] -> Type.ThetaType -> [TyVar.TyVar] -> Type!ThetaType -> [Type!TauType] -> TyCon!TyCon -> Id!Id ;; +1 mkTupleCon _:_ PrelBase.Int -> Name.Name -> Type!Type -> Id!Id ;; + diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs new file mode 100644 index 0000000..216538e --- /dev/null +++ b/ghc/compiler/basicTypes/MkId.lhs @@ -0,0 +1,387 @@ +% +% (c) The AQUA Project, Glasgow University, 1994-1996 +% +\section[StdIdInfo]{Standard unfoldings} + +This module contains definitions for the IdInfo for things that +have a standard form, namely: + + * data constructors + * record selectors + * method and superclass selectors + * primitive operations + +\begin{code} +module MkId ( + mkImportedId, + mkUserId, + mkUserLocal, mkSysLocal, + + mkDataCon, mkTupleCon, + + mkDictFunId, + mkMethodSelId, mkSuperDictSelId, mkDefaultMethodId, + + mkRecordSelId, + + mkPrimitiveId, + mkWorkerId + + ) where + +#include "HsVersions.h" + +import {-# SOURCE #-} CoreUnfold ( mkUnfolding ) + +import Type +import CoreSyn +import Literal +import TysWiredIn ( tupleCon ) +import Name ( mkLocalName, mkSysLocalName, mkCompoundName, + occNameString, Name, OccName, NamedThing(..) + ) +import Id ( idType, fIRST_TAG, + mkTemplateLocals, mkId, mkVanillaId, + dataConStrictMarks, dataConFieldLabels, dataConArgTys, + recordSelectorFieldLabel, dataConSig, + StrictnessMark(..), + Id, IdDetails(..), GenId + ) +import IdInfo ( noIdInfo, + exactArity, setUnfoldingInfo, + setArityInfo, setInlinePragInfo, + InlinePragInfo(..), IdInfo + ) +import Class ( Class, classBigSig, classTyCon ) +import FieldLabel ( FieldLabel, FieldLabelTag, mkFieldLabel, fieldLabelName, + firstFieldLabelTag, allFieldLabelTags + ) +import TyVar ( TyVar ) +import TyCon ( TyCon, isNewTyCon, tyConDataCons, isDataTyCon ) +import PrelVals ( rEC_SEL_ERROR_ID ) +import Maybes +import SrcLoc ( SrcLoc ) +import BasicTypes ( Arity ) +import Unique ( Unique ) +import Maybe ( isJust ) +import Outputable +import Util ( assoc ) +\end{code} + + +%************************************************************************ +%* * +\subsection{Easy ones} +%* * +%************************************************************************ + +\begin{code} +mkImportedId :: Name -> ty -> IdInfo -> GenId ty +mkImportedId name ty info = mkId name ty (VanillaId True) info + +-- SysLocal: for an Id being created by the compiler out of thin air... +-- UserLocal: an Id with a name the user might recognize... +mkSysLocal :: FAST_STRING -> Unique -> (GenType flexi) -> SrcLoc -> GenId (GenType flexi) +mkUserLocal :: OccName -> Unique -> (GenType flexi) -> SrcLoc -> GenId (GenType flexi) + +mkSysLocal str uniq ty loc + = mkVanillaId (mkSysLocalName uniq str loc) ty noIdInfo + +mkUserLocal occ uniq ty loc + = mkVanillaId (mkLocalName uniq occ loc) ty noIdInfo + +mkUserId :: Name -> GenType flexi -> GenId (GenType flexi) +mkUserId name ty + = mkVanillaId name ty noIdInfo + +mkDefaultMethodId dm_name rec_c ty + = mkVanillaId dm_name ty noIdInfo + +mkDictFunId dfun_name full_ty clas itys + = mkVanillaId dfun_name full_ty noIdInfo + +mkWorkerId uniq unwrkr ty info + = mkVanillaId name ty info + where + name = mkCompoundName name_fn uniq (getName unwrkr) + name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str +\end{code} + + +%************************************************************************ +%* * +\subsection{Data constructors} +%* * +%************************************************************************ + +\begin{code} +mkDataCon :: Name + -> [StrictnessMark] -> [FieldLabel] + -> [TyVar] -> ThetaType + -> [TyVar] -> ThetaType + -> [TauType] -> TyCon + -> Id + -- can get the tag and all the pieces of the type from the Type + +mkDataCon name stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon + = ASSERT(length stricts == length args_tys) + data_con + where + -- NB: data_con self-recursion; should be OK as tags are not + -- looked at until late in the game. + data_con = mkId name data_con_ty details (dataConInfo data_con) + details = AlgConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon + + data_con_tag = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con + data_con_family = tyConDataCons tycon + data_con_ty = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt) + (mkFunTys args_tys (mkTyConApp tycon (mkTyVarTys tvs))) + + +mkTupleCon :: Arity -> Name -> Type -> Id +mkTupleCon arity name ty + = con_id + where + con_id = mkId name ty (TupleConId arity) (dataConInfo con_id) +\end{code} + +We're going to build a constructor that looks like: + + data (Data a, C b) => T a b = T1 !a !Int b + + T1 = /\ a b -> + \d1::Data a, d2::C b -> + \p q r -> case p of { p -> + case q of { q -> + Con T1 [a,b] [p,q,r]}} + +Notice that + +* d2 is thrown away --- a context in a data decl is used to make sure + one *could* construct dictionaries at the site the constructor + is used, but the dictionary isn't actually used. + +* We have to check that we can construct Data dictionaries for + the types a and Int. Once we've done that we can throw d1 away too. + +* We use (case p of ...) to evaluate p, rather than "seq" because + all that matters is that the arguments are evaluated. "seq" is + very careful to preserve evaluation order, which we don't need + to be here. + +\begin{code} +dataConInfo :: Id -> IdInfo + +dataConInfo con_id + = setInlinePragInfo IWantToBeINLINEd $ + -- Always inline constructors if possible + setArityInfo (exactArity (length locals)) $ + setUnfoldingInfo unfolding $ + noIdInfo + where + unfolding = mkUnfolding con_rhs + + (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon) = dataConSig con_id + + dict_tys = [mkDictTy clas tys | (clas,tys) <- theta] + con_dict_tys = [mkDictTy clas tys | (clas,tys) <- con_theta] + n_dicts = length dict_tys + result_ty = mkTyConApp tycon (mkTyVarTys tyvars) + + locals = mkTemplateLocals (dict_tys ++ con_dict_tys ++ arg_tys) + data_args = drop n_dicts locals + (data_arg1:_) = data_args -- Used for newtype only + strict_marks = dataConStrictMarks con_id + strict_args = [arg | (arg,MarkedStrict) <- data_args `zip` strict_marks] + -- NB: we can't call mkTemplateLocals twice, because it + -- always starts from the same unique. + + con_app | isNewTyCon tycon + = ASSERT( length arg_tys == 1) + Note (Coerce result_ty (head arg_tys)) (Var data_arg1) + | otherwise + = Con con_id (map TyArg (mkTyVarTys tyvars) ++ map VarArg data_args) + + con_rhs = mkTyLam tyvars $ + mkValLam locals $ + foldr mk_case con_app strict_args + + mk_case arg body | isUnpointedType (idType arg) + = body -- "!" on unboxed arg does nothing + | otherwise + = Case (Var arg) (AlgAlts [] (BindDefault arg body)) + -- This case shadows "arg" but that's fine +\end{code} + + +%************************************************************************ +%* * +\subsection{Record selectors} +%* * +%************************************************************************ + +We're going to build a record selector unfolding that looks like this: + + data T a b c = T1 { ..., op :: a, ...} + | T2 { ..., op :: a, ...} + | T3 + + sel = /\ a b c -> \ d -> case d of + T1 ... x ... -> x + T2 ... x ... -> x + other -> error "..." + +\begin{code} +mkRecordSelId field_label selector_ty + = ASSERT( null theta && isDataTyCon tycon ) + sel_id + where + sel_id = mkId (fieldLabelName field_label) selector_ty + (RecordSelId field_label) info + + info = exactArity 1 `setArityInfo` ( + unfolding `setUnfoldingInfo` + noIdInfo) + -- ToDo: consider adding further IdInfo + + unfolding = mkUnfolding sel_rhs + + (tyvars, theta, tau) = splitSigmaTy selector_ty + (data_ty,rhs_ty) = expectJust "StdIdInfoRec" (splitFunTy_maybe tau) + -- tau is of form (T a b c -> field-type) + (tycon, _, data_cons) = splitAlgTyConApp data_ty + tyvar_tys = mkTyVarTys tyvars + + [data_id] = mkTemplateLocals [data_ty] + alts = map mk_maybe_alt data_cons + sel_rhs = mkTyLam tyvars $ + mkValLam [data_id] $ + Case (Var data_id) + -- if any of the constructors don't have the label, ... + (if any (not . isJust) alts then + AlgAlts (catMaybes alts) + (BindDefault data_id error_expr) + else + AlgAlts (catMaybes alts) NoDefault) + + mk_maybe_alt data_con + = case maybe_the_arg_id of + Nothing -> Nothing + Just the_arg_id -> Just (data_con, arg_ids, Var the_arg_id) + where + arg_ids = mkTemplateLocals (dataConArgTys data_con tyvar_tys) + -- The first one will shadow data_id, but who cares + field_lbls = dataConFieldLabels data_con + maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label + + error_expr = mkApp (Var rEC_SEL_ERROR_ID) [rhs_ty] [LitArg msg_lit] + full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id]) + msg_lit = NoRepStr (_PK_ full_msg) +\end{code} + + +%************************************************************************ +%* * +\subsection{Dictionary selectors} +%* * +%************************************************************************ + +\begin{code} +mkSuperDictSelId :: Unique -> Class -> FieldLabelTag -> Type -> Id + -- The FieldLabelTag says which superclass is selected + -- So, for + -- class (C a, C b) => Foo a b where ... + -- we get superclass selectors + -- Foo_sc1, Foo_sc2 + +mkSuperDictSelId uniq clas index ty + = mkDictSelId name clas ty + where + name = mkCompoundName name_fn uniq (getName clas) + name_fn clas_str = clas_str _APPEND_ SLIT("_sc") _APPEND_ (_PK_ (show index)) + + -- For method selectors the clean thing to do is + -- to give the method selector the same name as the class op itself. +mkMethodSelId name clas ty + = mkDictSelId name clas ty +\end{code} + +Selecting a field for a dictionary. If there is just one field, then +there's nothing to do. + +\begin{code} +mkDictSelId name clas ty + = sel_id + where + sel_id = mkId name ty (RecordSelId field_lbl) info + field_lbl = mkFieldLabel name ty tag + tag = assoc "MkId.mkDictSelId" ((sc_sel_ids ++ op_sel_ids) `zip` allFieldLabelTags) sel_id + + info = setInlinePragInfo IWantToBeINLINEd $ + setUnfoldingInfo unfolding noIdInfo + -- The always-inline thing means we don't need any other IdInfo + + unfolding = mkUnfolding rhs + + (tyvars, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas + + tycon = classTyCon clas + [data_con] = tyConDataCons tycon + tyvar_tys = mkTyVarTys tyvars + arg_tys = dataConArgTys data_con tyvar_tys + the_arg_id = arg_ids !! (tag - firstFieldLabelTag) + + dict_ty = mkDictTy clas tyvar_tys + (dict_id:arg_ids) = mkTemplateLocals (dict_ty : arg_tys) + + rhs | isNewTyCon tycon = mkLam tyvars [dict_id] $ + Note (Coerce (head arg_tys) dict_ty) (Var dict_id) + | otherwise = mkLam tyvars [dict_id] $ + Case (Var dict_id) $ + AlgAlts [(data_con, arg_ids, Var the_arg_id)] NoDefault +\end{code} + + +%************************************************************************ +%* * +\subsection{Primitive operations +%* * +%************************************************************************ + + +\begin{code} +mkPrimitiveId name ty prim_op + = mkId name ty (PrimitiveId prim_op) info + where + + info = setUnfoldingInfo unfolding $ + setInlinePragInfo IMustBeINLINEd $ + -- The pragma @IMustBeINLINEd@ says that this Id absolutely + -- must be inlined. It's only used for primitives, + -- because we don't want to make a closure for each of them. + noIdInfo + + unfolding = mkUnfolding rhs + + (tyvars, tau) = splitForAllTys ty + (arg_tys, _) = splitFunTys tau + + args = mkTemplateLocals arg_tys + rhs = mkLam tyvars args $ + Prim prim_op + ([TyArg (mkTyVarTy tv) | tv <- tyvars] ++ + [VarArg v | v <- args]) +\end{code} + + +%************************************************************************ +%* * +\subsection{Catch-all} +%* * +%************************************************************************ + +\begin{code} +addStandardIdInfo id + = pprTrace "addStandardIdInfo missing:" (ppr id) id +\end{code} + diff --git a/ghc/compiler/basicTypes/PragmaInfo.lhs b/ghc/compiler/basicTypes/PragmaInfo.lhs deleted file mode 100644 index 874a7f3..0000000 --- a/ghc/compiler/basicTypes/PragmaInfo.lhs +++ /dev/null @@ -1,23 +0,0 @@ -% -% (c) The AQUA Project, Glasgow University, 1996 -% -\section[PragmaInfo]{@PragmaInfos@: The user's pragma requests} - -\begin{code} -module PragmaInfo where - -#include "HsVersions.h" - -\end{code} - -\begin{code} -data PragmaInfo - = NoPragmaInfo - - | IWantToBeINLINEd - - | IMustNotBeINLINEd -- Used by the simplifier to prevent looping - -- on recursive definitions - - | IMustBeINLINEd -- Absolutely must inline; used for PrimOps only -\end{code} diff --git a/ghc/compiler/prelude/StdIdInfo.hi-boot b/ghc/compiler/prelude/StdIdInfo.hi-boot deleted file mode 100644 index 680b7f1..0000000 --- a/ghc/compiler/prelude/StdIdInfo.hi-boot +++ /dev/null @@ -1,5 +0,0 @@ -_interface_ StdIdInfo 1 -_exports_ -StdIdInfo addStandardIdInfo; -_declarations_ -1 addStandardIdInfo _:_ Id.Id -> Id.Id ;; diff --git a/ghc/compiler/prelude/StdIdInfo.lhs b/ghc/compiler/prelude/StdIdInfo.lhs deleted file mode 100644 index 968dc9d..0000000 --- a/ghc/compiler/prelude/StdIdInfo.lhs +++ /dev/null @@ -1,260 +0,0 @@ -% -% (c) The AQUA Project, Glasgow University, 1994-1996 -% -\section[StdIdInfo]{Standard unfoldings} - -This module contains definitions for the IdInfo for things that -have a standard form, namely: - - * data constructors - * record selectors - * method and superclass selectors - * primitive operations - -\begin{code} -module StdIdInfo ( - addStandardIdInfo - ) where - -#include "HsVersions.h" - -import Type -import TyVar ( alphaTyVar ) -import CoreSyn -import Literal -import CoreUnfold ( mkUnfolding, PragmaInfo(..) ) -import TysWiredIn ( tupleCon ) -import Id ( mkTemplateLocals, idType, - dataConStrictMarks, dataConFieldLabels, dataConArgTys, - recordSelectorFieldLabel, dataConSig, - StrictnessMark(..), - isAlgCon, isDictSelId_maybe, - isRecordSelector, isPrimitiveId_maybe, - addIdUnfolding, addIdArity, - Id - ) -import IdInfo ( ArityInfo, exactArity ) -import Class ( classBigSig, classTyCon ) -import TyCon ( isNewTyCon, tyConDataCons, isDataTyCon ) -import FieldLabel ( FieldLabel ) -import PrelVals ( pAT_ERROR_ID ) -import Maybes -import Maybe ( isJust ) -import Outputable -import Util ( assoc ) -\end{code} - - -%************************************************************************ -%* * -\subsection{Data constructors} -%* * -%************************************************************************ - -We're going to build a constructor that looks like: - - data (Data a, C b) => T a b = T1 !a !Int b - - T1 = /\ a b -> - \d1::Data a, d2::C b -> - \p q r -> case p of { p -> - case q of { q -> - Con T1 [a,b] [p,q,r]}} - -Notice that - -* d2 is thrown away --- a context in a data decl is used to make sure - one *could* construct dictionaries at the site the constructor - is used, but the dictionary isn't actually used. - -* We have to check that we can construct Data dictionaries for - the types a and Int. Once we've done that we can throw d1 away too. - -* We use (case p of ...) to evaluate p, rather than "seq" because - all that matters is that the arguments are evaluated. "seq" is - very careful to preserve evaluation order, which we don't need - to be here. - -\begin{code} -addStandardIdInfo :: Id -> Id - -addStandardIdInfo con_id - - | isAlgCon con_id - = con_id `addIdUnfolding` unfolding - `addIdArity` exactArity (length locals) - where - unfolding = mkUnfolding IWantToBeINLINEd {- Always inline constructors -} con_rhs - - (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon) = dataConSig con_id - - dict_tys = [mkDictTy clas tys | (clas,tys) <- theta] - con_dict_tys = [mkDictTy clas tys | (clas,tys) <- con_theta] - n_dicts = length dict_tys - result_ty = mkTyConApp tycon (mkTyVarTys tyvars) - - locals = mkTemplateLocals (dict_tys ++ con_dict_tys ++ arg_tys) - data_args = drop n_dicts locals - (data_arg1:_) = data_args -- Used for newtype only - strict_marks = dataConStrictMarks con_id - strict_args = [arg | (arg,MarkedStrict) <- data_args `zip` strict_marks] - -- NB: we can't call mkTemplateLocals twice, because it - -- always starts from the same unique. - - con_app | isNewTyCon tycon - = ASSERT( length arg_tys == 1) - Coerce (CoerceIn con_id) result_ty (Var data_arg1) - | otherwise - = Con con_id (map TyArg (mkTyVarTys tyvars) ++ map VarArg data_args) - - con_rhs = mkTyLam tyvars $ - mkValLam locals $ - foldr mk_case con_app strict_args - - mk_case arg body | isUnpointedType (idType arg) - = body -- "!" on unboxed arg does nothing - | otherwise - = Case (Var arg) (AlgAlts [] (BindDefault arg body)) - -- This case shadows "arg" but that's fine -\end{code} - - -%************************************************************************ -%* * -\subsection{Record selectors} -%* * -%************************************************************************ - -We're going to build a record selector that looks like this: - - data T a b c = T1 { ..., op :: a, ...} - | T2 { ..., op :: a, ...} - | T3 - - sel = /\ a b c -> \ d -> case d of - T1 ... x ... -> x - T2 ... x ... -> x - other -> error "..." - -\begin{code} -addStandardIdInfo sel_id - | isRecordSelector sel_id - = ASSERT( null theta && isDataTyCon tycon ) - sel_id `addIdUnfolding` unfolding - `addIdArity` exactArity 1 - -- ToDo: consider adding further IdInfo - where - unfolding = mkUnfolding NoPragmaInfo {- Don't inline every selector -} sel_rhs - - (tyvars, theta, tau) = splitSigmaTy (idType sel_id) - field_lbl = recordSelectorFieldLabel sel_id - (data_ty,rhs_ty) = expectJust "StdIdInfoRec" (splitFunTy_maybe tau) - -- tau is of form (T a b c -> field-type) - (tycon, _, data_cons) = splitAlgTyConApp data_ty - tyvar_tys = mkTyVarTys tyvars - - [data_id] = mkTemplateLocals [data_ty] - alts = map mk_maybe_alt data_cons - sel_rhs = mkTyLam tyvars $ - mkValLam [data_id] $ - Case (Var data_id) - -- if any of the constructors don't have the label, ... - (if any (not . isJust) alts then - AlgAlts (catMaybes alts) - (BindDefault data_id error_expr) - else - AlgAlts (catMaybes alts) NoDefault) - - mk_maybe_alt data_con - = case maybe_the_arg_id of - Nothing -> Nothing - Just the_arg_id -> Just (data_con, arg_ids, Var the_arg_id) - where - arg_ids = mkTemplateLocals (dataConArgTys data_con tyvar_tys) - -- The first one will shadow data_id, but who cares - field_lbls = dataConFieldLabels data_con - maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_lbl - - error_expr = mkApp (Var pAT_ERROR_ID) [rhs_ty] [LitArg msg_lit] - full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id]) - msg_lit = NoRepStr (_PK_ full_msg) -\end{code} - - -%************************************************************************ -%* * -\subsection{Dictionary selectors} -%* * -%************************************************************************ - -Selecting a field for a dictionary. If there is just one field, then -there's nothing to do. - -\begin{code} -addStandardIdInfo sel_id - | maybeToBool maybe_dict_sel_id - = sel_id `addIdUnfolding` unfolding - where - maybe_dict_sel_id = isDictSelId_maybe sel_id - Just clas = maybe_dict_sel_id - - unfolding = mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs - -- The always-inline thing means we don't need any other IdInfo - - (tyvars, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas - - tycon = classTyCon clas - [data_con] = tyConDataCons tycon - tyvar_tys = mkTyVarTys tyvars - arg_tys = dataConArgTys data_con tyvar_tys - the_arg_id = assoc "StdIdInfo:mk_sel" ((sc_sel_ids ++ op_sel_ids) `zip` arg_ids) sel_id - - (dict_id:arg_ids) = mkTemplateLocals (mkDictTy clas tyvar_tys : arg_tys) - - rhs | isNewTyCon tycon = mkLam tyvars [dict_id] $ - Coerce (CoerceOut data_con) (head arg_tys) (Var dict_id) - | otherwise = mkLam tyvars [dict_id] $ - Case (Var dict_id) $ - AlgAlts [(data_con, arg_ids, Var the_arg_id)] NoDefault -\end{code} - - -%************************************************************************ -%* * -\subsection{Primitive operations -%* * -%************************************************************************ - - -\begin{code} -addStandardIdInfo prim_id - | maybeToBool maybe_prim_id - = prim_id `addIdUnfolding` unfolding - where - maybe_prim_id = isPrimitiveId_maybe prim_id - Just prim_op = maybe_prim_id - - unfolding = mkUnfolding IWantToBeINLINEd {- Always inline PrimOps -} rhs - - (tyvars, tau) = splitForAllTys (idType prim_id) - (arg_tys, _) = splitFunTys tau - - args = mkTemplateLocals arg_tys - rhs = mkLam tyvars args $ - Prim prim_op - ([TyArg (mkTyVarTy tv) | tv <- tyvars] ++ - [VarArg v | v <- args]) -\end{code} - - -%************************************************************************ -%* * -\subsection{Catch-all} -%* * -%************************************************************************ - -\begin{code} -addStandardIdInfo id - = pprTrace "addStandardIdInfo missing:" (ppr id) id -\end{code} - -- 1.7.10.4