Permalink
Browse files

Convert comparison primops to return Int#

This implementation is unfinished. For some reason everything built
using a stage1 compiler segfaults.
  • Loading branch information...
1 parent 27cf625 commit b5be2fb1083d16239024849b60a4b3009e67afd9 @jstolarek committed Apr 11, 2013
@@ -264,7 +264,7 @@ native routes, but is otherwise harmless.
isComparisonMachOp :: MachOp -> Bool
isComparisonMachOp mop =
case mop of
- MO_Eq _ -> True
+{- MO_Eq _ -> True
MO_Ne _ -> True
MO_S_Ge _ -> True
MO_S_Le _ -> True
@@ -279,7 +279,7 @@ isComparisonMachOp mop =
MO_F_Ge {} -> True
MO_F_Le {} -> True
MO_F_Gt {} -> True
- MO_F_Lt {} -> True
+ MO_F_Lt {} -> True-}
_other -> False
-- -----------------------------------------------------------------------------
@@ -294,7 +294,7 @@ isComparisonMachOp mop =
maybeInvertComparison :: MachOp -> Maybe MachOp
maybeInvertComparison op
= case op of -- None of these Just cases include floating point
- MO_Eq r -> Just (MO_Ne r)
+{- MO_Eq r -> Just (MO_Ne r)
MO_Ne r -> Just (MO_Eq r)
MO_U_Lt r -> Just (MO_U_Ge r)
MO_U_Gt r -> Just (MO_U_Le r)
@@ -303,7 +303,7 @@ maybeInvertComparison op
MO_S_Lt r -> Just (MO_S_Ge r)
MO_S_Gt r -> Just (MO_S_Le r)
MO_S_Le r -> Just (MO_S_Gt r)
- MO_S_Ge r -> Just (MO_S_Lt r)
+ MO_S_Ge r -> Just (MO_S_Lt r)-}
_other -> Nothing
-- ----------------------------------------------------------------------------
@@ -216,41 +216,42 @@ primOpRules nm DoubleNegOp = mkPrimOpRule nm 1 [ unaryLit negOp
, inversePrimOp DoubleNegOp ]
-- Relational operators
-primOpRules nm IntEqOp = mkRelOpRule nm (==) [ litEq True ]
-primOpRules nm IntNeOp = mkRelOpRule nm (/=) [ litEq False ]
-primOpRules nm CharEqOp = mkRelOpRule nm (==) [ litEq True ]
-primOpRules nm CharNeOp = mkRelOpRule nm (/=) [ litEq False ]
-
-primOpRules nm IntGtOp = mkRelOpRule nm (>) [ boundsCmp Gt ]
-primOpRules nm IntGeOp = mkRelOpRule nm (>=) [ boundsCmp Ge ]
-primOpRules nm IntLeOp = mkRelOpRule nm (<=) [ boundsCmp Le ]
-primOpRules nm IntLtOp = mkRelOpRule nm (<) [ boundsCmp Lt ]
-
-primOpRules nm CharGtOp = mkRelOpRule nm (>) [ boundsCmp Gt ]
-primOpRules nm CharGeOp = mkRelOpRule nm (>=) [ boundsCmp Ge ]
-primOpRules nm CharLeOp = mkRelOpRule nm (<=) [ boundsCmp Le ]
-primOpRules nm CharLtOp = mkRelOpRule nm (<) [ boundsCmp Lt ]
-
-primOpRules nm FloatGtOp = mkRelOpRule nm (>) []
-primOpRules nm FloatGeOp = mkRelOpRule nm (>=) []
-primOpRules nm FloatLeOp = mkRelOpRule nm (<=) []
-primOpRules nm FloatLtOp = mkRelOpRule nm (<) []
-primOpRules nm FloatEqOp = mkRelOpRule nm (==) [ litEq True ]
-primOpRules nm FloatNeOp = mkRelOpRule nm (/=) [ litEq False ]
-
-primOpRules nm DoubleGtOp = mkRelOpRule nm (>) []
-primOpRules nm DoubleGeOp = mkRelOpRule nm (>=) []
-primOpRules nm DoubleLeOp = mkRelOpRule nm (<=) []
-primOpRules nm DoubleLtOp = mkRelOpRule nm (<) []
-primOpRules nm DoubleEqOp = mkRelOpRule nm (==) [ litEq True ]
-primOpRules nm DoubleNeOp = mkRelOpRule nm (/=) [ litEq False ]
-
-primOpRules nm WordGtOp = mkRelOpRule nm (>) [ boundsCmp Gt ]
-primOpRules nm WordGeOp = mkRelOpRule nm (>=) [ boundsCmp Ge ]
-primOpRules nm WordLeOp = mkRelOpRule nm (<=) [ boundsCmp Le ]
-primOpRules nm WordLtOp = mkRelOpRule nm (<) [ boundsCmp Lt ]
-primOpRules nm WordEqOp = mkRelOpRule nm (==) [ litEq True ]
-primOpRules nm WordNeOp = mkRelOpRule nm (/=) [ litEq False ]
+
+primOpRules nm IntEqOp = mkPrimOpRule nm 2 []
+primOpRules nm IntNeOp = mkPrimOpRule nm 2 []
+primOpRules nm CharEqOp = mkPrimOpRule nm 2 []
+primOpRules nm CharNeOp = mkPrimOpRule nm 2 []
+
+primOpRules nm IntGtOp = mkPrimOpRule nm 2 []
+primOpRules nm IntGeOp = mkPrimOpRule nm 2 []
+primOpRules nm IntLeOp = mkPrimOpRule nm 2 []
+primOpRules nm IntLtOp = mkPrimOpRule nm 2 []
+
+primOpRules nm CharGtOp = mkPrimOpRule nm 2 []
+primOpRules nm CharGeOp = mkPrimOpRule nm 2 []
+primOpRules nm CharLeOp = mkPrimOpRule nm 2 []
+primOpRules nm CharLtOp = mkPrimOpRule nm 2 []
+
+primOpRules nm FloatGtOp = mkPrimOpRule nm 2 []
+primOpRules nm FloatGeOp = mkPrimOpRule nm 2 []
+primOpRules nm FloatLeOp = mkPrimOpRule nm 2 []
+primOpRules nm FloatLtOp = mkPrimOpRule nm 2 []
+primOpRules nm FloatEqOp = mkPrimOpRule nm 2 []
+primOpRules nm FloatNeOp = mkPrimOpRule nm 2 []
+
+primOpRules nm DoubleGtOp = mkPrimOpRule nm 2 []
+primOpRules nm DoubleGeOp = mkPrimOpRule nm 2 []
+primOpRules nm DoubleLeOp = mkPrimOpRule nm 2 []
+primOpRules nm DoubleLtOp = mkPrimOpRule nm 2 []
+primOpRules nm DoubleEqOp = mkPrimOpRule nm 2 []
+primOpRules nm DoubleNeOp = mkPrimOpRule nm 2 []
+
+primOpRules nm WordGtOp = mkPrimOpRule nm 2 []
+primOpRules nm WordGeOp = mkPrimOpRule nm 2 []
+primOpRules nm WordLeOp = mkPrimOpRule nm 2 []
+primOpRules nm WordLtOp = mkPrimOpRule nm 2 []
+primOpRules nm WordEqOp = mkPrimOpRule nm 2 []
+primOpRules nm WordNeOp = mkPrimOpRule nm 2 []
primOpRules nm AddrAddOp = mkPrimOpRule nm 2 [ rightIdentityDynFlags zeroi ]
@@ -118,9 +118,8 @@ data PrimOpInfo
Type
| Monadic OccName -- string :: T -> T
Type
- | Compare OccName -- string :: T -> T -> Bool
+ | Compare OccName -- string :: T -> T -> Int#
Type
-
| GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
[TyVar]
[Type]
@@ -513,10 +512,10 @@ primOpSig op
arity = length arg_tys
(tyvars, arg_tys, res_ty)
= case (primOpInfo op) of
- Monadic _occ ty -> ([], [ty], ty )
- Dyadic _occ ty -> ([], [ty,ty], ty )
- Compare _occ ty -> ([], [ty,ty], boolTy)
- GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty)
+ Monadic _occ ty -> ([], [ty], ty )
+ Dyadic _occ ty -> ([], [ty,ty], ty )
+ Compare _occ ty -> ([], [ty,ty], intPrimTy)
+ GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty )
\end{code}
\begin{code}
@@ -533,7 +532,7 @@ getPrimOpResultInfo op
= case (primOpInfo op) of
Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
Monadic _ ty -> ReturnsPrim (typePrimRep ty)
- Compare _ _ -> ReturnsAlg boolTyCon
+ Compare _ _ -> ReturnsPrim (tyConPrimRep intPrimTyCon)
GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep tc)
| otherwise -> ReturnsAlg tc
where
@@ -560,7 +559,7 @@ Utils:
dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type
dyadic_fun_ty ty = mkFunTys [ty, ty] ty
monadic_fun_ty ty = mkFunTy ty ty
-compare_fun_ty ty = mkFunTys [ty, ty] boolTy
+compare_fun_ty ty = mkFunTys [ty, ty] intPrimTy
\end{code}
Output stuff:
@@ -140,19 +140,19 @@
primtype Char#
-primop CharGtOp "gtChar#" Compare Char# -> Char# -> Bool
-primop CharGeOp "geChar#" Compare Char# -> Char# -> Bool
+primop CharGtOp "gtCharI#" Compare Char# -> Char# -> Int#
+primop CharGeOp "geCharI#" Compare Char# -> Char# -> Int#
-primop CharEqOp "eqChar#" Compare
- Char# -> Char# -> Bool
+primop CharEqOp "eqCharI#" Compare
+ Char# -> Char# -> Int#
with commutable = True
-primop CharNeOp "neChar#" Compare
- Char# -> Char# -> Bool
+primop CharNeOp "neCharI#" Compare
+ Char# -> Char# -> Int#
with commutable = True
-primop CharLtOp "ltChar#" Compare Char# -> Char# -> Bool
-primop CharLeOp "leChar#" Compare Char# -> Char# -> Bool
+primop CharLtOp "ltCharI#" Compare Char# -> Char# -> Int#
+primop CharLeOp "leCharI#" Compare Char# -> Char# -> Int#
primop OrdOp "ord#" GenPrimOp Char# -> Int#
with code_size = 0
@@ -239,26 +239,26 @@
second member is 0 iff no overflow occured.}
with code_size = 2
-primop IntGtOp ">#" Compare Int# -> Int# -> Bool
+primop IntGtOp ">$#" Compare Int# -> Int# -> Int#
with fixity = infix 4
-primop IntGeOp ">=#" Compare Int# -> Int# -> Bool
+primop IntGeOp ">=$#" Compare Int# -> Int# -> Int#
with fixity = infix 4
-primop IntEqOp "==#" Compare
- Int# -> Int# -> Bool
+primop IntEqOp "==$#" Compare
+ Int# -> Int# -> Int#
with commutable = True
fixity = infix 4
-primop IntNeOp "/=#" Compare
- Int# -> Int# -> Bool
+primop IntNeOp "/=$#" Compare
+ Int# -> Int# -> Int#
with commutable = True
fixity = infix 4
-primop IntLtOp "<#" Compare Int# -> Int# -> Bool
+primop IntLtOp "<$#" Compare Int# -> Int# -> Int#
with fixity = infix 4
-primop IntLeOp "<=#" Compare Int# -> Int# -> Bool
+primop IntLeOp "<=$#" Compare Int# -> Int# -> Int#
with fixity = infix 4
primop ChrOp "chr#" GenPrimOp Int# -> Char#
@@ -345,12 +345,12 @@
primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int#
with code_size = 0
-primop WordGtOp "gtWord#" Compare Word# -> Word# -> Bool
-primop WordGeOp "geWord#" Compare Word# -> Word# -> Bool
-primop WordEqOp "eqWord#" Compare Word# -> Word# -> Bool
-primop WordNeOp "neWord#" Compare Word# -> Word# -> Bool
-primop WordLtOp "ltWord#" Compare Word# -> Word# -> Bool
-primop WordLeOp "leWord#" Compare Word# -> Word# -> Bool
+primop WordGtOp "gtWordI#" Compare Word# -> Word# -> Int#
+primop WordGeOp "geWordI#" Compare Word# -> Word# -> Int#
+primop WordEqOp "eqWordI#" Compare Word# -> Word# -> Int#
+primop WordNeOp "neWordI#" Compare Word# -> Word# -> Int#
+primop WordLtOp "ltWordI#" Compare Word# -> Word# -> Int#
+primop WordLeOp "leWordI#" Compare Word# -> Word# -> Int#
primop PopCnt8Op "popCnt8#" Monadic Word# -> Word#
{Count the number of set bits in the lower 8 bits of a word.}
@@ -426,26 +426,26 @@
primtype Double#
-primop DoubleGtOp ">##" Compare Double# -> Double# -> Bool
+primop DoubleGtOp ">$##" Compare Double# -> Double# -> Int#
with fixity = infix 4
-primop DoubleGeOp ">=##" Compare Double# -> Double# -> Bool
+primop DoubleGeOp ">=$##" Compare Double# -> Double# -> Int#
with fixity = infix 4
-primop DoubleEqOp "==##" Compare
- Double# -> Double# -> Bool
+primop DoubleEqOp "==$##" Compare
+ Double# -> Double# -> Int#
with commutable = True
fixity = infix 4
-primop DoubleNeOp "/=##" Compare
- Double# -> Double# -> Bool
+primop DoubleNeOp "/=$##" Compare
+ Double# -> Double# -> Int#
with commutable = True
fixity = infix 4
-primop DoubleLtOp "<##" Compare Double# -> Double# -> Bool
+primop DoubleLtOp "<$##" Compare Double# -> Double# -> Int#
with fixity = infix 4
-primop DoubleLeOp "<=##" Compare Double# -> Double# -> Bool
+primop DoubleLeOp "<=$##" Compare Double# -> Double# -> Int#
with fixity = infix 4
primop DoubleAddOp "+##" Dyadic
@@ -559,19 +559,19 @@
primtype Float#
-primop FloatGtOp "gtFloat#" Compare Float# -> Float# -> Bool
-primop FloatGeOp "geFloat#" Compare Float# -> Float# -> Bool
+primop FloatGtOp "gtFloatI#" Compare Float# -> Float# -> Int#
+primop FloatGeOp "geFloatI#" Compare Float# -> Float# -> Int#
-primop FloatEqOp "eqFloat#" Compare
- Float# -> Float# -> Bool
+primop FloatEqOp "eqFloatI#" Compare
+ Float# -> Float# -> Int#
with commutable = True
-primop FloatNeOp "neFloat#" Compare
- Float# -> Float# -> Bool
+primop FloatNeOp "neFloatI#" Compare
+ Float# -> Float# -> Int#
with commutable = True
-primop FloatLtOp "ltFloat#" Compare Float# -> Float# -> Bool
-primop FloatLeOp "leFloat#" Compare Float# -> Float# -> Bool
+primop FloatLtOp "ltFloatI#" Compare Float# -> Float# -> Int#
+primop FloatLeOp "leFloatI#" Compare Float# -> Float# -> Int#
primop FloatAddOp "plusFloat#" Dyadic
Float# -> Float# -> Float#
@@ -1235,12 +1235,12 @@
with code_size = 0
#endif
-primop AddrGtOp "gtAddr#" Compare Addr# -> Addr# -> Bool
-primop AddrGeOp "geAddr#" Compare Addr# -> Addr# -> Bool
-primop AddrEqOp "eqAddr#" Compare Addr# -> Addr# -> Bool
-primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Bool
-primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Bool
-primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Bool
+primop AddrGtOp "gtAddrI#" Compare Addr# -> Addr# -> Int#
+primop AddrGeOp "geAddrI#" Compare Addr# -> Addr# -> Int#
+primop AddrEqOp "eqAddrI#" Compare Addr# -> Addr# -> Int#
+primop AddrNeOp "neAddrI#" Compare Addr# -> Addr# -> Int#
+primop AddrLtOp "ltAddrI#" Compare Addr# -> Addr# -> Int#
+primop AddrLeOp "leAddrI#" Compare Addr# -> Addr# -> Int#
primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp
Addr# -> Int# -> Char#
@@ -935,7 +935,7 @@ Specifically
* For Show we use TcGenDeriv.box_if_necy to box the Int# into an Int
(which we know how to show)
- * For Eq, Ord, we ust TcGenDeriv.primOrdOps to give Ord operations
+ * For Eq, Ord, we use TcGenDeriv.primOrdOps to give Ord operations
on some primitive types
It's all a bit ad hoc.
Oops, something went wrong.

0 comments on commit b5be2fb

Please sign in to comment.