From 381b1a6243eba79b27e089a0ad677d82c8955165 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 4 May 2006 11:18:04 +0000
Subject: [PATCH] Fix precedence for records in derived Read

The derived instance for Read of records wasn't quite right.
Consider
	data T = T1 T | T2 { x::Int }

The string "T1 T2 { x=2 }" should parse correctly as
	T1 (T2 {x=2})
because of Haskell's odd precedence rules (record construction binds
even more tightly than application), but the derived Read didn't take
account of that.

drvrun020 is the regression test
---
 compiler/typecheck/TcGenDeriv.lhs |   18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 40e091d..d7dc977 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -692,7 +692,7 @@ Example
   infix 4 %%
   data T = Int %% Int
  	 | T1 { f1 :: Int }
-	 | T2 Int
+	 | T2 T
 
 
 instance Read T where
@@ -704,7 +704,9 @@ instance Read T where
            y           <- ReadP.step Read.readPrec
            return (x %% y))
       +++
-      prec appPrec (
+      prec (appPrec+1) (
+	-- Note the "+1" part; "T2 T1 {f1=3}" should parse ok
+	-- Record construction binds even more tightly than application
 	do Ident "T1" <- Lex.lex
 	   Punc '{' <- Lex.lex
 	   Ident "f1" <- Lex.lex
@@ -762,9 +764,9 @@ gen_Read_binds get_fixity tycon
     read_non_nullary_con data_con
       = nlHsApps prec_RDR [nlHsIntLit prec, nlHsDo DoExpr stmts body]
       where
-       	stmts | is_infix 	  = infix_stmts
-     	      | length labels > 0 = lbl_stmts
-     	      | otherwise	  = prefix_stmts
+       	stmts | is_infix  = infix_stmts
+     	      | is_record = lbl_stmts
+     	      | otherwise = prefix_stmts
      
 	body = result_expr data_con as_needed
 	con_str = data_con_str data_con
@@ -792,10 +794,14 @@ gen_Read_binds get_fixity tycon
        	labels       = dataConFieldLabels data_con
        	dc_nm	     = getName data_con
        	is_infix     = dataConIsInfix data_con
+	is_record    = length labels > 0
        	as_needed    = take con_arity as_RDRs
 	read_args    = zipWithEqual "gen_Read_binds" read_arg as_needed (dataConOrigArgTys data_con)
        	(read_a1:read_a2:_) = read_args
-       	prec 	     = getPrec is_infix get_fixity dc_nm
+       	prec | is_infix  = getPrecedence get_fixity dc_nm
+	     | is_record = appPrecedence + 1	-- Record construction binds even more tightly
+						-- than application; e.g. T2 T1 {x=2} means T2 (T1 {x=2})
+	     | otherwise = appPrecedence
 
     ------------------------------------------------------------------------
     --		Helpers
-- 
1.7.10.4