Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : simd
http://hackage.haskell.org/trac/ghc/changeset/770499c29ccf36aa939aefd982028dae60c0f72e >--------------------------------------------------------------- commit 770499c29ccf36aa939aefd982028dae60c0f72e Merge: e42746d... 1bbb89f... Author: Geoffrey Mainland <[email protected]> Date: Wed Nov 16 16:17:58 2011 +0000 Merge branch 'master' into simd Conflicts: compiler/prelude/TysPrim.lhs compiler/basicTypes/Literal.lhs | 6 +- compiler/basicTypes/MkId.lhs | 2 +- compiler/basicTypes/OccName.lhs | 35 + compiler/basicTypes/RdrName.lhs | 10 +- compiler/basicTypes/Var.lhs | 49 +- compiler/codeGen/CgPrimOp.hs | 2 +- compiler/codeGen/StgCmmPrim.hs | 2 +- compiler/coreSyn/CoreArity.lhs | 193 ++- compiler/coreSyn/CoreLint.lhs | 234 ++-- compiler/coreSyn/CoreSyn.lhs | 30 +- compiler/coreSyn/CoreUnfold.lhs | 106 +- compiler/coreSyn/CoreUtils.lhs | 113 +- compiler/coreSyn/MkCore.lhs | 4 +- compiler/coreSyn/MkExternalCore.lhs | 1 + compiler/coreSyn/PprCore.lhs | 1 + compiler/deSugar/Coverage.lhs | 3 - compiler/deSugar/Desugar.lhs | 2 - compiler/deSugar/DsExpr.lhs | 6 +- compiler/deSugar/DsListComp.lhs | 16 +- compiler/deSugar/DsMeta.hs | 16 +- compiler/deSugar/DsMonad.lhs | 207 ++- compiler/deSugar/DsUtils.lhs | 12 +- compiler/ghc.cabal.in | 1 + compiler/ghci/RtClosureInspect.hs | 3 +- compiler/hsSyn/Convert.lhs | 22 +- compiler/hsSyn/HsBinds.lhs | 7 +- compiler/hsSyn/HsDecls.lhs | 33 +- compiler/hsSyn/HsExpr.lhs | 10 +- compiler/hsSyn/HsExpr.lhs-boot | 10 +- compiler/hsSyn/HsLit.lhs | 23 +- compiler/hsSyn/HsPat.lhs-boot | 5 +- compiler/hsSyn/HsTypes.lhs | 171 ++- compiler/iface/BinIface.hs | 1739 ++++++++++---------- compiler/iface/BuildTyCl.lhs | 26 +- compiler/iface/FlagChecker.hs | 47 + compiler/iface/IfaceSyn.lhs | 12 +- compiler/iface/IfaceType.lhs | 97 +- compiler/iface/LoadIface.lhs | 3 +- compiler/iface/MkIface.lhs | 781 +++++----- compiler/iface/TcIface.lhs | 95 +- compiler/iface/TcIface.lhs-boot | 4 +- compiler/main/DriverPipeline.hs | 69 +- compiler/main/DynFlags.hs | 46 +- compiler/main/GHC.hs | 4 +- compiler/main/HscMain.hs | 6 +- compiler/main/HscTypes.lhs | 451 +++--- compiler/main/Packages.lhs | 8 +- compiler/main/TidyPgm.lhs | 12 +- compiler/parser/Lexer.x | 15 +- compiler/parser/Parser.y.pp | 105 +- compiler/parser/ParserCore.y | 16 +- compiler/parser/RdrHsSyn.lhs | 32 +- compiler/prelude/PrelNames.lhs | 90 +- compiler/prelude/PrelRules.lhs | 3 + compiler/prelude/TysPrim.lhs | 134 +- compiler/prelude/TysWiredIn.lhs | 15 +- compiler/prelude/primops.txt.pp | 9 +- compiler/rename/RnBinds.lhs | 2 +- compiler/rename/RnEnv.lhs | 152 ++- compiler/rename/RnExpr.lhs | 25 +- compiler/rename/RnHsSyn.lhs | 31 +- compiler/rename/RnPat.lhs | 5 +- compiler/rename/RnSource.lhs | 103 +- compiler/rename/RnTypes.lhs | 187 ++- compiler/simplCore/FloatOut.lhs | 14 +- compiler/simplCore/SetLevels.lhs | 22 +- compiler/simplCore/SimplCore.lhs | 9 +- compiler/simplCore/SimplEnv.lhs | 11 +- compiler/simplCore/SimplUtils.lhs | 83 +- compiler/simplCore/Simplify.lhs | 82 +- compiler/specialise/SpecConstr.lhs | 4 +- compiler/typecheck/FamInst.lhs | 1 + compiler/typecheck/TcArrows.lhs | 9 +- compiler/typecheck/TcBinds.lhs | 1 + compiler/typecheck/TcCanonical.lhs | 60 +- compiler/typecheck/TcClassDcl.lhs | 4 +- compiler/typecheck/TcDeriv.lhs | 9 +- compiler/typecheck/TcEnv.lhs | 60 +- compiler/typecheck/TcExpr.lhs | 33 +- compiler/typecheck/TcGenDeriv.lhs | 27 +- compiler/typecheck/TcHsSyn.lhs | 252 ++- compiler/typecheck/TcHsType.lhs | 559 ++++++-- compiler/typecheck/TcInstDcls.lhs | 82 +- compiler/typecheck/TcInteract.lhs | 33 +- compiler/typecheck/TcMType.lhs | 468 ++++--- compiler/typecheck/TcPat.lhs | 5 +- compiler/typecheck/TcRnDriver.lhs | 22 +- compiler/typecheck/TcRnMonad.lhs | 1 - compiler/typecheck/TcRnTypes.lhs | 35 +- compiler/typecheck/TcRules.lhs | 13 +- compiler/typecheck/TcSMonad.lhs | 20 +- compiler/typecheck/TcSimplify.lhs | 32 +- compiler/typecheck/TcSplice.lhs | 17 +- compiler/typecheck/TcTyClsDecls.lhs | 879 ++++++---- compiler/typecheck/TcType.lhs | 59 +- compiler/typecheck/TcUnify.lhs | 383 +++-- compiler/typecheck/TcUnify.lhs-boot | 12 +- compiler/types/Class.lhs | 28 +- compiler/types/Coercion.lhs | 81 +- compiler/types/FamInstEnv.lhs | 88 +- compiler/types/Kind.lhs | 239 +++- compiler/types/TyCon.lhs | 125 +- compiler/types/Type.lhs | 147 ++- compiler/types/Type.lhs-boot | 3 + compiler/types/TypeRep.lhs | 63 +- compiler/types/TypeRep.lhs-boot | 1 + compiler/types/Unify.lhs | 57 +- compiler/utils/Binary.hs | 32 +- compiler/utils/Outputable.lhs | 5 +- compiler/utils/Pretty.lhs | 9 +- .../vectorise/Vectorise/Builtins/Initialise.hs | 14 +- compiler/vectorise/Vectorise/Env.hs | 34 +- compiler/vectorise/Vectorise/Exp.hs | 10 - compiler/vectorise/Vectorise/Monad.hs | 5 +- compiler/vectorise/Vectorise/Monad/Naming.hs | 4 +- compiler/vectorise/Vectorise/Type/Classify.hs | 22 +- compiler/vectorise/Vectorise/Type/Env.hs | 14 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 33 +- docs/users_guide/flags.xml | 9 + docs/users_guide/glasgow_exts.xml | 15 +- docs/users_guide/using.xml | 14 + ghc.mk | 11 +- includes/Rts.h | 1 + includes/RtsAPI.h | 46 +- includes/RtsOpts.h | 20 - rts/RtsMain.h => includes/rts/Main.h | 4 +- mk/validate-settings.mk | 11 +- rts/Exception.cmm | 4 +- rts/Main.c | 24 - rts/Profiling.c | 24 +- rts/Profiling.h | 2 +- rts/RaiseAsync.c | 2 +- rts/RtsFlags.c | 26 +- rts/RtsFlags.h | 4 +- rts/RtsMain.c | 17 +- rts/RtsStartup.c | 14 +- rts/ThreadPaused.c | 132 +- rts/ghc.mk | 13 +- rts/hooks/RtsOpts.c | 14 - rts/win32/Ticker.c | 3 +- validate | 85 +- 141 files changed, 6277 insertions(+), 4192 deletions(-) diff --cc compiler/prelude/TysPrim.lhs index eaa127f,e97f462..9775384 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@@ -74,13 -75,7 +75,13 @@@ module TysPrim eqPrimTyCon, -- ty1 ~# ty2 -- * Any - anyTy, anyTyCon, anyTyConOfKind, anyTypeOfKind, - anyTy, anyTyCon, anyTypeOfKind ++ anyTy, anyTyCon, anyTypeOfKind, + + -- * SIMD + floatX4PrimTyCon, floatX4PrimTy, + doubleX2PrimTyCon, doubleX2PrimTy, + int32X4PrimTyCon, int32X4PrimTy, + int64X2PrimTyCon, int64X2PrimTy ) where #include "HsVersions.h" @@@ -698,53 -685,9 +700,37 @@@ anyTy :: Typ anyTy = mkTyConTy anyTyCon anyTyCon :: TyCon - anyTyCon = mkLiftedPrimTyCon anyTyConName liftedTypeKind 0 PtrRep + anyTyCon = mkLiftedPrimTyCon anyTyConName kind 1 PtrRep + where kind = ForAllTy kKiVar (mkTyVarTy kKiVar) anyTypeOfKind :: Kind -> Type - anyTypeOfKind kind = mkTyConApp (anyTyConOfKind kind) [] - - anyTyConOfKind :: Kind -> TyCon - -- Map all superkinds of liftedTypeKind to liftedTypeKind - anyTyConOfKind kind - | isLiftedTypeKind kind = anyTyCon - | otherwise = tycon - where - -- Derive the name from the kind, thus: - -- Any(*->*), Any(*->*->*) - -- These are names that can't be written by the user, - -- and are not allocated in the global name cache - str = "Any" ++ showSDoc (pprParendKind kind) - - occ = mkTcOcc str - uniq = getUnique occ -- See Note [Uniques of Any] - name = mkWiredInName gHC_PRIM occ uniq (ATyCon tycon) UserSyntax - tycon = mkAnyTyCon name kind + anyTypeOfKind kind = mkTyConApp anyTyCon [kind] \end{code} + +%************************************************************************ +%* * +\subsection{SIMD vector type} +%* * +%************************************************************************ + +\begin{code} +floatX4PrimTy :: Type +floatX4PrimTy = mkTyConTy floatX4PrimTyCon +floatX4PrimTyCon :: TyCon +floatX4PrimTyCon = pcPrimTyCon0 floatX4PrimTyConName (VecRep 4 FloatElemRep) + +doubleX2PrimTy :: Type +doubleX2PrimTy = mkTyConTy doubleX2PrimTyCon +doubleX2PrimTyCon :: TyCon +doubleX2PrimTyCon = pcPrimTyCon0 doubleX2PrimTyConName (VecRep 2 DoubleElemRep) + +int32X4PrimTy :: Type +int32X4PrimTy = mkTyConTy int32X4PrimTyCon +int32X4PrimTyCon :: TyCon +int32X4PrimTyCon = pcPrimTyCon0 int32X4PrimTyConName (VecRep 4 Int32ElemRep) + +int64X2PrimTy :: Type +int64X2PrimTy = mkTyConTy int64X2PrimTyCon +int64X2PrimTyCon :: TyCon +int64X2PrimTyCon = pcPrimTyCon0 int64X2PrimTyConName (VecRep 2 Int64ElemRep) +\end{code} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
