X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=0e2d8b88f70c44ad45755ee3568aeead53ef42e4;hb=fec15030261949611ae41ab4a356a511db1bac4a;hp=9f9b3fe423b5a522557680857e2295cf721c7c52;hpb=903205d522185034734bec2be26d9ae574f311bf;p=ghc-hetmet.git diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index 9f9b3fe..0e2d8b8 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -1,4 +1,4 @@ -\% +% % (c) The University of Glasgow 2006 % (c) The AQUA Project, Glasgow University, 1998 % @@ -6,17 +6,17 @@ 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 +- data constructors +- record selectors +- method and superclass selectors +- primitive operations \begin{code} {-# OPTIONS -fno-warn-missing-signatures #-} -- 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/Commentary/CodingStyle#Warnings +-- -- for details module MkId ( @@ -34,7 +34,7 @@ module MkId ( -- And some particular Ids; see below for why they are wired in wiredInIds, ghcPrimIds, unsafeCoerceId, realWorldPrimId, voidArgId, nullAddrId, seqId, - lazyId, lazyIdUnfolding, lazyIdKey, + lazyId, lazyIdUnfolding, lazyIdKey, mkRuntimeErrorApp, rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID, @@ -90,6 +90,7 @@ import Module %************************************************************************ \begin{code} +wiredInIds :: [Id] wiredInIds = [ -- These error-y things are wired in because we don't yet have -- a way to express in an interface file that the result type variable @@ -117,6 +118,7 @@ wiredInIds ] ++ ghcPrimIds -- These Ids are exported from GHC.Prim +ghcPrimIds :: [Id] ghcPrimIds = [ -- These can't be defined in Haskell, but they have -- perfectly reasonable unfoldings in Core @@ -544,7 +546,7 @@ mkRecordSelId tycon field_label data_tv_set = tyVarsOfType data_ty data_tvs = varSetElems data_tv_set - -- *Very* tiresomely, the selectors are (unnecessarily!) overloaded over + -- _Very_ tiresomely, the selectors are (unnecessarily!) overloaded over -- just the dictionaries in the types of the constructors that contain -- the relevant field. [The Report says that pattern matching on a -- constructor gives the same constraints as applying it.] Urgh. @@ -957,7 +959,7 @@ unwrapFamInstScrut tycon args scrut %************************************************************************ %* * -\subsection{Primitive operations +\subsection{Primitive operations} %* * %************************************************************************ @@ -1141,12 +1143,12 @@ realWorldName = mkWiredInIdName gHC_PRIM (fsLit "realWorld#") realWorldPri lazyIdName = mkWiredInIdName gHC_BASE (fsLit "lazy") lazyIdKey lazyId errorName = mkWiredInIdName gHC_ERR (fsLit "error") errorIdKey eRROR_ID -recSelErrorName = mkWiredInIdName gHC_ERR (fsLit "recSelError") recSelErrorIdKey rEC_SEL_ERROR_ID -runtimeErrorName = mkWiredInIdName gHC_ERR (fsLit "runtimeError") runtimeErrorIdKey rUNTIME_ERROR_ID -irrefutPatErrorName = mkWiredInIdName gHC_ERR (fsLit "irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID -recConErrorName = mkWiredInIdName gHC_ERR (fsLit "recConError") recConErrorIdKey rEC_CON_ERROR_ID -patErrorName = mkWiredInIdName gHC_ERR (fsLit "patError") patErrorIdKey pAT_ERROR_ID -noMethodBindingErrorName = mkWiredInIdName gHC_ERR (fsLit "noMethodBindingError") +recSelErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "recSelError") recSelErrorIdKey rEC_SEL_ERROR_ID +runtimeErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "runtimeError") runtimeErrorIdKey rUNTIME_ERROR_ID +irrefutPatErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID +recConErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "recConError") recConErrorIdKey rEC_CON_ERROR_ID +patErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "patError") patErrorIdKey pAT_ERROR_ID +noMethodBindingErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "noMethodBindingError") noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID nonExhaustiveGuardsErrorName = mkWiredInIdName gHC_ERR (fsLit "nonExhaustiveGuardsError") @@ -1154,6 +1156,7 @@ nonExhaustiveGuardsErrorName \end{code} \begin{code} +------------------------------------------------ -- unsafeCoerce# :: forall a b. a -> b unsafeCoerceId = pcMiscPrelId unsafeCoerceName ty info @@ -1167,17 +1170,23 @@ unsafeCoerceId rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $ Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy) +------------------------------------------------ +nullAddrId :: Id -- nullAddr# :: Addr# -- The reason is is here is because we don't provide -- a way to write this literal in Haskell. -nullAddrId - = pcMiscPrelId nullAddrName addrPrimTy info +nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info where info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding (Lit nullAddrLit) -seqId - = pcMiscPrelId seqName ty info +------------------------------------------------ +seqId :: Id +-- 'seq' is very special. See notes with +-- See DsUtils.lhs Note [Desugaring seq (1)] and +-- Note [Desugaring seq (2)] and +-- Fixity is set in LoadIface.ghcPrimIface +seqId = pcMiscPrelId seqName ty info where info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs @@ -1187,6 +1196,8 @@ seqId [x,y] = mkTemplateLocals [alphaTy, openBetaTy] rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x openBetaTy [(DEFAULT, [], Var y)]) +------------------------------------------------ +lazyId :: Id -- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too) -- Used to lazify pseq: pseq a b = a `seq` lazy b -- @@ -1198,8 +1209,7 @@ seqId -- (see WorkWrap.wwExpr) -- We could use inline phases to do this, but that would be vulnerable to changes in -- phase numbering....we must inline precisely after strictness analysis. -lazyId - = pcMiscPrelId lazyIdName ty info +lazyId = pcMiscPrelId lazyIdName ty info where info = noCafIdInfo ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy) @@ -1267,7 +1277,7 @@ mkRuntimeErrorApp mkRuntimeErrorApp err_id res_ty err_msg = mkApps (Var err_id) [Type res_ty, err_string] where - err_string = Lit (mkStringLit err_msg) + err_string = Lit (mkMachString err_msg) rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName @@ -1306,7 +1316,7 @@ errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy \begin{code} pcMiscPrelId :: Name -> Type -> IdInfo -> Id pcMiscPrelId name ty info - = mkVanillaGlobal name ty info + = mkVanillaGlobalWithInfo name ty info -- We lie and say the thing is imported; otherwise, we get into -- a mess with dependency analysis; e.g., core2stg may heave in -- random calls to GHCbase.unpackPS__. If GHCbase is the module