tyConTyVars, isDataTyCon, isAlgTyCon, tyConArity
)
import Type ( liftedTypeKind, openTypeKind, unliftedTypeKind,
- isUnLiftedType, isTyVarTy, mkTyVarTy, sourceTypeRep,
+ isUnLiftedType, isTyVarTy, mkTyVarTy, predTypeRep, pprType,
splitForAllTys, splitFunTys, applyTy, applyTys, eqKind, tyVarsOfTypes
)
import TypeRep ( Type(..) )
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
)
import Char ( ord )
import List ( partition, elem, insertBy,any )
import UniqSet
-import PprType ( pprType ) -- Only called in debug messages
import TysPrim ( foreignObjPrimTyCon, weakPrimTyCon, byteArrayPrimTyCon, mutableByteArrayPrimTyCon )
-- versions of compiled Haskell code. We add a ".O" to all assembly and module
-- names when this is set (because that's clue that -O was set).
-- One day this will be configured by the command line.
-import CmdLineOpts ( opt_InPackage, opt_SimplDoEtaReduction )
+import DynFlags ( opt_InPackage, opt_SimplDoEtaReduction )
+
+import Util ( lengthIs, equalLength )
\end{code}
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
importsPrelude | inPrelude = addModuleImpInfo (mkModuleName "PrelGHC")
- | otherwise = addPackageImpInfo preludePackage
+ | otherwise = addPackageImpInfo basePackage
importsType :: IlxEnv -> Type -> ImportsInfo -> ImportsInfo
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)
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)
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
deepIlxRepType (AppTy f x) = AppTy (deepIlxRepType f) (deepIlxRepType x)
deepIlxRepType (ForAllTy b ty) = ForAllTy b (deepIlxRepType ty)
deepIlxRepType (NoteTy _ ty) = deepIlxRepType ty
-deepIlxRepType (SourceTy p) = deepIlxRepType (sourceTypeRep p)
+deepIlxRepType (PredTy p) = deepIlxRepType (predTypeRep p)
deepIlxRepType ty@(TyVarTy tv) = ty
idIlxRepType id = deepIlxRepType (idType id)
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))
| 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,
-- 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
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# */ "
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])
FloatSinhOp -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Sinh(float64) conv.r4")
FloatCoshOp -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Cosh(float64) conv.r4")
FloatTanhOp -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Tanh(float64) conv.r4")
- FloatPowerOp -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Pow(float64, float64) conv.r4") -- ** op, make use of implicit cast to r8...
+ FloatPowerOp -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Pow(float64, float64) conv.r4") -- ** op, make use of implicit cast to r8...
DoubleExpOp -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Exp(float64)")
DoubleLogOp -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Log(float64)")
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])
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"))
projects / ghc-hetmet.git / blobdiff