Commit 6496c6f1 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Merge branch 'master' of http://darcs.haskell.org/ghc

parents f0c760ce b8fe21e9
......@@ -370,6 +370,18 @@ AC_DEFUN([FP_SETTINGS],
SettingsDllWrapCommand="/bin/false"
SettingsWindresCommand="/bin/false"
SettingsTouchCommand='touch'
if test -z "$LlcCmd"
then
SettingsLlcCommand="llc"
else
SettingsLlcCommand="$LlcCmd"
fi
if test -z "$OptCmd"
then
SettingsOptCommand="opt"
else
SettingsOptCommand="$OptCmd"
fi
fi
AC_SUBST(SettingsCCompilerCommand)
AC_SUBST(SettingsCCompilerFlags)
......@@ -377,6 +389,8 @@ AC_DEFUN([FP_SETTINGS],
AC_SUBST(SettingsDllWrapCommand)
AC_SUBST(SettingsWindresCommand)
AC_SUBST(SettingsTouchCommand)
AC_SUBST(SettingsLlcCommand)
AC_SUBST(SettingsOptCommand)
])
......@@ -538,6 +552,35 @@ AC_ARG_WITH($2,
]) # FP_ARG_WITH_PATH_GNU_PROG
# FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL
# --------------------
# XXX
#
# $1 = the variable to set
# $2 = the command to look for
#
AC_DEFUN([FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL],
[
AC_ARG_WITH($2,
[AC_HELP_STRING([--with-$2=ARG],
[Use ARG as the path to $2 [default=autodetect]])],
[
if test "$HostOS" = "mingw32"
then
AC_MSG_WARN([Request to use $withval will be ignored])
else
$1=$withval
fi
],
[
if test "$HostOS" != "mingw32"
then
AC_PATH_PROG([$1], [$2])
fi
]
)
]) # FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL
# FP_PROG_CONTEXT_DIFF
# --------------------
# Figure out how to do context diffs. Sets the output variable ContextDiffCmd.
......
......@@ -26,6 +26,7 @@ module CoreSyn (
mkIntLit, mkIntLitInt,
mkWordLit, mkWordLitWord,
mkWord64LitWord64, mkInt64LitInt64,
mkCharLit, mkStringLit,
mkFloatLit, mkFloatLitFloat,
mkDoubleLit, mkDoubleLitDouble,
......@@ -104,6 +105,7 @@ import Outputable
import Util
import Data.Data hiding (TyCon)
import Data.Int
import Data.Word
infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`
......@@ -1044,6 +1046,12 @@ mkWordLitWord :: Word -> Expr b
mkWordLit w = Lit (mkMachWord w)
mkWordLitWord w = Lit (mkMachWord (toInteger w))
mkWord64LitWord64 :: Word64 -> Expr b
mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w))
mkInt64LitInt64 :: Int64 -> Expr b
mkInt64LitInt64 w = Lit (mkMachInt64 (toInteger w))
-- | Create a machine character literal expression of type @Char#@.
-- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
mkCharLit :: Char -> Expr b
......
......@@ -251,8 +251,8 @@ initSysTools mbMinusB
ld_args = gcc_args
-- We just assume on command line
; let lc_prog = "llc"
lo_prog = "opt"
; lc_prog <- getSetting "LLVM llc command"
; lo_prog <- getSetting "LLVM opt command"
; return $ Settings {
sTargetPlatform = Platform {
......
......@@ -253,13 +253,16 @@ basicKnownKeyNames
-- Integer
integerTyConName, mkIntegerName,
integerToWord64Name, integerToInt64Name,
plusIntegerName, timesIntegerName, smallIntegerName,
integerToWordName, integerToIntName, minusIntegerName,
negateIntegerName, eqIntegerName, neqIntegerName,
absIntegerName, signumIntegerName,
leIntegerName, gtIntegerName, ltIntegerName, geIntegerName,
compareIntegerName, quotRemIntegerName, divModIntegerName,
quotIntegerName, remIntegerName,
floatFromIntegerName, doubleFromIntegerName,
encodeFloatIntegerName, encodeDoubleIntegerName,
gcdIntegerName, lcmIntegerName,
andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
shiftLIntegerName, shiftRIntegerName,
......@@ -821,18 +824,23 @@ minusName = methName gHC_NUM (fsLit "-") minusClassOpKey
negateName = methName gHC_NUM (fsLit "negate") negateClassOpKey
integerTyConName, mkIntegerName,
integerToWord64Name, integerToInt64Name,
plusIntegerName, timesIntegerName, smallIntegerName,
integerToWordName, integerToIntName, minusIntegerName,
negateIntegerName, eqIntegerName, neqIntegerName,
absIntegerName, signumIntegerName,
leIntegerName, gtIntegerName, ltIntegerName, geIntegerName,
compareIntegerName, quotRemIntegerName, divModIntegerName,
quotIntegerName, remIntegerName,
floatFromIntegerName, doubleFromIntegerName,
encodeFloatIntegerName, encodeDoubleIntegerName,
gcdIntegerName, lcmIntegerName,
andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
shiftLIntegerName, shiftRIntegerName :: Name
integerTyConName = tcQual gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey
mkIntegerName = varQual gHC_INTEGER_TYPE (fsLit "mkInteger") mkIntegerIdKey
integerToWord64Name = varQual gHC_INTEGER_TYPE (fsLit "integerToWord64") integerToWord64IdKey
integerToInt64Name = varQual gHC_INTEGER_TYPE (fsLit "integerToInt64") integerToInt64IdKey
plusIntegerName = varQual gHC_INTEGER_TYPE (fsLit "plusInteger") plusIntegerIdKey
timesIntegerName = varQual gHC_INTEGER_TYPE (fsLit "timesInteger") timesIntegerIdKey
smallIntegerName = varQual gHC_INTEGER_TYPE (fsLit "smallInteger") smallIntegerIdKey
......@@ -851,8 +859,12 @@ geIntegerName = varQual gHC_INTEGER_TYPE (fsLit "geInteger") geI
compareIntegerName = varQual gHC_INTEGER_TYPE (fsLit "compareInteger") compareIntegerIdKey
quotRemIntegerName = varQual gHC_INTEGER_TYPE (fsLit "quotRemInteger") quotRemIntegerIdKey
divModIntegerName = varQual gHC_INTEGER_TYPE (fsLit "divModInteger") divModIntegerIdKey
quotIntegerName = varQual gHC_INTEGER_TYPE (fsLit "quotInteger") quotIntegerIdKey
remIntegerName = varQual gHC_INTEGER_TYPE (fsLit "remInteger") remIntegerIdKey
floatFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "floatFromIntegerName") floatFromIntegerIdKey
doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromIntegerName") doubleFromIntegerIdKey
encodeFloatIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeFloatIntegerName") encodeFloatIntegerIdKey
encodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeDoubleIntegerName") encodeDoubleIntegerIdKey
gcdIntegerName = varQual gHC_INTEGER_TYPE (fsLit "gcdInteger") gcdIntegerIdKey
lcmIntegerName = varQual gHC_INTEGER_TYPE (fsLit "lcmInteger") lcmIntegerIdKey
andIntegerName = varQual gHC_INTEGER_TYPE (fsLit "andInteger") andIntegerIdKey
......@@ -1441,12 +1453,15 @@ assertIdKey = mkPreludeMiscIdUnique 44
runSTRepIdKey = mkPreludeMiscIdUnique 45
mkIntegerIdKey, smallIntegerIdKey, integerToWordIdKey, integerToIntIdKey,
integerToWord64IdKey, integerToInt64IdKey,
plusIntegerIdKey, timesIntegerIdKey, minusIntegerIdKey,
negateIntegerIdKey,
eqIntegerIdKey, neqIntegerIdKey, absIntegerIdKey, signumIntegerIdKey,
leIntegerIdKey, gtIntegerIdKey, ltIntegerIdKey, geIntegerIdKey,
compareIntegerIdKey, quotRemIntegerIdKey, divModIntegerIdKey,
quotIntegerIdKey, remIntegerIdKey,
floatFromIntegerIdKey, doubleFromIntegerIdKey,
encodeFloatIntegerIdKey, encodeDoubleIntegerIdKey,
gcdIntegerIdKey, lcmIntegerIdKey,
andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey,
shiftLIntegerIdKey, shiftRIntegerIdKey :: Unique
......@@ -1454,31 +1469,37 @@ mkIntegerIdKey = mkPreludeMiscIdUnique 60
smallIntegerIdKey = mkPreludeMiscIdUnique 61
integerToWordIdKey = mkPreludeMiscIdUnique 62
integerToIntIdKey = mkPreludeMiscIdUnique 63
plusIntegerIdKey = mkPreludeMiscIdUnique 64
timesIntegerIdKey = mkPreludeMiscIdUnique 65
minusIntegerIdKey = mkPreludeMiscIdUnique 66
negateIntegerIdKey = mkPreludeMiscIdUnique 67
eqIntegerIdKey = mkPreludeMiscIdUnique 68
neqIntegerIdKey = mkPreludeMiscIdUnique 69
absIntegerIdKey = mkPreludeMiscIdUnique 70
signumIntegerIdKey = mkPreludeMiscIdUnique 71
leIntegerIdKey = mkPreludeMiscIdUnique 72
gtIntegerIdKey = mkPreludeMiscIdUnique 73
ltIntegerIdKey = mkPreludeMiscIdUnique 74
geIntegerIdKey = mkPreludeMiscIdUnique 75
compareIntegerIdKey = mkPreludeMiscIdUnique 76
quotRemIntegerIdKey = mkPreludeMiscIdUnique 77
divModIntegerIdKey = mkPreludeMiscIdUnique 78
floatFromIntegerIdKey = mkPreludeMiscIdUnique 79
doubleFromIntegerIdKey = mkPreludeMiscIdUnique 80
gcdIntegerIdKey = mkPreludeMiscIdUnique 81
lcmIntegerIdKey = mkPreludeMiscIdUnique 82
andIntegerIdKey = mkPreludeMiscIdUnique 83
orIntegerIdKey = mkPreludeMiscIdUnique 84
xorIntegerIdKey = mkPreludeMiscIdUnique 85
complementIntegerIdKey = mkPreludeMiscIdUnique 86
shiftLIntegerIdKey = mkPreludeMiscIdUnique 87
shiftRIntegerIdKey = mkPreludeMiscIdUnique 88
integerToWord64IdKey = mkPreludeMiscIdUnique 64
integerToInt64IdKey = mkPreludeMiscIdUnique 65
plusIntegerIdKey = mkPreludeMiscIdUnique 66
timesIntegerIdKey = mkPreludeMiscIdUnique 67
minusIntegerIdKey = mkPreludeMiscIdUnique 68
negateIntegerIdKey = mkPreludeMiscIdUnique 69
eqIntegerIdKey = mkPreludeMiscIdUnique 70
neqIntegerIdKey = mkPreludeMiscIdUnique 71
absIntegerIdKey = mkPreludeMiscIdUnique 72
signumIntegerIdKey = mkPreludeMiscIdUnique 73
leIntegerIdKey = mkPreludeMiscIdUnique 74
gtIntegerIdKey = mkPreludeMiscIdUnique 75
ltIntegerIdKey = mkPreludeMiscIdUnique 76
geIntegerIdKey = mkPreludeMiscIdUnique 77
compareIntegerIdKey = mkPreludeMiscIdUnique 78
quotRemIntegerIdKey = mkPreludeMiscIdUnique 79
divModIntegerIdKey = mkPreludeMiscIdUnique 80
quotIntegerIdKey = mkPreludeMiscIdUnique 81
remIntegerIdKey = mkPreludeMiscIdUnique 82
floatFromIntegerIdKey = mkPreludeMiscIdUnique 83
doubleFromIntegerIdKey = mkPreludeMiscIdUnique 84
encodeFloatIntegerIdKey = mkPreludeMiscIdUnique 85
encodeDoubleIntegerIdKey = mkPreludeMiscIdUnique 86
gcdIntegerIdKey = mkPreludeMiscIdUnique 87
lcmIntegerIdKey = mkPreludeMiscIdUnique 88
andIntegerIdKey = mkPreludeMiscIdUnique 89
orIntegerIdKey = mkPreludeMiscIdUnique 90
xorIntegerIdKey = mkPreludeMiscIdUnique 91
complementIntegerIdKey = mkPreludeMiscIdUnique 92
shiftLIntegerIdKey = mkPreludeMiscIdUnique 93
shiftRIntegerIdKey = mkPreludeMiscIdUnique 94
rootMainKey, runMainKey :: Unique
rootMainKey = mkPreludeMiscIdUnique 100
......
......@@ -623,42 +623,42 @@ builtinIntegerRules :: [CoreRule]
builtinIntegerRules =
[-- TODO: smallInteger rule
-- TODO: wordToInteger rule
rule_convert "integerToWord" integerToWordName mkWordLitWord,
rule_convert "integerToInt" integerToIntName mkIntLitInt,
-- TODO: integerToWord64 rule
rule_convert "integerToWord" integerToWordName mkWordLitWord,
rule_convert "integerToInt" integerToIntName mkIntLitInt,
rule_convert "integerToWord64" integerToWord64Name mkWord64LitWord64,
-- TODO: word64ToInteger rule
-- TODO: integerToInt64 rule
rule_convert "integerToInt64" integerToInt64Name mkInt64LitInt64,
-- TODO: int64ToInteger rule
rule_binop "plusInteger" plusIntegerName (+),
rule_binop "minusInteger" minusIntegerName (-),
rule_binop "timesInteger" timesIntegerName (*),
rule_unop "negateInteger" negateIntegerName negate,
rule_binop_Bool "eqInteger" eqIntegerName (==),
rule_binop_Bool "neqInteger" neqIntegerName (/=),
rule_unop "absInteger" absIntegerName abs,
rule_unop "signumInteger" signumIntegerName signum,
rule_binop_Bool "leInteger" leIntegerName (<=),
rule_binop_Bool "gtInteger" gtIntegerName (>),
rule_binop_Bool "ltInteger" ltIntegerName (<),
rule_binop_Bool "geInteger" geIntegerName (>=),
rule_binop_Ordering "compareInteger" compareIntegerName compare,
rule_divop "divModInteger" divModIntegerName divMod,
rule_divop "quotRemInteger" quotRemIntegerName quotRem,
-- TODO: quotInteger rule
-- TODO: remInteger rule
-- TODO: encodeFloatInteger rule
rule_convert "floatFromInteger" floatFromIntegerName mkFloatLitFloat,
-- TODO: encodeDoubleInteger rule
rule_binop "plusInteger" plusIntegerName (+),
rule_binop "minusInteger" minusIntegerName (-),
rule_binop "timesInteger" timesIntegerName (*),
rule_unop "negateInteger" negateIntegerName negate,
rule_binop_Bool "eqInteger" eqIntegerName (==),
rule_binop_Bool "neqInteger" neqIntegerName (/=),
rule_unop "absInteger" absIntegerName abs,
rule_unop "signumInteger" signumIntegerName signum,
rule_binop_Bool "leInteger" leIntegerName (<=),
rule_binop_Bool "gtInteger" gtIntegerName (>),
rule_binop_Bool "ltInteger" ltIntegerName (<),
rule_binop_Bool "geInteger" geIntegerName (>=),
rule_binop_Ordering "compareInteger" compareIntegerName compare,
rule_divop_both "divModInteger" divModIntegerName divMod,
rule_divop_both "quotRemInteger" quotRemIntegerName quotRem,
rule_divop_one "quotInteger" quotIntegerName quot,
rule_divop_one "remInteger" remIntegerName rem,
rule_encodeFloat "encodeFloatInteger" encodeFloatIntegerName mkFloatLitFloat,
rule_convert "floatFromInteger" floatFromIntegerName mkFloatLitFloat,
rule_encodeFloat "encodeDoubleInteger" encodeDoubleIntegerName mkDoubleLitDouble,
-- TODO: decodeDoubleInteger rule
rule_convert "doubleFromInteger" doubleFromIntegerName mkDoubleLitDouble,
rule_binop "gcdInteger" gcdIntegerName gcd,
rule_binop "lcmInteger" lcmIntegerName lcm,
rule_binop "andInteger" andIntegerName (.&.),
rule_binop "orInteger" orIntegerName (.|.),
rule_binop "xorInteger" xorIntegerName xor,
rule_unop "complementInteger" complementIntegerName complement,
rule_Int_binop "shiftLInteger" shiftLIntegerName shiftL,
rule_Int_binop "shiftRInteger" shiftRIntegerName shiftR]
rule_convert "doubleFromInteger" doubleFromIntegerName mkDoubleLitDouble,
rule_binop "gcdInteger" gcdIntegerName gcd,
rule_binop "lcmInteger" lcmIntegerName lcm,
rule_binop "andInteger" andIntegerName (.&.),
rule_binop "orInteger" orIntegerName (.|.),
rule_binop "xorInteger" xorIntegerName xor,
rule_unop "complementInteger" complementIntegerName complement,
rule_Int_binop "shiftLInteger" shiftLIntegerName shiftL,
rule_Int_binop "shiftRInteger" shiftRIntegerName shiftR]
where rule_convert str name convert
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,
ru_try = match_Integer_convert convert }
......@@ -668,9 +668,12 @@ builtinIntegerRules =
rule_binop str name op
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
ru_try = match_Integer_binop op }
rule_divop str name op
rule_divop_both str name op
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
ru_try = match_Integer_divop op }
ru_try = match_Integer_divop_both op }
rule_divop_one str name op
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
ru_try = match_Integer_divop_one op }
rule_Int_binop str name op
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
ru_try = match_Integer_Int_binop op }
......@@ -680,6 +683,9 @@ builtinIntegerRules =
rule_binop_Ordering str name op
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
ru_try = match_Integer_binop_Ordering op }
rule_encodeFloat str name op
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
ru_try = match_Integer_Int_encodeFloat op }
---------------------------------------------------
-- The rule is this:
......@@ -773,11 +779,11 @@ match_Integer_binop binop id_unf [xl,yl]
match_Integer_binop _ _ _ = Nothing
-- This helper is used for the quotRem and divMod functions
match_Integer_divop :: (Integer -> Integer -> (Integer, Integer))
-> IdUnfoldingFun
-> [Expr CoreBndr]
-> Maybe (Expr CoreBndr)
match_Integer_divop divop id_unf [xl,yl]
match_Integer_divop_both :: (Integer -> Integer -> (Integer, Integer))
-> IdUnfoldingFun
-> [Expr CoreBndr]
-> Maybe (Expr CoreBndr)
match_Integer_divop_both divop id_unf [xl,yl]
| Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
, Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
, y /= 0
......@@ -789,9 +795,20 @@ match_Integer_divop divop id_unf [xl,yl]
Type integerTy,
Lit (LitInteger r i),
Lit (LitInteger s i)]
_ -> panic "match_Integer_divop: mkIntegerId has the wrong type"
_ -> panic "match_Integer_divop_both: mkIntegerId has the wrong type"
match_Integer_divop_both _ _ _ = Nothing
match_Integer_divop _ _ _ = Nothing
-- This helper is used for the quotRem and divMod functions
match_Integer_divop_one :: (Integer -> Integer -> Integer)
-> IdUnfoldingFun
-> [Expr CoreBndr]
-> Maybe (Expr CoreBndr)
match_Integer_divop_one divop id_unf [xl,yl]
| Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
, Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
, y /= 0
= Just (Lit (LitInteger (x `divop` y) i))
match_Integer_divop_one _ _ _ = Nothing
match_Integer_Int_binop :: (Integer -> Int -> Integer)
-> IdUnfoldingFun
......@@ -825,4 +842,15 @@ match_Integer_binop_Ordering binop id_unf [xl, yl]
EQ -> eqVal
GT -> gtVal
match_Integer_binop_Ordering _ _ _ = Nothing
match_Integer_Int_encodeFloat :: RealFloat a
=> (a -> Expr CoreBndr)
-> IdUnfoldingFun
-> [Expr CoreBndr]
-> Maybe (Expr CoreBndr)
match_Integer_Int_encodeFloat mkLit id_unf [xl,yl]
| Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
, Just (MachInt y) <- exprIsLiteral_maybe id_unf yl
= Just (mkLit $ encodeFloat x (fromInteger y))
match_Integer_Int_encodeFloat _ _ _ = Nothing
\end{code}
......@@ -349,6 +349,18 @@ FP_ARG_WITH_PATH_GNU_PROG([NM], [nm])
NmCmd="$NM"
AC_SUBST([NmCmd])
dnl ** Which LLVM llc to use?
dnl --------------------------------------------------------------
FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL([LLC], [llc])
LlcCmd="$LLC"
AC_SUBST([LlcCmd])
dnl ** Which LLVM opt to use?
dnl --------------------------------------------------------------
FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL([OPT], [opt])
OptCmd="$OPT"
AC_SUBST([OptCmd])
dnl ** Mac OS X: explicit deployment target
dnl --------------------------------------------------------------
AC_ARG_WITH([macosx-deployment-target],
......
......@@ -678,6 +678,9 @@ DTRACE = @DtraceCmd@
LD = @LdCmd@
NM = @NmCmd@
LLC = @LlcCmd@
OPT = @OptCmd@
# Some ld's support the -x flag and some don't, so the configure
# script detects which we have and sets LdXFlag to "-x" or ""
# respectively.
......
......@@ -13,6 +13,8 @@
("target word size", "@WordSize@"),
("target has GNU nonexec stack", "@HaskellHaveGnuNonexecStack@"),
("target has .ident directive", "@HaskellHaveIdentDirective@"),
("target has subsections via symbols", "@HaskellHaveSubsectionsViaSymbols@")
("target has subsections via symbols", "@HaskellHaveSubsectionsViaSymbols@"),
("LLVM llc command", "@SettingsLlcCommand@"),
("LLVM opt command", "@SettingsOptCommand@")
]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment