) where
IMP_Ubiq()
+IMPORT_1_3(List(partition))
import HsSyn ( HsBinds(..), Bind(..), MonoBinds(..), Match(..), GRHSsAndBinds(..),
- GRHS(..), HsExpr(..), HsLit(..), InPat(..), Qual(..), Stmt,
+ GRHS(..), HsExpr(..), HsLit(..), InPat(..), Qualifier(..), Stmt,
ArithSeqInfo, Sig, PolyType, FixityDecl, Fake )
-import RdrHsSyn ( RdrNameMonoBinds(..), RdrNameHsExpr(..), RdrNamePat(..) )
+import RdrHsSyn ( SYN_IE(RdrNameMonoBinds), SYN_IE(RdrNameHsExpr), SYN_IE(RdrNamePat) )
import RnHsSyn ( RenamedFixityDecl(..) )
--import RnUtils
-import Id ( GenId, dataConArity, isNullaryDataCon, dataConTag,
+import Id ( GenId, dataConNumFields, isNullaryDataCon, dataConTag,
dataConRawArgTys, fIRST_TAG,
- isDataCon, DataCon(..), ConTag(..) )
+ isDataCon, SYN_IE(DataCon), SYN_IE(ConTag) )
import IdUtils ( primOpId )
import Maybes ( maybeToBool )
-import Name ( moduleNamePair, origName, RdrName(..) )
-import PrelMods ( fromPrelude, pRELUDE, pRELUDE_BUILTIN, pRELUDE_LIST, pRELUDE_TEXT )
+import Name ( origName, preludeQual, nameOf, RdrName(..), OrigName(..) )
+import PrelMods ( pRELUDE, gHC__, iX )
import PrelVals ( eRROR_ID )
import PrimOp ( PrimOp(..) )
con1_pat = ConPatIn data_con_PN (map VarPatIn as_needed)
con2_pat = ConPatIn data_con_PN (map VarPatIn bs_needed)
- data_con_PN = origName data_con
- con_arity = dataConArity data_con
+ data_con_PN = qual_orig_name data_con
+ con_arity = length tys_needed
as_needed = take con_arity as_PNs
bs_needed = take con_arity bs_PNs
tys_needed = dataConRawArgTys data_con
= foldr1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs)
where
nested_eq ty a b = HsPar (eq_Expr ty (HsVar a) (HsVar b))
-{-OLD:
- nested_eq_expr [] [] [] = true_Expr
- nested_eq_expr [ty] [a] [b] =
- nested_eq_expr (t:ts) (a:as) (b:bs)
- = let
- rest_expr = nested_eq_expr ts as bs
- in
- and_Expr (eq_Expr t (HsVar a) (HsVar b)) rest_expr
--}
boring_ne_method
= mk_easy_FunMonoBind ne_PN [a_Pat, b_Pat] [] $
(cmp_tags_Expr ltH_Int_PN ah_PN bh_PN ltTag_Expr gtTag_Expr)))
(nullary_cons, nonnullary_cons)
- = partition (\ con -> dataConArity con == 0) (tyConDataCons tycon)
+ = partition isNullaryDataCon (tyConDataCons tycon)
cmp_eq
= mk_FunMonoBind cmp_eq_PN (map pats_etc nonnullary_cons ++ deflt_pats_etc)
con1_pat = ConPatIn data_con_PN (map VarPatIn as_needed)
con2_pat = ConPatIn data_con_PN (map VarPatIn bs_needed)
- data_con_PN = origName data_con
- con_arity = dataConArity data_con
+ data_con_PN = qual_orig_name data_con
+ con_arity = length tys_needed
as_needed = take con_arity as_PNs
bs_needed = take con_arity bs_PNs
tys_needed = dataConRawArgTys data_con
data_con_1 = head data_cons
data_con_N = last data_cons
- data_con_1_PN = origName data_con_1
- data_con_N_PN = origName data_con_N
+ data_con_1_PN = qual_orig_name data_con_1
+ data_con_N_PN = qual_orig_name data_con_N
----- single-constructor-flavored: -------------
- arity = dataConArity data_con_1
+ arity = dataConNumFields data_con_1
min_bound_1con = mk_easy_FunMonoBind minBound_PN [] [] $
mk_easy_App data_con_1_PN (nOfThem arity minBound_PN)
then enum_ixes
else single_con_ixes
where
- tycon_str = _UNPK_ (snd (moduleNamePair tycon))
+ tycon_str = _UNPK_ (nameOf (origName "gen_Ix_binds" tycon))
--------------------------------------------------------------
enum_ixes = enum_range `AndMonoBinds`
else
dc
- con_arity = dataConArity data_con
- data_con_PN = origName data_con
+ con_arity = dataConNumFields data_con
+ data_con_PN = qual_orig_name data_con
con_pat xs = ConPatIn data_con_PN (map VarPatIn xs)
con_expr xs = mk_easy_App data_con_PN xs
where
-----------------------------------------------------------------------
read_list = mk_easy_FunMonoBind readList_PN [] []
- (HsApp (HsVar _readList_PN) (HsPar (HsApp (HsVar readsPrec_PN) (HsLit (HsInt 0)))))
+ (HsApp (HsVar readList___PN) (HsPar (HsApp (HsVar readsPrec_PN) (HsLit (HsInt 0)))))
-----------------------------------------------------------------------
reads_prec
= let
where
read_con data_con -- note: "b" is the string being "read"
= let
- data_con_PN = origName data_con
- data_con_str= snd (moduleNamePair data_con)
- con_arity = dataConArity data_con
+ data_con_PN = qual_orig_name data_con
+ data_con_str= nameOf (origName "gen_Read_binds" data_con)
+ con_arity = dataConNumFields data_con
as_needed = take con_arity as_PNs
bs_needed = take con_arity bs_PNs
con_expr = mk_easy_App data_con_PN as_needed
where
-----------------------------------------------------------------------
show_list = mk_easy_FunMonoBind showList_PN [] []
- (HsApp (HsVar _showList_PN) (HsPar (HsApp (HsVar showsPrec_PN) (HsLit (HsInt 0)))))
+ (HsApp (HsVar showList___PN) (HsPar (HsApp (HsVar showsPrec_PN) (HsLit (HsInt 0)))))
-----------------------------------------------------------------------
shows_prec
= mk_FunMonoBind showsPrec_PN (map pats_etc (tyConDataCons tycon))
where
pats_etc data_con
= let
- data_con_PN = origName data_con
- con_arity = dataConArity data_con
+ data_con_PN = qual_orig_name data_con
+ con_arity = dataConNumFields data_con
bs_needed = take con_arity bs_PNs
con_pat = ConPatIn data_con_PN (map VarPatIn bs_needed)
nullary_con = isNullaryDataCon data_con
show_con
- = let (mod, nm) = moduleNamePair data_con
+ = let (OrigName mod nm) = origName "gen_Show_binds" data_con
space_maybe = if nullary_con then _NIL_ else SLIT(" ")
in
HsApp (HsVar showString_PN) (HsLit (HsString (nm _APPEND_ space_maybe)))
= ASSERT(isDataCon var)
([pat], HsLit (HsIntPrim (toInteger ((dataConTag var) - fIRST_TAG))))
where
- pat = ConPatIn var_PN (nOfThem (dataConArity var) WildPatIn)
- var_PN = origName var
+ pat = ConPatIn var_PN (nOfThem (dataConNumFields var) WildPatIn)
+ var_PN = qual_orig_name var
gen_tag_n_con_monobind (pn, tycon, GenTag2Con)
= mk_FunMonoBind pn (map mk_stuff (tyConDataCons tycon))
([lit_pat], HsVar var_PN)
where
lit_pat = ConPatIn mkInt_PN [LitPatIn (HsIntPrim (toInteger ((dataConTag var) - fIRST_TAG)))]
- var_PN = origName var
+ var_PN = qual_orig_name var
gen_tag_n_con_monobind (pn, tycon, GenMaxTag)
= mk_easy_FunMonoBind pn [] [] (HsApp (HsVar mkInt_PN) (HsLit (HsIntPrim max_tag)))
\end{code}
\begin{code}
+qual_orig_name n = case (origName "qual_orig_name" n) of { OrigName m n -> Qual m n }
+
a_PN = Unqual SLIT("a")
b_PN = Unqual SLIT("b")
c_PN = Unqual SLIT("c")
ch_PN = Unqual SLIT("c#")
dh_PN = Unqual SLIT("d#")
cmp_eq_PN = Unqual SLIT("cmp_eq")
-rangeSize_PN = Unqual SLIT("rangeSize")
+rangeSize_PN = Qual iX SLIT("rangeSize")
as_PNs = [ Unqual (_PK_ ("a"++show i)) | i <- [(1::Int) .. ] ]
bs_PNs = [ Unqual (_PK_ ("b"++show i)) | i <- [(1::Int) .. ] ]
cs_PNs = [ Unqual (_PK_ ("c"++show i)) | i <- [(1::Int) .. ] ]
-eq_PN = prelude_method SLIT("Eq") SLIT("==")
-ne_PN = prelude_method SLIT("Eq") SLIT("/=")
-le_PN = prelude_method SLIT("Ord") SLIT("<=")
-lt_PN = prelude_method SLIT("Ord") SLIT("<")
-ge_PN = prelude_method SLIT("Ord") SLIT(">=")
-gt_PN = prelude_method SLIT("Ord") SLIT(">")
-max_PN = prelude_method SLIT("Ord") SLIT("max")
-min_PN = prelude_method SLIT("Ord") SLIT("min")
-compare_PN = prelude_method SLIT("Ord") SLIT("compare")
-minBound_PN = prelude_method SLIT("Bounded") SLIT("minBound")
-maxBound_PN = prelude_method SLIT("Bounded") SLIT("maxBound")
-ltTag_PN = Unqual SLIT("LT")
-eqTag_PN = Unqual SLIT("EQ")
-gtTag_PN = Unqual SLIT("GT")
-enumFrom_PN = prelude_method SLIT("Enum") SLIT("enumFrom")
-enumFromTo_PN = prelude_method SLIT("Enum") SLIT("enumFromTo")
-enumFromThen_PN = prelude_method SLIT("Enum") SLIT("enumFromThen")
-enumFromThenTo_PN= prelude_method SLIT("Enum") SLIT("enumFromThenTo")
-range_PN = prelude_method SLIT("Ix") SLIT("range")
-index_PN = prelude_method SLIT("Ix") SLIT("index")
-inRange_PN = prelude_method SLIT("Ix") SLIT("inRange")
-readsPrec_PN = prelude_method SLIT("Read") SLIT("readsPrec")
-readList_PN = prelude_method SLIT("Read") SLIT("readList")
-showsPrec_PN = prelude_method SLIT("Show") SLIT("showsPrec")
-showList_PN = prelude_method SLIT("Show") SLIT("showList")
-plus_PN = prelude_method SLIT("Num") SLIT("+")
-times_PN = prelude_method SLIT("Num") SLIT("*")
-
-false_PN = prelude_val pRELUDE SLIT("False")
-true_PN = prelude_val pRELUDE SLIT("True")
+eq_PN = preludeQual {-SLIT("Eq")-} SLIT("==")
+ne_PN = preludeQual {-SLIT("Eq")-} SLIT("/=")
+le_PN = preludeQual {-SLIT("Ord")-} SLIT("<=")
+lt_PN = preludeQual {-SLIT("Ord")-} SLIT("<")
+ge_PN = preludeQual {-SLIT("Ord")-} SLIT(">=")
+gt_PN = preludeQual {-SLIT("Ord")-} SLIT(">")
+max_PN = preludeQual {-SLIT("Ord")-} SLIT("max")
+min_PN = preludeQual {-SLIT("Ord")-} SLIT("min")
+compare_PN = preludeQual {-SLIT("Ord")-} SLIT("compare")
+minBound_PN = preludeQual {-SLIT("Bounded")-} SLIT("minBound")
+maxBound_PN = preludeQual {-SLIT("Bounded")-} SLIT("maxBound")
+enumFrom_PN = preludeQual {-SLIT("Enum")-} SLIT("enumFrom")
+enumFromTo_PN = preludeQual {-SLIT("Enum")-} SLIT("enumFromTo")
+enumFromThen_PN = preludeQual {-SLIT("Enum")-} SLIT("enumFromThen")
+enumFromThenTo_PN= preludeQual {-SLIT("Enum")-} SLIT("enumFromThenTo")
+range_PN = Qual iX SLIT("range")
+index_PN = Qual iX SLIT("index")
+inRange_PN = Qual iX SLIT("inRange")
+readsPrec_PN = preludeQual {-SLIT("Read")-} SLIT("readsPrec")
+readList_PN = preludeQual {-SLIT("Read")-} SLIT("readList")
+showsPrec_PN = preludeQual {-SLIT("Show")-} SLIT("showsPrec")
+showList_PN = preludeQual {-SLIT("Show")-} SLIT("showList")
+plus_PN = preludeQual {-SLIT("Num")-} SLIT("+")
+times_PN = preludeQual {-SLIT("Num")-} SLIT("*")
+ltTag_PN = preludeQual SLIT("LT")
+eqTag_PN = preludeQual SLIT("EQ")
+gtTag_PN = preludeQual SLIT("GT")
+
eqH_Char_PN = prelude_primop CharEqOp
ltH_Char_PN = prelude_primop CharLtOp
eqH_Word_PN = prelude_primop WordEqOp
geH_PN = prelude_primop IntGeOp
leH_PN = prelude_primop IntLeOp
minusH_PN = prelude_primop IntSubOp
-and_PN = prelude_val pRELUDE SLIT("&&")
-not_PN = prelude_val pRELUDE SLIT("not")
-append_PN = prelude_val pRELUDE_LIST SLIT("++")
-map_PN = prelude_val pRELUDE_LIST SLIT("map")
-compose_PN = prelude_val pRELUDE SLIT(".")
-mkInt_PN = prelude_val pRELUDE_BUILTIN SLIT("I#")
-error_PN = prelude_val pRELUDE SLIT("error")
-showString_PN = prelude_val pRELUDE_TEXT SLIT("showString")
-showParen_PN = prelude_val pRELUDE_TEXT SLIT("showParen")
-readParen_PN = prelude_val pRELUDE_TEXT SLIT("readParen")
-lex_PN = prelude_val pRELUDE_TEXT SLIT("lex")
-showSpace_PN = prelude_val pRELUDE_TEXT SLIT("__showSpace")
-_showList_PN = prelude_val pRELUDE SLIT("__showList")
-_readList_PN = prelude_val pRELUDE SLIT("__readList")
-
-prelude_val m s = Unqual s
-prelude_method c o = Unqual o
-prelude_primop o = origName (primOpId o)
+
+prelude_primop o = case (origName "prelude_primop" (primOpId o)) of { OrigName m n -> Qual m n }
+
+false_PN = preludeQual SLIT("False")
+true_PN = preludeQual SLIT("True")
+and_PN = preludeQual SLIT("&&")
+not_PN = preludeQual SLIT("not")
+append_PN = preludeQual SLIT("++")
+map_PN = preludeQual SLIT("map")
+compose_PN = preludeQual SLIT(".")
+mkInt_PN = preludeQual SLIT("I#")
+error_PN = preludeQual SLIT("error")
+showString_PN = preludeQual SLIT("showString")
+showParen_PN = preludeQual SLIT("showParen")
+readParen_PN = preludeQual SLIT("readParen")
+lex_PN = Qual gHC__ SLIT("lex")
+showSpace_PN = Qual gHC__ SLIT("showSpace")
+showList___PN = Qual gHC__ SLIT("showList__")
+readList___PN = Qual gHC__ SLIT("readList__")
a_Expr = HsVar a_PN
b_Expr = HsVar b_PN
con2tag_PN, tag2con_PN, maxtag_PN :: TyCon -> RdrName
con2tag_PN tycon
- = let (mod, nm) = moduleNamePair tycon
+ = let (OrigName mod nm) = origName "con2tag_PN" tycon
con2tag = SLIT("con2tag_") _APPEND_ nm _APPEND_ SLIT("#")
in
- (if fromPrelude mod then Unqual else Qual mod) con2tag
+ Qual mod con2tag
tag2con_PN tycon
- = let (mod, nm) = moduleNamePair tycon
+ = let (OrigName mod nm) = origName "tag2con_PN" tycon
tag2con = SLIT("tag2con_") _APPEND_ nm _APPEND_ SLIT("#")
in
- (if fromPrelude mod then Unqual else Qual mod) tag2con
+ Qual mod tag2con
maxtag_PN tycon
- = let (mod, nm) = moduleNamePair tycon
+ = let (OrigName mod nm) = origName "maxtag_PN" tycon
maxtag = SLIT("maxtag_") _APPEND_ nm _APPEND_ SLIT("#")
in
- (if fromPrelude mod then Unqual else Qual mod) maxtag
+ Qual mod maxtag
\end{code}
projects / ghc-hetmet.git / blobdiff