Commit 6579a6c7 authored by Jan Stolarek's avatar Jan Stolarek

Comparison primops return Int# (Fixes #6135)

This patch modifies all comparison primops for Char#, Int#, Word#, Double#,
Float# and Addr# to return Int# instead of Bool. A value of 1# represents True
and 0# represents False. For a more detailed description of motivation for this
change, discussion of implementation details and benchmarking results please
visit the wiki page: http://hackage.haskell.org/trac/ghc/wiki/PrimBool

There's also some cleanup: whitespace fixes in files that were extensively edited
in this patch and constant folding rules for Integer div and mod operators (which
for some reason have been left out up till now).
parent 33327379
......@@ -141,9 +141,9 @@ cgLetNoEscapeRhsBody local_cc bndr (StgRhsClosure cc _bi _ _upd _ args body)
= cgLetNoEscapeClosure bndr local_cc cc (nonVoidIds args) body
cgLetNoEscapeRhsBody local_cc bndr (StgRhsCon cc con args)
= cgLetNoEscapeClosure bndr local_cc cc [] (StgConApp con args)
-- For a constructor RHS we want to generate a single chunk of
-- code which can be jumped to from many places, which will
-- return the constructor. It's easy; just behave as if it
-- For a constructor RHS we want to generate a single chunk of
-- code which can be jumped to from many places, which will
-- return the constructor. It's easy; just behave as if it
-- was an StgRhsClosure with a ConApp inside!
-------------------------
......@@ -193,9 +193,9 @@ heapcheck will take their worst case into account.
In favour of omitting !Q!, !R!:
- *May* save a heap overflow test,
if ...P... allocates anything.
if ...P... allocates anything.
- We can use relative addressing from a single Hp to
- We can use relative addressing from a single Hp to
get at all the closures so allocated.
- No need to save volatile vars etc across heap checks
......@@ -203,7 +203,7 @@ In favour of omitting !Q!, !R!:
Against omitting !Q!, !R!
- May put a heap-check into the inner loop. Suppose
- May put a heap-check into the inner loop. Suppose
the main loop is P -> R -> P -> R...
Q is the loop exit, and only it does allocation.
This only hurts us if P does no allocation. If P allocates,
......@@ -212,7 +212,7 @@ Against omitting !Q!, !R!
- May do more allocation than reqd. This sometimes bites us
badly. For example, nfib (ha!) allocates about 30\% more space if the
worst-casing is done, because many many calls to nfib are leaf calls
which don't need to allocate anything.
which don't need to allocate anything.
We can un-allocate, but that costs an instruction
......@@ -248,7 +248,7 @@ Hence: two basic plans for
...save current cost centre...
...code for e,
...code for e,
with sequel (SetLocals r)
...restore current cost centre...
......@@ -338,8 +338,12 @@ So we add a special case to generate
and later optimisations will further improve this.
We should really change all these primops to return Int# instead, that
would make this special case go away.
Now that #6135 has been resolved it should be possible to remove that
special case. The idea behind this special case and pre-6135 implementation
of Bool-returning primops was that tagToEnum# was added implicitly in the
codegen and then optimized away. Now the call to tagToEnum# is explicit
in the source code, which allows to optimize it away at the earlier stages
of compilation (i.e. at the Core level).
-}
......@@ -498,7 +502,7 @@ cgAlts gc_plan bndr (PrimAlt _) alts
-- PrimAlts always have a DEFAULT case
-- and it always comes first
tagged_cmms' = [(lit,code)
tagged_cmms' = [(lit,code)
| (LitAlt lit, code) <- tagged_cmms]
; emitCmmLitSwitch (CmmReg bndr_reg) tagged_cmms' deflt
; return AssignedDirectly }
......@@ -637,7 +641,7 @@ cgLneJump blk_id lne_regs args -- Join point; discard sequel
; emitMultiAssign lne_regs cmm_args
; emit (mkBranch blk_id)
; return AssignedDirectly }
cgTailCall :: Id -> CgIdInfo -> [StgArg] -> FCode ReturnKind
cgTailCall fun_id fun_info args = do
dflags <- getDynFlags
......@@ -645,7 +649,7 @@ cgTailCall fun_id fun_info args = do
-- A value in WHNF, so we can just return it.
ReturnIt -> emitReturn [fun] -- ToDo: does ReturnIt guarantee tagged?
EnterIt -> ASSERT( null args ) -- Discarding arguments
emitEnter fun
......@@ -653,7 +657,7 @@ cgTailCall fun_id fun_info args = do
{ tickySlowCall lf_info args
; emitComment $ mkFastString "slowCall"
; slowCall fun args }
-- A direct function call (possibly with some left-over arguments)
DirectEntry lbl arity -> do
{ tickyDirectCall arity args
......
......@@ -107,15 +107,6 @@ cgOpApp (StgPrimOp primop) args res_ty
cgPrimOp regs primop args
emitReturn (map (CmmReg . CmmLocal) regs)
| ReturnsAlg tycon <- result_info
, isEnumerationTyCon tycon
-- c.f. cgExpr (...TagToEnumOp...)
= do dflags <- getDynFlags
tag_reg <- newTemp (bWord dflags)
cgPrimOp [tag_reg] primop args
emitReturn [tagToClosure dflags tycon
(CmmReg (CmmLocal tag_reg))]
| otherwise = panic "cgPrimop"
where
result_info = getPrimOpResultInfo primop
......
This diff is collapsed.
This diff is collapsed.
......@@ -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 @@ section "Char#"
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 @@ primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #)
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 SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
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.}
......@@ -435,26 +435,26 @@ section "Double#"
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
......@@ -568,19 +568,19 @@ section "Float#"
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#
......@@ -698,7 +698,7 @@ primop NewArrayOp "newArray#" GenPrimOp
has_side_effects = True
primop SameMutableArrayOp "sameMutableArray#" GenPrimOp
MutableArray# s a -> MutableArray# s a -> Bool
MutableArray# s a -> MutableArray# s a -> Int#
primop ReadArrayOp "readArray#" GenPrimOp
MutableArray# s a -> Int# -> State# s -> (# State# s, a #)
......@@ -837,7 +837,7 @@ primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp
{Intended for use with pinned arrays; otherwise very unsafe!}
primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
MutableByteArray# s -> MutableByteArray# s -> Bool
MutableByteArray# s -> MutableByteArray# s -> Int#
primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
......@@ -1133,7 +1133,7 @@ primop NewArrayArrayOp "newArrayArray#" GenPrimOp
has_side_effects = True
primop SameMutableArrayArrayOp "sameMutableArrayArray#" GenPrimOp
MutableArrayArray# s -> MutableArrayArray# s -> Bool
MutableArrayArray# s -> MutableArrayArray# s -> Int#
primop UnsafeFreezeArrayArrayOp "unsafeFreezeArrayArray#" GenPrimOp
MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #)
......@@ -1244,12 +1244,12 @@ primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr#
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#
......@@ -1510,7 +1510,7 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp
can_fail = True
primop SameMutVarOp "sameMutVar#" GenPrimOp
MutVar# s a -> MutVar# s a -> Bool
MutVar# s a -> MutVar# s a -> Int#
-- not really the right type, but we don't know about pairs here. The
-- correct type is
......@@ -1689,7 +1689,7 @@ primop WriteTVarOp "writeTVar#" GenPrimOp
has_side_effects = True
primop SameTVarOp "sameTVar#" GenPrimOp
TVar# s a -> TVar# s a -> Bool
TVar# s a -> TVar# s a -> Int#
------------------------------------------------------------------------
......@@ -1759,7 +1759,7 @@ primop TryReadMVarOp "tryReadMVar#" GenPrimOp
has_side_effects = True
primop SameMVarOp "sameMVar#" GenPrimOp
MVar# s a -> MVar# s a -> Bool
MVar# s a -> MVar# s a -> Int#
primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp
MVar# s a -> State# s -> (# State# s, Int# #)
......
......@@ -404,7 +404,7 @@ renameDeriv is_boot inst_infos bagBinds
| otherwise
= discardWarnings $ -- Discard warnings about unused bindings etc
setXOptM Opt_EmptyCase $ -- Derived decls (for empty types) can have
setXOptM Opt_EmptyCase $ -- Derived decls (for empty types) can have
-- case x of {}
do {
-- Bring the extra deriving stuff into scope
......@@ -764,7 +764,7 @@ if there are any overlaps.
There are two other things that might go wrong with the lookup.
First, we might see a standalone deriving clause
deriving Eq (F ())
when there is no data instance F () in scope.
when there is no data instance F () in scope.
Note that it's OK to have
data instance F [a] = ...
......@@ -796,7 +796,7 @@ When type familes are involved it's trickier:
instance Monad [] => Monad (T Int) -- only if we can eta reduce???
-- d1 :: Monad []
-- d2 :: Monad (T Int) = d1 |> Monad (sym (:Co:RT ; :coF:RT))
-- d2 :: Monad (T Int) = d1 |> Monad (sym (:Co:RT ; :coF:RT))
Note the need for the eta-reduced rule axioms. After all, we can
write it out
......@@ -912,7 +912,7 @@ mkPolyKindedTypeableEqn orig tvs cls _cls_tys tycon tc_args mtheta
, ds_tc = tycon, ds_tc_args = tc_args
, ds_theta = mtheta `orElse` [] -- Context is empty for polykinded Typeable
, ds_newtype = False }) }
where
where
is_kind_var tc_arg = case tcGetTyVar_maybe tc_arg of
Just v -> isKindVar v
Nothing -> False
......@@ -1002,16 +1002,10 @@ ghc-prim does not use Functor or Typeable implicitly via these lookups.
Note [Deriving and unboxed types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We have some special hacks to support things like
data T = MkT Int# deriving( Ord, Show )
Specifically
* For Show we use TcGenDeriv.box_if_necy to box the Int# into an Int
(which we know how to show)
data T = MkT Int# deriving ( Show )
* For Eq, Ord, we ust TcGenDeriv.primOrdOps to give Ord operations
on some primitive types
It's all a bit ad hoc.
Specifically, we use TcGenDeriv.box_if_necy to box the Int# into an Int
(which we know how to show). It's a bit ad hoc.
\begin{code}
......@@ -1610,7 +1604,7 @@ extendLocalInstEnv dfuns thing_inside
***********************************************************************************
* *
* *
* Simplify derived constraints
* *
***********************************************************************************
......@@ -1618,16 +1612,16 @@ extendLocalInstEnv dfuns thing_inside
\begin{code}
simplifyDeriv :: CtOrigin
-> PredType
-> [TyVar]
-> [TyVar]
-> ThetaType -- Wanted
-> TcM ThetaType -- Needed
-- Given instance (wanted) => C inst_ty
-- Given instance (wanted) => C inst_ty
-- Simplify 'wanted' as much as possibles
-- Fail if not possible
simplifyDeriv orig pred tvs theta
simplifyDeriv orig pred tvs theta
= do { (skol_subst, tvs_skols) <- tcInstSkolTyVars tvs -- Skolemize
-- The constraint solving machinery
-- expects *TcTyVars* not TyVars.
-- The constraint solving machinery
-- expects *TcTyVars* not TyVars.
-- We use *non-overlappable* (vanilla) skolems
-- See Note [Overlap and deriving]
......@@ -1637,7 +1631,7 @@ simplifyDeriv orig pred tvs theta
; wanted <- newFlatWanteds orig (substTheta skol_subst theta)
; traceTc "simplifyDeriv" $
; traceTc "simplifyDeriv" $
vcat [ pprTvBndrs tvs $$ ppr theta $$ ppr wanted, doc ]
; (residual_wanted, _ev_binds1)
<- solveWantedsTcM (mkFlatWC wanted)
......@@ -1646,8 +1640,8 @@ simplifyDeriv orig pred tvs theta
; let (good, bad) = partitionBagWith get_good (wc_flat residual_wanted)
-- See Note [Exotic derived instance contexts]
get_good :: Ct -> Either PredType Ct
get_good ct | validDerivPred skol_set p
, isWantedCt ct = Left p
get_good ct | validDerivPred skol_set p
, isWantedCt ct = Left p
-- NB: residual_wanted may contain unsolved
-- Derived and we stick them into the bad set
-- so that reportUnsolved may decide what to do with them
......@@ -1684,7 +1678,7 @@ and we want to infer
f :: Show [a] => a -> String
BOTTOM LINE: use vanilla, non-overlappable skolems when inferring
the context for the derived instance.
the context for the derived instance.
Hence tcInstSkolTyVars not tcInstSuperSkolTyVars
Note [Exotic derived instance contexts]
......@@ -1699,13 +1693,13 @@ One could go further: consider
data T a b c = MkT (Foo a b c) deriving( Eq )
instance (C Int a, Eq b, Eq c) => Eq (Foo a b c)
Notice that this instance (just) satisfies the Paterson termination
Notice that this instance (just) satisfies the Paterson termination
conditions. Then we *could* derive an instance decl like this:
instance (C Int a, Eq b, Eq c) => Eq (T a b c)
instance (C Int a, Eq b, Eq c) => Eq (T a b c)
even though there is no instance for (C Int a), because there just
*might* be an instance for, say, (C Int Bool) at a site where we
need the equality instance for T's.
need the equality instance for T's.
However, this seems pretty exotic, and it's quite tricky to allow
this, and yet give sensible error messages in the (much more common)
......
This diff is collapsed.
......@@ -108,6 +108,22 @@
</para>
</listitem>
<listitem>
<para>
PrimOps for comparing unboxed values now return
<literal>Int#</literal> instead of <literal>Bool</literal>.
New PrimOps' names end with <literal>$#</literal> for operators and
<literal>I#</literal> for ordinary names, e.g. <literal>==$#</literal>
compares <literal>Int#</literal>s for equality and
<literal>eqCharI#</literal> does the same for <literal>Char#</literal>s.
Old PrimOps have been removed and turned into wrappers. If your
code relied on removed PrimOps then importing
<literal>GHC.PrimWrappers</literal> will make it work again (no
need to add anything if your code already imports
<literal>GHC.Exts</literal>).
</para>
</listitem>
<listitem>
<para>
TODO: mention dynamic changes
......
primitive @ c6b1e204
Subproject commit 75c3379b6d76e914cc3c7ffd290b6b1cad7ea3e6
Subproject commit c6b1e204f0f2a1a0d6cb1df35fa60762b2fe3cdc
......@@ -138,8 +138,6 @@ gen_hs_source (Info defaults entries) =
++ unlines (map (("\t" ++) . hdr) entries)
++ ") where\n"
++ "\n"
++ "import GHC.Types\n"
++ "\n"
++ "{-\n"
++ unlines (map opt defaults)
++ "-}\n"
......@@ -507,7 +505,6 @@ gen_wrappers (Info _ entries)
-- don't need the Prelude here so we add NoImplicitPrelude.
++ "module GHC.PrimopWrappers where\n"
++ "import qualified GHC.Prim\n"
++ "import GHC.Types (Bool)\n"
++ "import GHC.Tuple ()\n"
++ "import GHC.Prim (" ++ concat (intersperse ", " othertycons) ++ ")\n"
++ "#if defined (__GLASGOW_HASKELL_LLVM__)\n"
......
......@@ -114,7 +114,7 @@ sanityPrimOp def_names p
sane_ty :: Category -> Ty -> Bool
sane_ty Compare (TyF t1 (TyF t2 td))
| t1 == t2 && td == TyApp "Bool" [] = True
| t1 == t2 && td == TyApp "Int#" [] = True
sane_ty Monadic (TyF t1 td)
| t1 == td = True
sane_ty Dyadic (TyF t1 (TyF t2 td))
......
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