From 9d14163136f08c71a11a62b0ae9516bfe6f326d2 Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 19 Sep 2002 12:31:09 +0000 Subject: [PATCH] [project @ 2002-09-19 12:31:08 by simonmar] Fix records with infix constructors (parser/should_compile/read010). Also tidy up the parser a bit: - clean up the tycon productions - check the current s/r conflicts (29) against reality, and update the comment. --- ghc/compiler/parser/ParseUtil.lhs | 7 +-- ghc/compiler/parser/Parser.y | 85 +++++++++++++++++++------------------ 2 files changed, 47 insertions(+), 45 deletions(-) diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs index c77a990..11fd473 100644 --- a/ghc/compiler/parser/ParseUtil.lhs +++ b/ghc/compiler/parser/ParseUtil.lhs @@ -82,9 +82,10 @@ mkPrefixCon ty tys returnP (data_con, PrefixCon ts) split _ _ = parseError "Illegal data/newtype declaration" -mkRecCon :: [([RdrName],RdrNameBangType)] -> RdrNameConDetails -mkRecCon fields - = RecCon [ (l,t) | (ls,t) <- fields, l <- ls ] +mkRecCon :: RdrName -> [([RdrName],RdrNameBangType)] -> P (RdrName, RdrNameConDetails) +mkRecCon con fields + = tyConToDataCon con `thenP` \ data_con -> + returnP (data_con, RecCon [ (l,t) | (ls,t) <- fields, l <- ls ]) tyConToDataCon :: RdrName -> P RdrName tyConToDataCon tc diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 3a0b3ac..6daeba9 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- -*-haskell-*- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.102 2002/09/13 15:02:37 simonpj Exp $ +$Id: Parser.y,v 1.103 2002/09/19 12:31:09 simonmar Exp $ Haskell grammar. @@ -48,18 +48,33 @@ import Outputable {- ----------------------------------------------------------------------------- -Conflicts: 21 shift/reduce, -=chak[4Feb2] +Conflicts: 29 shift/reduce, [SDM 19/9/2002] -11 for abiguity in 'if x then y else z + 1' [State 128] +10 for abiguity in 'if x then y else z + 1' [State 136] (shift parses as 'if x then y else (z + 1)', as per longest-parse rule) - 8 because op might be: - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM + 10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM -1 for ambiguity in '{-# RULES "name" [ ... #-} [State 210] +1 for ambiguity in 'if x then y else z with ?x=3' [State 136] + (shift parses as 'if x then y else (z with ?x=3)' + +1 for ambiguity in 'if x then y else z :: T' [State 136] + (shift parses as 'if x then y else (z :: T)', as per longest-parse rule) + +8 for ambiguity in 'e :: a `b` c'. Does this mean [States 160,246] + (e::a) `b` c, or + (e :: (a `b` c)) + +1 for ambiguity in 'let ?x ...' [State 268] + the parser can't tell whether the ?x is the lhs of a normal binding or + an implicit binding. Fortunately resolving as shift gives it the only + sensible meaning, namely the lhs of an implicit binding. + +1 for ambiguity in '{-# RULES "name" [ ... #-} [State 332] we don't know whether the '[' starts the activation or not: it might be the start of the declaration with the activation being empty. --SDM 1/4/2002 -1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 412] +1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 394] since 'forall' is a valid variable name, we don't know whether to treat a forall on the input as the beginning of a quantifier or the beginning of the rule itself. Resolving to shift means @@ -67,28 +82,9 @@ Conflicts: 21 shift/reduce, -=chak[4Feb2] This saves explicitly defining a grammar for the rule lhs that doesn't include 'forall'. -1 for ambiguity in 'let ?x ...' [State 278] - the parser can't tell whether the ?x is the lhs of a normal binding or - an implicit binding. Fortunately resolving as shift gives it the only - sensible meaning, namely the lhs of an implicit binding. - - -8 for ambiguity in 'e :: a `b` c'. Does this mean [States 238,267] - (e::a) `b` c, or - (e :: (a `b` c)) - -6 for conflicts between `fdecl' and `fdeclDEPRECATED', [States 402,403] - which are resolved correctly, and moreover, - should go away when `fdeclDEPRECATED' is removed. - -1 for ambiguity in 'if x then y else z :: T' - (shift parses as 'if x then y else (z :: T)', as per longest-parse rule) -1 for ambiguity in 'if x then y else z with ?x=3' - (shift parses as 'if x then y else (z with ?x=3)' -3 for ambiguity in 'case x of y :: a -> b' - (don't know whether to reduce 'a' as a btype or shift the '->'. - conclusion: bogus expression anyway, doesn't matter) - +6 for conflicts between `fdecl' and `fdeclDEPRECATED', [States 384,385] + which are resolved correctly, and moreover, + should go away when `fdeclDEPRECATED' is removed. ----------------------------------------------------------------------------- -} @@ -907,8 +903,8 @@ forall :: { [RdrNameHsTyVar] } constr_stuff :: { (RdrName, RdrNameConDetails) } : btype {% mkPrefixCon $1 [] } | btype '!' atype satypes {% mkPrefixCon $1 (BangType MarkedUserStrict $3 : $4) } - | conid '{' '}' { ($1, RecCon []) } - | conid '{' fielddecls '}' { ($1, mkRecCon $3) } + | oqtycon '{' '}' {% mkRecCon $1 [] } + | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 } | sbtype conop sbtype { ($2, InfixCon $1 $3) } satypes :: { [RdrNameBangType] } @@ -1317,24 +1313,29 @@ gtycon :: { RdrName } -- A "general" qualified tycon oqtycon :: { RdrName } -- An "ordinary" qualified tycon : qtycon { $1 } - | '(' qtyconop ')' { $2 } - -qtycon :: { RdrName } -- Qualified or unqualified - : QCONID { mkQual tcClsName $1 } - | tycon { $1 } + | '(' qtyconsym ')' { $2 } qtyconop :: { RdrName } -- Qualified or unqualified - : QCONSYM { mkQual tcClsName $1 } - | '`' QCONID '`' { mkQual tcClsName $2 } - | tyconop { $1 } + : qtyconsym { $1 } + | '`' qtycon '`' { $2 } + +tyconop :: { RdrName } -- Unqualified + : tyconsym { $1 } + | '`' tycon '`' { $2 } + +qtycon :: { RdrName } -- Qualified or unqualified + : QCONID { mkQual tcClsName $1 } + | tycon { $1 } tycon :: { RdrName } -- Unqualified - : CONID { mkUnqual tcClsName $1 } + : CONID { mkUnqual tcClsName $1 } -tyconop :: { RdrName } -- Unqualified - : CONSYM { mkUnqual tcClsName $1 } - | '`' tycon '`' { $2 } +qtyconsym :: { RdrName } + : QCONSYM { mkQual tcClsName $1 } + | tyconsym { $1 } +tyconsym :: { RdrName } + : CONSYM { mkUnqual tcClsName $1 } ----------------------------------------------------------------------------- -- Any operator -- 1.7.10.4