import HsSyn ( InPat(..), HsExpr(..), MonoBinds(..),
Match(..), GRHSs(..), Stmt(..), HsLit(..),
- HsBinds(..), StmtCtxt(..), HsType(..),
+ HsBinds(..), HsType(..), HsMatchContext(..),
unguardedRHS, mkSimpleMatch, mkMonoBind, andMonoBindList
)
import RdrHsSyn ( mkHsOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat )
import RdrName ( RdrName, mkUnqual )
import BasicTypes ( RecFlag(..), Fixity(..), FixityDirection(..)
- , maxPrecedence
+ , maxPrecedence, defaultFixity
, Boxity(..)
)
import FieldLabel ( fieldLabelName )
import TyCon ( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
maybeTyConSingleCon, tyConFamilySize
)
-import Type ( isUnLiftedType, isUnboxedType, Type )
+import Type ( isUnLiftedType, Type )
import TysPrim ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
floatPrimTy, doublePrimTy
)
import Util ( mapAccumL, zipEqual, zipWithEqual,
zipWith3Equal, nOfThem )
import Panic ( panic, assertPanic )
-import Maybes ( maybeToBool )
+import Maybes ( maybeToBool, orElse )
import Constants
import List ( partition, intersperse )
-import Outputable ( pprPanic, ppr, pprTrace )
#if __GLASGOW_HASKELL__ >= 404
import GlaExts ( fromInt )
(==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
\end{verbatim}
- Note: if we're comparing unboxed things, e.g., if \tr{a1} and
+ Note: if we're comparing unlifted things, e.g., if \tr{a1} and
\tr{a2} are \tr{Float#}s, then we have to generate
\begin{verbatim}
case (a1 `eqFloat#` a2) of
}
\end{verbatim}
- Again, we must be careful about unboxed comparisons. For example,
+ Again, we must be careful about unlifted comparisons. For example,
if \tr{a1} and \tr{a2} were \tr{Int#}s in the 2nd example above, we'd need to
generate:
(if maybeToBool (maybeTyConSingleCon tycon) then
-- cmp_eq_Expr ltTag_Expr eqTag_Expr gtTag_Expr a_Expr b_Expr
--- Wierd. Was: case (cmp a b) of { LT -> LT; EQ -> EQ; GT -> GT }
+-- Weird. Was: case (cmp a b) of { LT -> LT; EQ -> EQ; GT -> GT }
cmp_eq_Expr a_Expr b_Expr
else
False
}}}
\end{verbatim}
-(modulo suitable case-ification to handle the unboxed tags)
+(modulo suitable case-ification to handle the unlifted tags)
For a single-constructor type (NB: this includes all tuples), e.g.,
\begin{verbatim}
where
stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
++
- [ReturnStmt con_expr]
+ [ExprStmt con_expr tycon_loc]
mk_qual a b c = BindStmt (VarPatIn c)
(HsApp (HsVar range_RDR)
| is_infix = let (h:t) = field_quals in (h:con_qual:t)
| otherwise = con_qual:field_quals
- stmts = quals ++ [ReturnStmt result_expr]
+ stmts = quals ++ [ExprStmt result_expr tycon_loc]
{-
c.f. Figure 18 in Haskell 1.1 report.
getPrecedence get_fixity nm
= case get_fixity nm of
Just (Fixity x _) -> fromInt x
- other -> pprTrace "TcGenDeriv.getPrecedence" (ppr nm) defaultPrecedence
+ other -> defaultPrecedence
isLRAssoc :: (Name -> Maybe Fixity) -> Name -> (Bool, Bool)
isLRAssoc get_fixity nm =
- case get_fixity nm of
- Just (Fixity _ InfixN) -> (False, False)
- Just (Fixity _ InfixR) -> (False, True)
- Just (Fixity _ InfixL) -> (True, False)
- other -> pprPanic "TcGenDeriv.isLRAssoc" (ppr nm)
+ case get_fixity nm `orElse` defaultFixity of
+ Fixity _ InfixN -> (False, False)
+ Fixity _ InfixR -> (False, True)
+ Fixity _ InfixL -> (True, False)
isInfixOccName :: String -> Bool
isInfixOccName str =
con2tag_Foo :: Foo ... -> Int#
tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int#
-maxtag_Foo :: Int -- ditto (NB: not unboxed)
+maxtag_Foo :: Int -- ditto (NB: not unlifted)
\end{verbatim}
The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
generatedSrcLoc
careful_compare_Case ty lt eq gt a b
- = if not (isUnboxedType ty) then
+ = if not (isUnLiftedType ty) then
compare_gen_Case compare_RDR lt eq gt a b
else -- we have to do something special for primitive things...
eq_Expr :: Type -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
eq_Expr ty a b
- = if not (isUnboxedType ty) then
+ = if not (isUnLiftedType ty) then
genOpApp a eq_RDR b
else -- we have to do something special for primitive things...
genOpApp a relevant_eq_op b