From: sof Date: Tue, 13 Apr 1999 15:50:35 +0000 (+0000) Subject: [project @ 1999-04-13 15:50:29 by sof] X-Git-Tag: Approximately_9120_patches~6320 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4216e402f6b50a611cd593873fd9c6597b2fe0e7;p=ghc-hetmet.git [project @ 1999-04-13 15:50:29 by sof] The {Int,Word}{8,16,32,64} types are no longer 'wired-in', just names with a known key. --- diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs index 0f65b85..396c20b 100644 --- a/ghc/compiler/basicTypes/Unique.lhs +++ b/ghc/compiler/basicTypes/Unique.lhs @@ -99,12 +99,8 @@ module Unique ( intPrimTyConKey, intTyConKey, int8TyConKey, - int8DataConKey, int16TyConKey, - int16DataConKey, int32TyConKey, - int32DataConKey, - int64DataConKey, int64PrimTyConKey, int64TyConKey, smallIntegerDataConKey, @@ -188,12 +184,8 @@ module Unique ( wordPrimTyConKey, wordTyConKey, word8TyConKey, - word8DataConKey, word16TyConKey, - word16DataConKey, word32TyConKey, - word32DataConKey, - word64DataConKey, word64PrimTyConKey, word64TyConKey, zipIdKey @@ -556,10 +548,6 @@ doubleDataConKey = mkPreludeDataConUnique 4 falseDataConKey = mkPreludeDataConUnique 5 floatDataConKey = mkPreludeDataConUnique 6 intDataConKey = mkPreludeDataConUnique 7 -int8DataConKey = mkPreludeDataConUnique 8 -int16DataConKey = mkPreludeDataConUnique 9 -int32DataConKey = mkPreludeDataConUnique 10 -int64DataConKey = mkPreludeDataConUnique 11 smallIntegerDataConKey = mkPreludeDataConUnique 12 largeIntegerDataConKey = mkPreludeDataConUnique 13 foreignObjDataConKey = mkPreludeDataConUnique 14 @@ -569,10 +557,6 @@ stablePtrDataConKey = mkPreludeDataConUnique 17 stableNameDataConKey = mkPreludeDataConUnique 18 trueDataConKey = mkPreludeDataConUnique 34 wordDataConKey = mkPreludeDataConUnique 35 -word8DataConKey = mkPreludeDataConUnique 36 -word16DataConKey = mkPreludeDataConUnique 37 -word32DataConKey = mkPreludeDataConUnique 38 -word64DataConKey = mkPreludeDataConUnique 39 stDataConKey = mkPreludeDataConUnique 40 ioDataConKey = mkPreludeDataConUnique 42 \end{code} diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index cb0a306..4877086 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -9,7 +9,7 @@ module PrelInfo ( -- that is all. If something is in here, you know that -- if it's used at all then it's Name will be just as -- it is here, unique and all. Includes all the - -- wiredd-in names. + -- wired-in names. thinAirIdNames, -- Names of non-wired-in Ids that may be used out of setThinAirIds, -- thin air in any compilation. If they are not wired in @@ -33,7 +33,7 @@ module PrelInfo ( -- Random other things main_NAME, ioTyCon_NAME, deRefStablePtr_NAME, makeStablePtr_NAME, - bindIO_NAME, + bindIO_NAME, maybeCharLikeCon, maybeIntLikeCon, needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, @@ -188,17 +188,9 @@ data_tycons , doubleTyCon , floatTyCon , intTyCon - , int8TyCon - , int16TyCon - , int32TyCon - , int64TyCon , integerTyCon , listTyCon , wordTyCon - , word8TyCon - , word16TyCon - , word32TyCon - , word64TyCon ] \end{code} @@ -402,6 +394,16 @@ knownKeyNames , (filter_RDR, filterIdKey) , (zip_RDR, zipIdKey) + -- FFI primitive types that are not wired-in. + , (int8TyCon_RDR, int8TyConKey) + , (int16TyCon_RDR, int16TyConKey) + , (int32TyCon_RDR, int32TyConKey) + , (int64TyCon_RDR, int64TyConKey) + , (word8TyCon_RDR, word8TyConKey) + , (word16TyCon_RDR, word16TyConKey) + , (word32TyCon_RDR, word32TyConKey) + , (word64TyCon_RDR, word64TyConKey) + -- Others , (otherwiseId_RDR, otherwiseIdKey) , (assert_RDR, assertIdKey) @@ -535,6 +537,16 @@ plus_RDR = varQual pREL_BASE SLIT("+") times_RDR = varQual pREL_BASE SLIT("*") mkInt_RDR = dataQual pREL_BASE SLIT("I#") +int8TyCon_RDR = tcQual iNT SLIT("Int8") +int16TyCon_RDR = tcQual iNT SLIT("Int16") +int32TyCon_RDR = tcQual iNT SLIT("Int32") +int64TyCon_RDR = tcQual pREL_ADDR SLIT("Int64") + +word8TyCon_RDR = tcQual wORD SLIT("Word8") +word16TyCon_RDR = tcQual wORD SLIT("Word16") +word32TyCon_RDR = tcQual wORD SLIT("Word32") +word64TyCon_RDR = tcQual pREL_ADDR SLIT("Word64") + error_RDR = varQual pREL_ERR SLIT("error") assert_RDR = varQual pREL_GHC SLIT("assert") assertErr_RDR = varQual pREL_ERR SLIT("assertError") @@ -667,7 +679,7 @@ cCallishClassKeys = ] -- Renamer always imports these data decls replete with constructors - -- so that desugarer can always see the constructor. Ugh! + -- so that desugarer can always see their constructors. Ugh! cCallishTyKeys = [ addrTyConKey , wordTyConKey @@ -675,6 +687,14 @@ cCallishTyKeys = , mutableByteArrayTyConKey , foreignObjTyConKey , stablePtrTyConKey + , int8TyConKey + , int16TyConKey + , int32TyConKey + , int64TyConKey + , word8TyConKey + , word16TyConKey + , word32TyConKey + , word64TyConKey ] standardClassKeys diff --git a/ghc/compiler/prelude/PrelMods.lhs b/ghc/compiler/prelude/PrelMods.lhs index e2e9b43..5902c4b 100644 --- a/ghc/compiler/prelude/PrelMods.lhs +++ b/ghc/compiler/prelude/PrelMods.lhs @@ -61,8 +61,8 @@ mAIN = mkSrcModule "Main" iNT, wORD :: Module -iNT = mkPrelModule "Int" -wORD = mkPrelModule "Word" +iNT = mkSrcModule "Int" +wORD = mkSrcModule "Word" \end{code} diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs index 3c5fd87..c775e7a 100644 --- a/ghc/compiler/prelude/TysWiredIn.lhs +++ b/ghc/compiler/prelude/TysWiredIn.lhs @@ -36,12 +36,6 @@ module TysWiredIn ( isIntTy, inIntRange, - int8TyCon, - int16TyCon, - int32TyCon, - - int64TyCon, - integerTy, integerTyCon, smallIntegerDataCon, @@ -71,11 +65,6 @@ module TysWiredIn ( wordTy, wordTyCon, - word8TyCon, - word16TyCon, - word32TyCon, - word64TyCon, - isFFIArgumentTy, -- :: Type -> Bool isFFIResultTy, -- :: Type -> Bool isFFIExternalTy, -- :: Type -> Bool @@ -298,21 +287,6 @@ max_int, min_int :: Integer max_int = toInteger maxInt min_int = toInteger minInt -int8TyCon = pcNonRecDataTyCon int8TyConKey iNT SLIT("Int8") [] [int8DataCon] - where - int8DataCon = pcDataCon int8DataConKey iNT SLIT("I8#") [] [] [intPrimTy] int8TyCon - -int16TyCon = pcNonRecDataTyCon int16TyConKey iNT SLIT("Int16") [] [int16DataCon] - where - int16DataCon = pcDataCon int16DataConKey iNT SLIT("I16#") [] [] [intPrimTy] int16TyCon - -int32TyCon = pcNonRecDataTyCon int32TyConKey iNT SLIT("Int32") [] [int32DataCon] - where - int32DataCon = pcDataCon int32DataConKey iNT SLIT("I32#") [] [] [intPrimTy] int32TyCon - -int64TyCon = pcNonRecDataTyCon int64TyConKey pREL_ADDR SLIT("Int64") [] [int64DataCon] - where - int64DataCon = pcDataCon int64DataConKey pREL_ADDR SLIT("I64#") [] [] [int64PrimTy] int64TyCon \end{code} \begin{code} @@ -321,22 +295,6 @@ wordTy = mkTyConTy wordTyCon wordTyCon = pcNonRecDataTyCon wordTyConKey pREL_ADDR SLIT("Word") [] [wordDataCon] wordDataCon = pcDataCon wordDataConKey pREL_ADDR SLIT("W#") [] [] [wordPrimTy] wordTyCon - -word8TyCon = pcNonRecDataTyCon word8TyConKey wORD SLIT("Word8") [] [word8DataCon] - where - word8DataCon = pcDataCon word8DataConKey wORD SLIT("W8#") [] [] [wordPrimTy] word8TyCon - -word16TyCon = pcNonRecDataTyCon word16TyConKey wORD SLIT("Word16") [] [word16DataCon] - where - word16DataCon = pcDataCon word16DataConKey wORD SLIT("W16#") [] [] [wordPrimTy] word16TyCon - -word32TyCon = pcNonRecDataTyCon word32TyConKey wORD SLIT("Word32") [] [word32DataCon] - where - word32DataCon = pcDataCon word32DataConKey wORD SLIT("W32#") [] [] [wordPrimTy] word32TyCon - -word64TyCon = pcNonRecDataTyCon word64TyConKey pREL_ADDR SLIT("Word64") [] [word64DataCon] - where - word64DataCon = pcDataCon word64DataConKey pREL_ADDR SLIT("W64#") [] [] [word64PrimTy] word64TyCon \end{code} \begin{code} diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index 1d3578a..de6268a 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -361,11 +361,11 @@ initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc -> IO (r, Bag ErrMsg, Bag WarnMsg) initRn mod us dirs loc do_rn = do + (himap, hibmap) <- mkModuleHiMaps dirs names_var <- sstToIO (newMutVarSST (us, emptyFM, builtins)) errs_var <- sstToIO (newMutVarSST (emptyBag,emptyBag)) iface_var <- sstToIO (newMutVarSST (emptyIfaces mod)) occs_var <- sstToIO (newMutVarSST initOccs) - (himap, hibmap) <- mkModuleHiMaps dirs let rn_down = RnDown { rn_loc = loc, rn_omit = \n -> False, rn_ns = names_var, rn_errs = errs_var, rn_occs = occs_var, @@ -400,11 +400,11 @@ emptyIfaces mod = Ifaces { iMod = mod, iDefData = emptyNameEnv, iInstMods = [] } - builtins :: FiniteMap (Module,OccName) Name -builtins = bagToFM $ - mapBag (\ name -> ((nameModule name, nameOccName name), name)) - builtinNames +builtins = + bagToFM ( + mapBag (\ name -> ((nameModule name, nameOccName name), name)) + builtinNames) -- Initial value for the occurrence pool. initOccs :: ([Occurrence],[Occurrence]) -- Compulsory and optional respectively @@ -912,7 +912,11 @@ and 'hi-boot' mentions of names, with the flavour in the being encoded inside a @Module@. @setModuleFlavourRn@ fixes up @Module@ values containing -normal flavours, checking to see whether +normal flavours, returning a @Module@ value containing +the attributes of the module that's in scope. The only +attribute at the moment is the DLLness of a module, i.e., +whether the object code for that module resides in a +Win32 DLL or not. \begin{code} setModuleFlavourRn :: Module -> RnM s d Module @@ -920,13 +924,13 @@ setModuleFlavourRn mod | bootFlavour hif = returnRn mod | otherwise = getModuleHiMap (bootFlavour hif) `thenRn` \ himap -> - let mod_pstr = moduleString mod in case (lookupFM himap mod_pstr) of Nothing -> returnRn mod - Just (_,is_in_a_dll) -> - returnRn (setModuleFlavour (mkDynFlavour is_in_a_dll hif) mod) - where - hif = moduleIfaceFlavour mod + Just (_, is_in_a_dll) -> + returnRn (setModuleFlavour (mkDynFlavour is_in_a_dll hif) mod) + where + mod_pstr = moduleString mod + hif = moduleIfaceFlavour mod \end{code} diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs index 8e2e660..9e1d592 100644 --- a/ghc/compiler/rename/RnSource.lhs +++ b/ghc/compiler/rename/RnSource.lhs @@ -335,8 +335,8 @@ rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc)) addImplicitOccRn deRefStablePtr_NAME `thenRn_` addImplicitOccRn bindIO_NAME `thenRn_` returnRn name' - _ -> returnRn name') `thenRn_` - rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs) -> + _ -> returnRn name') `thenRn_` + rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs) -> returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc), fvs) where fo_decl_msg = ptext SLIT("a foreign declaration")