-import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
-import DataCon ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
-import CoreUtils ( cheapEqExpr )
-import CoreUnfold ( exprIsConApp_maybe )
+import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
+import DataCon ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
+import CoreUtils ( cheapEqExpr )
+import CoreUnfold ( exprIsConApp_maybe )
- -- coercions
- primop_rule Word2IntOp = one_lit (litCoerce word2IntLit)
- primop_rule Int2WordOp = one_lit (litCoerce int2WordLit)
- primop_rule Narrow8IntOp = one_lit (litCoerce narrow8IntLit)
- primop_rule Narrow16IntOp = one_lit (litCoerce narrow16IntLit)
- primop_rule Narrow32IntOp = one_lit (litCoerce narrow32IntLit)
- primop_rule Narrow8WordOp = one_lit (litCoerce narrow8WordLit)
- primop_rule Narrow16WordOp = one_lit (litCoerce narrow16WordLit)
- primop_rule Narrow32WordOp = one_lit (litCoerce narrow32WordLit)
- primop_rule OrdOp = one_lit (litCoerce char2IntLit)
- primop_rule ChrOp = one_lit (predLitCoerce litFitsInChar int2CharLit)
- primop_rule Float2IntOp = one_lit (litCoerce float2IntLit)
- primop_rule Int2FloatOp = one_lit (litCoerce int2FloatLit)
- primop_rule Double2IntOp = one_lit (litCoerce double2IntLit)
- primop_rule Int2DoubleOp = one_lit (litCoerce int2DoubleLit)
- -- SUP: Not sure what the standard says about precision in the following 2 cases
- primop_rule Float2DoubleOp = one_lit (litCoerce float2DoubleLit)
- primop_rule Double2FloatOp = one_lit (litCoerce double2FloatLit)
-
- -- Float
+ -- coercions
+ primop_rule Word2IntOp = one_lit (litCoerce word2IntLit)
+ primop_rule Int2WordOp = one_lit (litCoerce int2WordLit)
+ primop_rule Narrow8IntOp = one_lit (litCoerce narrow8IntLit)
+ primop_rule Narrow16IntOp = one_lit (litCoerce narrow16IntLit)
+ primop_rule Narrow32IntOp = one_lit (litCoerce narrow32IntLit)
+ primop_rule Narrow8WordOp = one_lit (litCoerce narrow8WordLit)
+ primop_rule Narrow16WordOp = one_lit (litCoerce narrow16WordLit)
+ primop_rule Narrow32WordOp = one_lit (litCoerce narrow32WordLit)
+ primop_rule OrdOp = one_lit (litCoerce char2IntLit)
+ primop_rule ChrOp = one_lit (predLitCoerce litFitsInChar int2CharLit)
+ primop_rule Float2IntOp = one_lit (litCoerce float2IntLit)
+ primop_rule Int2FloatOp = one_lit (litCoerce int2FloatLit)
+ primop_rule Double2IntOp = one_lit (litCoerce double2IntLit)
+ primop_rule Int2DoubleOp = one_lit (litCoerce int2DoubleLit)
+ -- SUP: Not sure what the standard says about precision in the following 2 cases
+ primop_rule Float2DoubleOp = one_lit (litCoerce float2DoubleLit)
+ primop_rule Double2FloatOp = one_lit (litCoerce double2FloatLit)
+
+ -- Float
primop_rule FloatAddOp = two_lits (floatOp2 (+))
primop_rule FloatSubOp = two_lits (floatOp2 (-))
primop_rule FloatMulOp = two_lits (floatOp2 (*))
primop_rule FloatDivOp = two_lits (floatOp2Z (/))
primop_rule FloatNegOp = one_lit negOp
primop_rule FloatAddOp = two_lits (floatOp2 (+))
primop_rule FloatSubOp = two_lits (floatOp2 (-))
primop_rule FloatMulOp = two_lits (floatOp2 (*))
primop_rule FloatDivOp = two_lits (floatOp2Z (/))
primop_rule FloatNegOp = one_lit negOp
primop_rule DoubleAddOp = two_lits (doubleOp2 (+))
primop_rule DoubleSubOp = two_lits (doubleOp2 (-))
primop_rule DoubleMulOp = two_lits (doubleOp2 (*))
primop_rule DoubleDivOp = two_lits (doubleOp2Z (/))
primop_rule DoubleNegOp = one_lit negOp
primop_rule DoubleAddOp = two_lits (doubleOp2 (+))
primop_rule DoubleSubOp = two_lits (doubleOp2 (-))
primop_rule DoubleMulOp = two_lits (doubleOp2 (*))
primop_rule DoubleDivOp = two_lits (doubleOp2Z (/))
primop_rule DoubleNegOp = one_lit negOp
- -- Relational operators
- primop_rule IntEqOp = relop (==) ++ litEq op_name True
- primop_rule IntNeOp = relop (/=) ++ litEq op_name False
- primop_rule CharEqOp = relop (==) ++ litEq op_name True
- primop_rule CharNeOp = relop (/=) ++ litEq op_name False
-
- primop_rule IntGtOp = relop (>)
- primop_rule IntGeOp = relop (>=)
- primop_rule IntLeOp = relop (<=)
- primop_rule IntLtOp = relop (<)
-
- primop_rule CharGtOp = relop (>)
- primop_rule CharGeOp = relop (>=)
- primop_rule CharLeOp = relop (<=)
- primop_rule CharLtOp = relop (<)
-
- primop_rule FloatGtOp = relop (>)
- primop_rule FloatGeOp = relop (>=)
- primop_rule FloatLeOp = relop (<=)
- primop_rule FloatLtOp = relop (<)
- primop_rule FloatEqOp = relop (==)
- primop_rule FloatNeOp = relop (/=)
-
- primop_rule DoubleGtOp = relop (>)
- primop_rule DoubleGeOp = relop (>=)
- primop_rule DoubleLeOp = relop (<=)
- primop_rule DoubleLtOp = relop (<)
- primop_rule DoubleEqOp = relop (==)
- primop_rule DoubleNeOp = relop (/=)
-
- primop_rule WordGtOp = relop (>)
- primop_rule WordGeOp = relop (>=)
- primop_rule WordLeOp = relop (<=)
- primop_rule WordLtOp = relop (<)
- primop_rule WordEqOp = relop (==)
- primop_rule WordNeOp = relop (/=)
-
- primop_rule _ = []
+ -- Relational operators
+ primop_rule IntEqOp = relop (==) ++ litEq op_name True
+ primop_rule IntNeOp = relop (/=) ++ litEq op_name False
+ primop_rule CharEqOp = relop (==) ++ litEq op_name True
+ primop_rule CharNeOp = relop (/=) ++ litEq op_name False
+
+ primop_rule IntGtOp = relop (>)
+ primop_rule IntGeOp = relop (>=)
+ primop_rule IntLeOp = relop (<=)
+ primop_rule IntLtOp = relop (<)
+
+ primop_rule CharGtOp = relop (>)
+ primop_rule CharGeOp = relop (>=)
+ primop_rule CharLeOp = relop (<=)
+ primop_rule CharLtOp = relop (<)
+
+ primop_rule FloatGtOp = relop (>)
+ primop_rule FloatGeOp = relop (>=)
+ primop_rule FloatLeOp = relop (<=)
+ primop_rule FloatLtOp = relop (<)
+ primop_rule FloatEqOp = relop (==)
+ primop_rule FloatNeOp = relop (/=)
+
+ primop_rule DoubleGtOp = relop (>)
+ primop_rule DoubleGeOp = relop (>=)
+ primop_rule DoubleLeOp = relop (<=)
+ primop_rule DoubleLtOp = relop (<)
+ primop_rule DoubleEqOp = relop (==)
+ primop_rule DoubleNeOp = relop (/=)
+
+ primop_rule WordGtOp = relop (>)
+ primop_rule WordGeOp = relop (>=)
+ primop_rule WordLeOp = relop (<=)
+ primop_rule WordLtOp = relop (<)
+ primop_rule WordEqOp = relop (==)
+ primop_rule WordNeOp = relop (/=)
+
+ primop_rule _ = []
intOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
-- Like intOp2, but Nothing if i2=0
intOp2Z op (MachInt i1) (MachInt i2)
| i2 /= 0 = intResult (i1 `op` i2)
intOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
-- Like intOp2, but Nothing if i2=0
intOp2Z op (MachInt i1) (MachInt i2)
| i2 /= 0 = intResult (i1 `op` i2)
- -- This stuff turns
- -- n ==# 3#
- -- into
- -- case n of
- -- 3# -> True
- -- m -> False
- --
- -- This is a Good Thing, because it allows case-of case things
- -- to happen, and case-default absorption to happen. For
- -- example:
- --
- -- if (n ==# 3#) || (n ==# 4#) then e1 else e2
- -- will transform to
- -- case n of
- -- 3# -> e1
- -- 4# -> e1
- -- m -> e2
- -- (modulo the usual precautions to avoid duplicating e1)
-
-litEq :: Name
- -> Bool -- True <=> equality, False <=> inequality
+-- This stuff turns
+-- n ==# 3#
+-- into
+-- case n of
+-- 3# -> True
+-- m -> False
+--
+-- This is a Good Thing, because it allows case-of case things
+-- to happen, and case-default absorption to happen. For
+-- example:
+--
+-- if (n ==# 3#) || (n ==# 4#) then e1 else e2
+-- will transform to
+-- case n of
+-- 3# -> e1
+-- 4# -> e1
+-- m -> e2
+-- (modulo the usual precautions to avoid duplicating e1)
+
+litEq :: Name
+ -> Bool -- True <=> equality, False <=> inequality