)
import RdrHsSyn ( mkOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat )
import RdrName ( RdrName, mkSrcUnqual )
)
import RdrHsSyn ( mkOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat )
import RdrName ( RdrName, mkSrcUnqual )
import BasicTypes ( RecFlag(..), Fixity(..), FixityDirection(..)
, maxPrecedence, defaultFixity
import BasicTypes ( RecFlag(..), Fixity(..), FixityDirection(..)
, maxPrecedence, defaultFixity
)
import FieldLabel ( fieldLabelName )
import DataCon ( isNullaryDataCon, dataConTag,
)
import FieldLabel ( fieldLabelName )
import DataCon ( isNullaryDataCon, dataConTag,
untag_Expr tycon [(a_RDR, ah_RDR)] $
untag_Expr tycon [(b_RDR, bh_RDR)] $
HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
untag_Expr tycon [(a_RDR, ah_RDR)] $
untag_Expr tycon [(b_RDR, bh_RDR)] $
HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
d_Pat] [] (
HsIf (HsPar (mk_easy_App inRange_RDR [c_RDR, d_RDR])) (
untag_Expr tycon [(a_RDR, ah_RDR)] (
d_Pat] [] (
HsIf (HsPar (mk_easy_App inRange_RDR [c_RDR, d_RDR])) (
untag_Expr tycon [(a_RDR, ah_RDR)] (
untag_Expr tycon [(a_RDR, ah_RDR)] (
untag_Expr tycon [(b_RDR, bh_RDR)] (
untag_Expr tycon [(c_RDR, ch_RDR)] (
untag_Expr tycon [(a_RDR, ah_RDR)] (
untag_Expr tycon [(b_RDR, bh_RDR)] (
untag_Expr tycon [(c_RDR, ch_RDR)] (
--------------------------------------------------------------
single_con_range
= mk_easy_FunMonoBind tycon_loc range_RDR
--------------------------------------------------------------
single_con_range
= mk_easy_FunMonoBind tycon_loc range_RDR
HsDo ListComp stmts tycon_loc
where
stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
HsDo ListComp stmts tycon_loc
where
stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
con_pat cs_needed] [range_size] (
foldl mk_index (HsLit (HsInt 0)) (zip3 as_needed bs_needed cs_needed))
where
mk_index multiply_by (l, u, i)
= genOpApp (
(HsApp (HsApp (HsVar index_RDR)
con_pat cs_needed] [range_size] (
foldl mk_index (HsLit (HsInt 0)) (zip3 as_needed bs_needed cs_needed))
where
mk_index multiply_by (l, u, i)
= genOpApp (
(HsApp (HsApp (HsVar index_RDR)
con_pat cs_needed]
[] (
foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed))
where
in_range a b c = HsApp (HsApp (HsVar inRange_RDR)
con_pat cs_needed]
[] (
foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed))
where
in_range a b c = HsApp (HsApp (HsVar inRange_RDR)
(HsApp (HsApp (HsVar readsPrec_RDR) (HsLit (HsInt p))) draw_from)
tycon_loc
result_expr = ExplicitTuple [con_expr, if null bs_needed
then d_Expr
(HsApp (HsApp (HsVar readsPrec_RDR) (HsLit (HsInt p))) draw_from)
tycon_loc
result_expr = ExplicitTuple [con_expr, if null bs_needed
then d_Expr
-getLRPrecs :: Bool -> Fixities -> Name -> [Integer]
-getLRPrecs is_infix fixs_assoc nm = [lp, rp]
+getLRPrecs :: Bool -> FixityEnv -> Name -> [Integer]
+getLRPrecs is_infix fixity_env nm = [lp, rp]
where
{-
Figuring out the fixities of the arguments to a constructor,
cf. Figures 16-18 in Haskell 1.1 report.
-}
where
{-
Figuring out the fixities of the arguments to a constructor,
cf. Figures 16-18 in Haskell 1.1 report.
-}
- (con_left_assoc, con_right_assoc) = isLRAssoc fixs_assoc nm
- paren_con_prec = getFixity fixs_assoc nm
+ (con_left_assoc, con_right_assoc) = isLRAssoc fixity_env nm
+ paren_con_prec = getFixity fixity_env nm
-getFixity :: Fixities -> Name -> Integer
-getFixity fixs_assoc nm =
- case lookupFixity fixs_assoc nm of
- Fixity x _ -> fromInt x
+getFixity :: FixityEnv -> Name -> Integer
+getFixity fixity_env nm = case lookupFixity fixity_env nm of
+ Fixity x _ -> fromInt x
isLRAssoc fixs_assoc nm =
case lookupFixity fixs_assoc nm of
Fixity _ InfixN -> (False, False)
Fixity _ InfixR -> (False, True)
Fixity _ InfixL -> (True, False)
isLRAssoc fixs_assoc nm =
case lookupFixity fixs_assoc nm of
Fixity _ InfixN -> (False, False)
Fixity _ InfixR -> (False, True)
Fixity _ InfixL -> (True, False)
= mk_FunMonoBind (getSrcLoc tycon) rdr_name
[([ConPatIn mkInt_RDR [VarPatIn a_RDR]],
ExprWithTySig (HsApp tagToEnum_Expr a_Expr)
= mk_FunMonoBind (getSrcLoc tycon) rdr_name
[([ConPatIn mkInt_RDR [VarPatIn a_RDR]],
ExprWithTySig (HsApp tagToEnum_Expr a_Expr)
gen_tag_n_con_monobind (rdr_name, tycon, GenMaxTag)
= mk_easy_FunMonoBind (getSrcLoc tycon)
gen_tag_n_con_monobind (rdr_name, tycon, GenMaxTag)
= mk_easy_FunMonoBind (getSrcLoc tycon)