+Consider
+ a `op1` b `op2` c
+
+(compareFixity op1 op2) tells which way to arrange appication, or
+whether there's an error.
+
+\begin{code}
+compareFixity :: Fixity -> Fixity
+ -> (Bool, -- Error please
+ Bool) -- Associate to the right: a op1 (b op2 c)
+compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
+ = case prec1 `compare` prec2 of
+ GT -> left
+ LT -> right
+ EQ -> case (dir1, dir2) of
+ (InfixR, InfixR) -> right
+ (InfixL, InfixL) -> left
+ _ -> error_please
+ where
+ right = (False, True)
+ left = (False, False)
+ error_please = (True, False)
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection{Literals}
+%* *
+%************************************************************************
+
+When literals occur we have to make sure that the types and classes they involve
+are made available.
+
+\begin{code}
+litOccurrence (HsChar _)
+ = returnRn (unitFV charTyCon_name)
+
+litOccurrence (HsCharPrim _)
+ = returnRn (unitFV (getName charPrimTyCon))
+
+litOccurrence (HsString _)
+ = returnRn (unitFV listTyCon_name `plusFV` unitFV charTyCon_name)
+
+litOccurrence (HsStringPrim _)
+ = returnRn (unitFV (getName addrPrimTyCon))
+
+litOccurrence (HsInt _)
+ = lookupImplicitOccRn numClass_RDR `thenRn` \ num ->
+ returnRn (unitFV num) -- Int and Integer are forced in by Num
+
+litOccurrence (HsFrac _)
+ = lookupImplicitOccRn fractionalClass_RDR `thenRn` \ frac ->
+ lookupImplicitOccRn ratioDataCon_RDR `thenRn` \ ratio ->
+ returnRn (unitFV frac `plusFV` unitFV ratio)
+ -- We have to make sure that the Ratio type is imported with
+ -- its constructor, because literals of type Ratio t are
+ -- built with that constructor.
+ -- The Rational type is needed too, but that will come in
+ -- when fractionalClass does.
+
+litOccurrence (HsIntPrim _)
+ = returnRn (unitFV (getName intPrimTyCon))
+
+litOccurrence (HsFloatPrim _)
+ = returnRn (unitFV (getName floatPrimTyCon))
+
+litOccurrence (HsDoublePrim _)
+ = returnRn (unitFV (getName doublePrimTyCon))
+
+litOccurrence (HsLitLit _)
+ = lookupImplicitOccRn ccallableClass_RDR `thenRn` \ cc ->
+ returnRn (unitFV cc)
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection{Assertion utils}
+%* *
+%************************************************************************
+
+\begin{code}
+mkAssertExpr :: RnMS (RenamedHsExpr, FreeVars)
+mkAssertExpr =
+ mkImportedGlobalFromRdrName assertErr_RDR `thenRn` \ name ->
+ getSrcLocRn `thenRn` \ sloc ->
+
+ -- if we're ignoring asserts, return (\ _ e -> e)
+ -- if not, return (assertError "src-loc")
+
+ if opt_IgnoreAsserts then
+ getUniqRn `thenRn` \ uniq ->
+ let
+ vname = mkSysLocalName uniq SLIT("v")
+ expr = HsLam ignorePredMatch
+ loc = nameSrcLoc vname
+ ignorePredMatch = Match [] [WildPatIn, VarPatIn vname] Nothing
+ (GRHSs [GRHS [ExprStmt (HsVar vname) loc] loc]
+ EmptyBinds Nothing)
+ in
+ returnRn (expr, unitFV name)
+ else
+ let
+ expr =
+ HsApp (HsVar name)
+ (HsLit (HsString (_PK_ (showSDoc (ppr sloc)))))
+
+ in
+ returnRn (expr, unitFV name)
+
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection{Errors}
+%* *
+%************************************************************************
+