X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Fprelude%2FTysWiredIn.lhs;h=2975922af8db9f37b47845f3f3744e809ea93859;hb=f5fbd41ca7f30e0f8db3f7b280a044d5af138428;hp=62b2623ad33142c0dae772dc4d9a474318c1e9c6;hpb=dc9c5583ddc876362c09dba165ecdbcf35c5a1f4;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs index 62b2623..2975922 100644 --- a/ghc/compiler/prelude/TysWiredIn.lhs +++ b/ghc/compiler/prelude/TysWiredIn.lhs @@ -13,15 +13,6 @@ types and operations.'' module TysWiredIn ( wiredInTyCons, genericTyCons, - addrDataCon, - addrTy, - addrTyCon, - ptrDataCon, - ptrTy, - ptrTyCon, - funPtrDataCon, - funPtrTy, - funPtrTyCon, boolTy, boolTyCon, charDataCon, @@ -53,7 +44,7 @@ module TysWiredIn ( -- tuples mkTupleTy, tupleTyCon, tupleCon, - unitTyCon, unitDataConId, pairTyCon, + unitTyCon, unitDataCon, unitDataConId, pairTyCon, unboxedSingletonTyCon, unboxedSingletonDataCon, unboxedPairTyCon, unboxedPairDataCon, @@ -62,7 +53,6 @@ module TysWiredIn ( plusTyCon, inrDataCon, inlDataCon, crossTyCon, crossDataCon, - stablePtrTyCon, stringTy, trueDataCon, trueDataConId, unitTy, @@ -78,7 +68,7 @@ module TysWiredIn ( #include "HsVersions.h" -import {-# SOURCE #-} MkId( mkDataConId, mkDataConWrapId ) +import {-# SOURCE #-} MkId( mkDataConWorkId ) import {-# SOURCE #-} Generics( mkTyConGenInfo ) -- friends: @@ -87,18 +77,17 @@ import TysPrim -- others: import Constants ( mAX_TUPLE_SIZE ) -import Module ( mkPrelModule ) -import Name ( Name, nameRdrName, nameUnique, nameOccName, +import Module ( mkBasePkgModule ) +import Name ( Name, nameUnique, nameOccName, nameModule, mkWiredInName ) -import OccName ( mkOccFS, tcName, dataName, mkWorkerOcc, mkGenOcc1, mkGenOcc2 ) -import RdrName ( rdrNameOcc ) +import OccName ( mkOccFS, tcName, dataName, mkDataConWorkerOcc, mkGenOcc1, mkGenOcc2 ) import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity ) import Var ( TyVar, tyVarKind ) import TyCon ( TyCon, AlgTyConFlavour(..), DataConDetails(..), tyConDataCons, mkTupleTyCon, mkAlgTyCon, tyConName ) -import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, StrictnessMark(..) ) +import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed ) import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys, mkArrowKinds, liftedTypeKind, unliftedTypeKind, @@ -121,15 +110,15 @@ alpha_beta_tyvars = [alphaTyVar, betaTyVar] %* * %************************************************************************ +If you change which things are wired in, make sure you change their +names in PrelNames, so they use wTcQual, wDataQual, etc + \begin{code} wiredInTyCons :: [TyCon] wiredInTyCons = data_tycons ++ tuple_tycons ++ unboxed_tuple_tycons data_tycons = genericTyCons ++ - [ addrTyCon - , ptrTyCon - , funPtrTyCon - , boolTyCon + [ boolTyCon , charTyCon , doubleTyCon , floatTyCon @@ -143,7 +132,6 @@ data_tycons = genericTyCons ++ genericTyCons :: [TyCon] genericTyCons = [ plusTyCon, crossTyCon, genUnitTyCon ] - tuple_tycons = unitTyCon : [tupleTyCon Boxed i | i <- [2..mAX_TUPLE_SIZE] ] unboxed_tuple_tycons = [tupleTyCon Unboxed i | i <- [1..mAX_TUPLE_SIZE] ] \end{code} @@ -191,28 +179,28 @@ mk_tc_gen_info mod tc_uniq tc_name tycon name2 = mkWiredInName mod occ_name2 fn2_key pcDataCon :: Name -> [TyVar] -> ThetaType -> [Type] -> TyCon -> DataCon +-- The Name should be in the DataName name space; it's the name +-- of the DataCon itself. +-- -- The unique is the first of two free uniques; --- the first is used for the datacon itself and the worker; --- the second is used for the wrapper. +-- the first is used for the datacon itself, +-- the second is used for the "worker name" -pcDataCon name tyvars context arg_tys tycon +pcDataCon dc_name tyvars context arg_tys tycon = data_con where - data_con = mkDataCon name - [ NotMarkedStrict | a <- arg_tys ] - [ {- no labelled fields -} ] - tyvars context [] [] arg_tys tycon work_id wrap_id - - wrap_rdr = nameRdrName name - wrap_occ = rdrNameOcc wrap_rdr - - mod = nameModule name - wrap_id = mkDataConWrapId data_con - - work_occ = mkWorkerOcc wrap_occ - work_key = incrUnique (nameUnique name) - work_name = mkWiredInName mod work_occ work_key - work_id = mkDataConId work_name data_con + data_con = mkDataCon dc_name + [{- No strictness -}] + [{- No labelled fields -}] + tyvars context [] [] arg_tys tycon work_id + Nothing {- No wrapper for wired-in things + (they are too simple to need one) -} + + mod = nameModule dc_name + wrk_occ = mkDataConWorkerOcc (nameOccName dc_name) + wrk_key = incrUnique (nameUnique dc_name) + wrk_name = mkWiredInName mod wrk_occ wrk_key + work_id = mkDataConWorkId wrk_name data_con \end{code} @@ -234,8 +222,8 @@ tupleCon Boxed i = snd (boxedTupleArr ! i) tupleCon Unboxed i = snd (unboxedTupleArr ! i) boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon) -boxedTupleArr = array (0,mAX_TUPLE_SIZE) [(i,mk_tuple Boxed i) | i <- [0..mAX_TUPLE_SIZE]] -unboxedTupleArr = array (0,mAX_TUPLE_SIZE) [(i,mk_tuple Unboxed i) | i <- [0..mAX_TUPLE_SIZE]] +boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]] +unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]] mk_tuple :: Boxity -> Int -> (TyCon,DataCon) mk_tuple boxity arity = (tycon, tuple_con) @@ -255,11 +243,12 @@ mk_tuple boxity arity = (tycon, tuple_con) name = mkWiredInName mod (mkOccFS dataName name_str) dc_uniq tc_uniq = mkTupleTyConUnique boxity arity dc_uniq = mkTupleDataConUnique boxity arity - mod = mkPrelModule mod_name + mod = mkBasePkgModule mod_name gen_info = mk_tc_gen_info mod tc_uniq tc_name tycon unitTyCon = tupleTyCon Boxed 0 -unitDataConId = dataConWorkId (head (tyConDataCons unitTyCon)) +unitDataCon = head (tyConDataCons unitTyCon) +unitDataConId = dataConWorkId unitDataCon pairTyCon = tupleTyCon Boxed 2 @@ -316,27 +305,6 @@ wordDataCon = pcDataCon wordDataConName [] [] [wordPrimTy] wordTyCon \end{code} \begin{code} -addrTy = mkTyConTy addrTyCon - -addrTyCon = pcNonRecDataTyCon addrTyConName [] [] [addrDataCon] -addrDataCon = pcDataCon addrDataConName [] [] [addrPrimTy] addrTyCon -\end{code} - -\begin{code} -ptrTy = mkTyConTy ptrTyCon - -ptrTyCon = pcNonRecDataTyCon ptrTyConName alpha_tyvar [(True,False)] [ptrDataCon] -ptrDataCon = pcDataCon ptrDataConName alpha_tyvar [] [addrPrimTy] ptrTyCon -\end{code} - -\begin{code} -funPtrTy = mkTyConTy funPtrTyCon - -funPtrTyCon = pcNonRecDataTyCon funPtrTyConName alpha_tyvar [(True,False)] [funPtrDataCon] -funPtrDataCon = pcDataCon funPtrDataConName alpha_tyvar [] [addrPrimTy] funPtrTyCon -\end{code} - -\begin{code} floatTy = mkTyConTy floatTyCon floatTyCon = pcNonRecDataTyCon floatTyConName [] [] [floatDataCon] @@ -346,19 +314,10 @@ floatDataCon = pcDataCon floatDataConName [] [] [floatPrimTy] floatTyCon \begin{code} doubleTy = mkTyConTy doubleTyCon -doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [] [doubleDataCon] +doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [] [doubleDataCon] doubleDataCon = pcDataCon doubleDataConName [] [] [doublePrimTy] doubleTyCon \end{code} -\begin{code} -stablePtrTyCon - = pcNonRecDataTyCon stablePtrTyConName - alpha_tyvar [(True,False)] [stablePtrDataCon] - where - stablePtrDataCon - = pcDataCon stablePtrDataConName - alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon -\end{code} %************************************************************************ %* * @@ -610,7 +569,7 @@ mkPArrFakeCon arity = pcDataCon name [tyvar] [] tyvarTys parrTyCon nameStr = mkFastString ("MkPArr" ++ show arity) name = mkWiredInName mod (mkOccFS dataName nameStr) uniq uniq = mkPArrDataConUnique arity - mod = mkPrelModule pREL_PARR_Name + mod = mkBasePkgModule pREL_PARR_Name -- checks whether a data constructor is a fake constructor for parallel arrays --