Commit 5a5552c1 authored by simonpj's avatar simonpj
Browse files

[project @ 2002-07-23 14:57:11 by simonpj]

a)	Correct precedence for application in derived
	Read/Show

  b)	Spaces round '=' in derived Show for records

	*** MERGE TO STABLE BRANCH ***
parent 9c02be64
...@@ -750,7 +750,7 @@ Example ...@@ -750,7 +750,7 @@ Example
instance Read T where instance Read T where
readPrec = readPrec =
block parens
( prec 4 ( ( prec 4 (
do x <- ReadP.step Read.readPrec do x <- ReadP.step Read.readPrec
Symbol "%%" <- Lex.lex Symbol "%%" <- Lex.lex
...@@ -890,6 +890,29 @@ gen_Read_binds get_fixity tycon ...@@ -890,6 +890,29 @@ gen_Read_binds get_fixity tycon
%* * %* *
%************************************************************************ %************************************************************************
Example
infixr 5 :^:
data Tree a = Leaf a | Tree a :^: Tree a
instance (Show a) => Show (Tree a) where
showsPrec d (Leaf m) = showParen (d > app_prec) showStr
where
showStr = showString "Leaf " . showsPrec (app_prec+1) m
showsPrec d (u :^: v) = showParen (d > up_prec) showStr
where
showStr = showsPrec (up_prec+1) u .
showString " :^: " .
showsPrec (up_prec+1) v
-- Note: right-associativity of :^: ignored
up_prec = 5 -- Precedence of :^:
app_prec = 10 -- Application has precedence one more than
-- the most tightly-binding operator
\begin{code} \begin{code}
gen_Show_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds gen_Show_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds
...@@ -909,7 +932,7 @@ gen_Show_binds get_fixity tycon ...@@ -909,7 +932,7 @@ gen_Show_binds get_fixity tycon
([wildPat, con_pat], mk_showString_app con_str) ([wildPat, con_pat], mk_showString_app con_str)
| otherwise = | otherwise =
([a_Pat, con_pat], ([a_Pat, con_pat],
showParen_Expr (HsPar (genOpApp a_Expr ge_RDR (HsLit (HsInt con_prec)))) showParen_Expr (HsPar (genOpApp a_Expr ge_RDR (HsLit (HsInt con_prec_plus_one))))
(HsPar (nested_compose_Expr show_thingies))) (HsPar (nested_compose_Expr show_thingies)))
where where
data_con_RDR = qual_orig_name data_con data_con_RDR = qual_orig_name data_con
...@@ -931,7 +954,11 @@ gen_Show_binds get_fixity tycon ...@@ -931,7 +954,11 @@ gen_Show_binds get_fixity tycon
show_record_args ++ [mk_showString_app "}"] show_record_args ++ [mk_showString_app "}"]
| otherwise = mk_showString_app (con_str ++ " ") : show_prefix_args | otherwise = mk_showString_app (con_str ++ " ") : show_prefix_args
show_label l = mk_showString_app (the_name ++ "=") show_label l = mk_showString_app (the_name ++ " = ")
-- Note the spaces around the "=" sign. If we don't have them
-- then we get Foo { x=-1 } and the "=-" parses as a single
-- lexeme. Only the space after the '=' is necessary, but
-- it seems tidier to have them both sides.
where where
occ_nm = getOccName (fieldLabelName l) occ_nm = getOccName (fieldLabelName l)
nm = occNameUserString occ_nm nm = occNameUserString occ_nm
...@@ -957,9 +984,9 @@ gen_Show_binds get_fixity tycon ...@@ -957,9 +984,9 @@ gen_Show_binds get_fixity tycon
-- Fixity stuff -- Fixity stuff
is_infix = isDataSymOcc dc_occ_nm is_infix = isDataSymOcc dc_occ_nm
con_prec = 1 + getPrec is_infix get_fixity dc_nm con_prec_plus_one = 1 + getPrec is_infix get_fixity dc_nm
arg_prec | record_syntax = 0 -- Record fields don't need parens arg_prec | record_syntax = 0 -- Record fields don't need parens
| otherwise = con_prec | otherwise = con_prec_plus_one
mk_showString_app str = HsApp (HsVar showString_RDR) (HsLit (mkHsString str)) mk_showString_app str = HsApp (HsVar showString_RDR) (HsLit (mkHsString str))
\end{code} \end{code}
...@@ -971,7 +998,9 @@ getPrec is_infix get_fixity nm ...@@ -971,7 +998,9 @@ getPrec is_infix get_fixity nm
| otherwise = getPrecedence get_fixity nm | otherwise = getPrecedence get_fixity nm
appPrecedence :: Integer appPrecedence :: Integer
appPrecedence = fromIntegral maxPrecedence appPrecedence = fromIntegral maxPrecedence + 1
-- One more than the precedence of the most
-- tightly-binding operator
getPrecedence :: FixityEnv -> Name -> Integer getPrecedence :: FixityEnv -> Name -> Integer
getPrecedence get_fixity nm getPrecedence get_fixity nm
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment