projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Documentation for -fno-code and -fwrite-iface.
[ghc-hetmet.git]
/
ghc
/
compiler
/
typecheck
/
TcGenDeriv.lhs
diff --git
a/ghc/compiler/typecheck/TcGenDeriv.lhs
b/ghc/compiler/typecheck/TcGenDeriv.lhs
index
19c8da8
..
40e091d
100644
(file)
--- a/
ghc/compiler/typecheck/TcGenDeriv.lhs
+++ b/
ghc/compiler/typecheck/TcGenDeriv.lhs
@@
-54,7
+54,6
@@
import TysWiredIn ( charDataCon, intDataCon, floatDataCon, doubleDataCon,
intDataCon_RDR, true_RDR, false_RDR )
import Util ( zipWithEqual, isSingleton,
zipWith3Equal, nOfThem, zipEqual )
intDataCon_RDR, true_RDR, false_RDR )
import Util ( zipWithEqual, isSingleton,
zipWith3Equal, nOfThem, zipEqual )
-import Char ( isAlpha )
import Constants
import List ( partition, intersperse )
import Outputable
import Constants
import List ( partition, intersperse )
import Outputable
@@
-298,8
+297,8
@@
gen_Ord_binds tycon
tycon_loc = getSrcSpan tycon
--------------------------------------------------------------------
tycon_loc = getSrcSpan tycon
--------------------------------------------------------------------
- compare = L tycon_loc (FunBind (L tycon_loc compare_RDR) False compare_matches placeHolderNames)
- compare_matches = mkMatchGroup [mkMatch [a_Pat, b_Pat] compare_rhs cmp_eq_binds]
+ compare = L tycon_loc (mkFunBind (L tycon_loc compare_RDR) compare_matches)
+ compare_matches = [mkMatch [a_Pat, b_Pat] compare_rhs cmp_eq_binds]
cmp_eq_binds = HsValBinds (ValBindsIn (unitBag cmp_eq) [])
compare_rhs
cmp_eq_binds = HsValBinds (ValBindsIn (unitBag cmp_eq) [])
compare_rhs
@@
-776,9
+775,9
@@
gen_Read_binds get_fixity tycon
infix_stmts -- a %% b, or a `T` b
= [read_a1]
infix_stmts -- a %% b, or a `T` b
= [read_a1]
- ++ if isSym con_str
- then [bindLex (symbol_pat con_str)]
- else [read_punc "`", bindLex (ident_pat con_str), read_punc "`"]
+ ++ (if isSym con_str
+ then [bindLex (symbol_pat con_str)]
+ else [read_punc "`", bindLex (ident_pat con_str), read_punc "`"])
++ [read_a2]
lbl_stmts -- T { f1 = a, f2 = b }
++ [read_a2]
lbl_stmts -- T { f1 = a, f2 = b }
@@
-810,7
+809,7
@@
gen_Read_binds get_fixity tycon
ident_pat s = nlConPat ident_RDR [nlLitPat (mkHsString s)] -- Ident "foo"
symbol_pat s = nlConPat symbol_RDR [nlLitPat (mkHsString s)] -- Symbol ">>"
ident_pat s = nlConPat ident_RDR [nlLitPat (mkHsString s)] -- Ident "foo"
symbol_pat s = nlConPat symbol_RDR [nlLitPat (mkHsString s)] -- Symbol ">>"
- data_con_str con = occNameUserString (getOccName con)
+ data_con_str con = occNameString (getOccName con)
read_punc c = bindLex (punc_pat c)
read_arg a ty
read_punc c = bindLex (punc_pat c)
read_arg a ty
@@
-833,7
+832,7
@@
gen_Read_binds get_fixity tycon
| otherwise
= [bindLex (ident_pat lbl_str)]
where
| otherwise
= [bindLex (ident_pat lbl_str)]
where
- lbl_str = occNameUserString (getOccName lbl)
+ lbl_str = occNameString (getOccName lbl)
\end{code}
\end{code}
@@
-900,7
+899,7
@@
gen_Show_binds get_fixity tycon
dc_nm = getName data_con
dc_occ_nm = getOccName data_con
dc_nm = getName data_con
dc_occ_nm = getOccName data_con
- con_str = occNameUserString dc_occ_nm
+ con_str = occNameString dc_occ_nm
op_con_str = wrapOpParens con_str
backquote_str = wrapOpBackquotes con_str
op_con_str = wrapOpParens con_str
backquote_str = wrapOpBackquotes con_str
@@
-917,7
+916,7
@@
gen_Show_binds get_fixity tycon
-- it seems tidier to have them both sides.
where
occ_nm = getOccName l
-- it seems tidier to have them both sides.
where
occ_nm = getOccName l
- nm = wrapOpParens (occNameUserString occ_nm)
+ nm = wrapOpParens (occNameString occ_nm)
show_args = zipWith show_arg bs_needed arg_tys
(show_arg1:show_arg2:_) = show_args
show_args = zipWith show_arg bs_needed arg_tys
(show_arg1:show_arg2:_) = show_args
@@
-1129,7
+1128,7
@@
gen_Data_binds fix_env tycon
constr_args dc =
[ -- nlHsIntLit (toInteger (dataConTag dc)), -- Tag
nlHsVar data_type_name, -- DataType
constr_args dc =
[ -- nlHsIntLit (toInteger (dataConTag dc)), -- Tag
nlHsVar data_type_name, -- DataType
- nlHsLit (mkHsString (occNameUserString dc_occ)), -- String name
+ nlHsLit (mkHsString (occNameString dc_occ)), -- String name
nlList labels, -- Field labels
nlHsVar fixity] -- Fixity
where
nlList labels, -- Field labels
nlHsVar fixity] -- Fixity
where
@@
-1459,7
+1458,7
@@
mk_tc_deriv_name tycon str
= mkDerivedRdrName tc_name mk_occ
where
tc_name = tyConName tycon
= mkDerivedRdrName tc_name mk_occ
where
tc_name = tyConName tycon
- mk_occ tc_occ = mkOccFS varName (mkFastString new_str)
+ mk_occ tc_occ = mkVarOccFS (mkFastString new_str)
where
new_str = str ++ occNameString tc_occ ++ "#"
\end{code}
where
new_str = str ++ occNameString tc_occ ++ "#"
\end{code}