X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FilxGen%2FIlxGen.lhs;h=a4a7b7cb9aaf6961eac6c33bbfe60b4b981cac8f;hb=984c225de77786cdb289001082166e77cc3e8733;hp=f1b45b0d7c832f2bef9fdd1bbc8f24c5d0a3815e;hpb=4e025e1250f43635de0617b68a661ef2982d1b1d;p=ghc-hetmet.git diff --git a/ghc/compiler/ilxGen/IlxGen.lhs b/ghc/compiler/ilxGen/IlxGen.lhs index f1b45b0..a4a7b7c 100644 --- a/ghc/compiler/ilxGen/IlxGen.lhs +++ b/ghc/compiler/ilxGen/IlxGen.lhs @@ -27,11 +27,11 @@ import PrimOp ( PrimOp(..) ) import ForeignCall ( CCallConv(..), ForeignCall(..), CCallSpec(..), CCallTarget(..), DNCallSpec(..) ) import TysWiredIn ( mkTupleTy, tupleCon ) import PrimRep ( PrimRep(..) ) -import Name ( nameModule, nameOccName, isGlobalName, isLocalName, NamedThing(getName) ) +import Name ( nameModule, nameOccName, isExternalName, isInternalName, NamedThing(getName) ) import Subst ( substTyWith ) import Module ( Module, PackageName, ModuleName, moduleName, - modulePackage, preludePackage, + modulePackage, basePackage, isHomeModule, isVanillaModule, pprModuleName, mkHomeModule, mkModuleName ) @@ -157,7 +157,7 @@ importsVars env vs = foldR (importsVar env) vs importsVar env v = importsName env (idName v). importsType env (idType v) importsName env n - | isLocalName n = importsNone + | isInternalName n = importsNone | ilxEnvModule env == nameModule n = importsNone | isHomeModule (nameModule n) = addModuleImpInfo (moduleName (nameModule n)) -- See HACK below @@ -168,7 +168,7 @@ importsName env n importsPrelude | inPrelude = addModuleImpInfo (mkModuleName "PrelGHC") - | otherwise = addPackageImpInfo preludePackage + | otherwise = addPackageImpInfo basePackage importsType :: IlxEnv -> Type -> ImportsInfo -> ImportsInfo @@ -187,7 +187,7 @@ importsTypeArgs2 env tys = foldR (importsType2 env) tys importsDataCon env dcon = importsTyCon env (dataConTyCon dcon) importsTyCon env tc | (not (isDataTyCon tc) || - isLocalName (getName tc) || + isInternalName (getName tc) || ilxEnvModule env == nameModule (getName tc)) = importsNone importsTyCon env tc | otherwise = importsName env (getName tc) . addTyConImpInfo tc . foldR (importsTyConDataCon env) (tyConDataCons tc) @@ -210,7 +210,7 @@ importsTyConDataConType2 _ _ = panic "IlxGen.lhs: importsTyConDataConType2 ty" importsTyConDataConTypeArgs2 env tys = foldR (importsTyConDataConType2 env) tys importsTyConDataConTypeTyCon env tc | (not (isDataTyCon tc) || - isLocalName (getName tc) || + isInternalName (getName tc) || ilxEnvModule env == nameModule (getName tc)) = importsNone importsTyConDataConTypeTyCon env tc | otherwise = importsName env (getName tc) @@ -1120,11 +1120,11 @@ pushLit env (MachWord64 w) = text "ldc.i8" <+> integer w <+> text "conv.u8" pushLit env (MachFloat f) = text "ldc.r4" <+> rational f pushLit env (MachDouble f) = text "ldc.r8" <+> rational f pushLit env (MachLitLit _ _) = trace "WARNING: Cannot compile MachLitLit to ILX in IlxGen.lhs" (text "// MachLitLit!!! Not valid in ILX!!") -pushLit env (MachAddr w) = text "ldc.i4" <+> integer w <+> text "conv.i" -pushLit env (MachLabel l) = trace "WARNING: Cannot compile MachLabel to ILX in IlxGen.lhs" (text "// MachLabel!!! Not valid in ILX!!") +pushLit env (MachNullAddr) = text "ldc.i4 0" +pushLit env (MachLabel l _) = trace "WARNING: Cannot compile MachLabel to ILX in IlxGen.lhs" (text "// MachLabel!!! Not valid in ILX!!") pprIlxTopVar env v - | isGlobalName n = (nameReference env n) <> pprId (nameModule n) <> text "::" <> singleQuotes (ppr (nameModule n) <> text "_" <> ppr (nameOccName n)) + | isExternalName n = (nameReference env n) <> pprId (nameModule n) <> text "::" <> singleQuotes (ppr (nameModule n) <> text "_" <> ppr (nameOccName n)) | otherwise = pprId (nameOccName n) where n = idName v @@ -1458,14 +1458,14 @@ line = text "// ----------------------------------" hscOptionQual = text ".i_" nameReference env n - | isLocalName n = empty + | isInternalName n = empty | ilxEnvModule env == nameModule n = text "" | isHomeModule (nameModule n) = moduleNameReference (moduleName (nameModule n)) -- HACK: no Vanilla modules should be around, but they are!! This -- gets things working for the scenario "standard library linked as one -- assembly with multiple modules + a one module program running on top of this" -- Same applies to all other mentions of Vailla modules in this file - | isVanillaModule (nameModule n) && not inPrelude = preludePackageReference + | isVanillaModule (nameModule n) && not inPrelude = basePackageReference | isVanillaModule (nameModule n) && inPrelude = moduleNameReference (moduleName (nameModule n)) -- end hack | otherwise = packageReference (modulePackage (nameModule n)) @@ -1477,13 +1477,13 @@ moduleReference env m | ilxEnvModule env == m = text "" | isHomeModule m = moduleNameReference (moduleName m) -- See hack above - | isVanillaModule m && not inPrelude = preludePackageReference + | isVanillaModule m && not inPrelude = basePackageReference | isVanillaModule m && inPrelude = moduleNameReference (moduleName m) -- end hack | otherwise = packageReference (modulePackage m) -preludePackageReference = packageReference preludePackage -inPrelude = preludePackage == opt_InPackage +basePackageReference = packageReference basePackage +inPrelude = basePackage == opt_InPackage ------------------------------------------------ -- This code is copied from absCSyn/CString.lhs, @@ -1491,8 +1491,8 @@ inPrelude = preludePackage == opt_InPackage -- still a mess though. Also, still have to do the -- right thing for embedded nulls. -pprFSInILStyle :: FAST_STRING -> SDoc -pprFSInILStyle fs = doubleQuotes (text (stringToC (_UNPK_ fs))) +pprFSInILStyle :: FastString -> SDoc +pprFSInILStyle fs = doubleQuotes (text (stringToC (unpackFS fs))) stringToC :: String -> String -- Convert a string to the form required by C in a C literal string @@ -1693,13 +1693,13 @@ prelGHCReference :: IlxTyFrag prelGHCReference env = if ilxEnvModule env == mkHomeModule (mkModuleName "PrelGHC") then empty else if inPrelude then moduleNameReference (mkModuleName "PrelGHC") - else preludePackageReference + else basePackageReference prelBaseReference :: IlxTyFrag prelBaseReference env = if ilxEnvModule env == mkHomeModule (mkModuleName "PrelBase") then empty else if inPrelude then moduleNameReference (mkModuleName "PrelBase") - else preludePackageReference + else basePackageReference repThread = ilxType "class [mscorlib]System.Threading.Thread /* ThreadId# */ " repByteArray = ilxType "unsigned int8[] /* ByteArr# */ " @@ -1870,7 +1870,6 @@ ilxPrimOpTable op ISrlOp -> simp_op (ilxOp "shr.un") IntAddCOp -> simp_op (ilxCallSuppMeth (ilxUnboxedPairRep repInt repInt) "IntAddCOp" [] [repInt, repInt]) IntSubCOp -> simp_op (ilxCallSuppMeth (ilxUnboxedPairRep repInt repInt) "IntSubCOp" [] [repInt, repInt]) - IntMulCOp -> simp_op (ilxCallSuppMeth (ilxUnboxedPairRep repInt repInt) "IntMulCOp" [] [repInt, repInt]) IntGcdOp -> simp_op (ilxCallSuppMeth repInt "IntGcdOp" [] [repInt, repInt]) @@ -1958,9 +1957,9 @@ ilxPrimOpTable op Integer2WordOp -> simp_op (ilxCallSuppMeth repWord "Integer2WordOp" [] [repInt, repByteArray]) Int2IntegerOp -> simp_op (ilxCallSuppMeth repInteger "Int2IntegerOp" [] [repInt]) Word2IntegerOp -> simp_op (ilxCallSuppMeth repInteger "Word2IntegerOp" [] [repWord]) - IntegerToInt64Op -> simp_op (ilxCallSuppMeth repInt64 "IntegerToInt64Op" [] [repInt,repByteArray]) +-- IntegerToInt64Op -> simp_op (ilxCallSuppMeth repInt64 "IntegerToInt64Op" [] [repInt,repByteArray]) Int64ToIntegerOp -> simp_op (ilxCallSuppMeth repInteger "Int64ToIntegerOp" [] [repInt64]) - IntegerToWord64Op -> simp_op (ilxCallSuppMeth repWord64 "IntegerToWord64Op" [] [repInt,repByteArray]) +-- IntegerToWord64Op -> simp_op (ilxCallSuppMeth repWord64 "IntegerToWord64Op" [] [repInt,repByteArray]) Word64ToIntegerOp -> simp_op (ilxCallSuppMeth repInteger "Word64ToIntegerOp" [] [repWord64]) @@ -2267,7 +2266,7 @@ ilxPrimOpTable op ParGlobalOp -> warn_op "ParGlobalOp" (simp_op (ilxOp " /* ParGlobalOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw")) SeqOp -> warn_op "SeqOp" (simp_op (ilxOp " newobj void [mscorlib]System.Object::.ctor() throw ")) AddrToHValueOp -> warn_op "AddrToHValueOp" (simp_op (ilxOp "newobj void [mscorlib]System.Object::.ctor() throw")) - ReallyUnsafePtrEqualityOp -> simp_op (ilxOp "ceq") +-- ReallyUnsafePtrEqualityOp -> simp_op (ilxOp "ceq") MkApUpd0_Op -> warn_op "MkApUpd0_Op" (simp_op (ilxOp " newobj void [mscorlib]System.Object::.ctor() throw")) NewBCOOp -> warn_op "NewBCOOp" (simp_op (ilxOp " newobj void [mscorlib]System.Object::.ctor() throw"))