diff options
Diffstat (limited to 'compiler/parser/Parser.y')
| -rw-r--r-- | compiler/parser/Parser.y | 41 |
1 files changed, 33 insertions, 8 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index fea9203811..cd10a29703 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1682,6 +1682,8 @@ atype :: { LHsType RdrName } [mo $1,mc $2] } | '(#' comma_types1 '#)' {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple $2) [mo $1,mc $3] } + | '(#' bar_types2 '#)' {% ams (sLL $1 $> $ HsSumTy $2) + [mo $1,mc $3] } | '[' ctype ']' {% ams (sLL $1 $> $ HsListTy $2) [mos $1,mcs $3] } | '[:' ctype ':]' {% ams (sLL $1 $> $ HsPArrTy $2) [mo $1,mc $3] } | '(' ctype ')' {% ams (sLL $1 $> $ HsParTy $2) [mop $1,mcp $3] } @@ -1741,6 +1743,12 @@ comma_types1 :: { [LHsType RdrName] } -- One or more: ty,ty,ty | ctype ',' comma_types1 {% addAnnotation (gl $1) AnnComma (gl $2) >> return ($1 : $3) } +bar_types2 :: { [LHsType RdrName] } -- Two or more: ty|ty|ty + : ctype '|' ctype {% addAnnotation (gl $1) AnnVbar (gl $2) + >> return [$1,$3] } + | ctype '|' bar_types2 {% addAnnotation (gl $1) AnnVbar (gl $2) + >> return ($1 : $3) } + tv_bndrs :: { [LHsTyVarBndr RdrName] } : tv_bndr tv_bndrs { $1 : $2 } | {- empty -} { [] } @@ -2289,14 +2297,14 @@ aexp2 :: { LHsExpr RdrName } -- correct Haskell (you'd have to write '((+ 3), (4 -))') -- but the less cluttered version fell out of having texps. | '(' texp ')' {% ams (sLL $1 $> (HsPar $2)) [mop $1,mcp $3] } - | '(' tup_exprs ')' {% ams (sLL $1 $> (ExplicitTuple $2 Boxed)) - [mop $1,mcp $3] } + | '(' tup_exprs ')' {% do { e <- mkSumOrTuple Boxed (comb2 $1 $3) $2 + ; ams (sLL $1 $> e) [mop $1,mcp $3] } } | '(#' texp '#)' {% ams (sLL $1 $> (ExplicitTuple [L (gl $2) (Present $2)] Unboxed)) [mo $1,mc $3] } - | '(#' tup_exprs '#)' {% ams (sLL $1 $> (ExplicitTuple $2 Unboxed)) - [mo $1,mc $3] } + | '(#' tup_exprs '#)' {% do { e <- mkSumOrTuple Unboxed (comb2 $1 $3) $2 + ; ams (sLL $1 $> e) [mo $1,mc $3] } } | '[' list ']' {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) } | '[:' parr ':]' {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) } @@ -2384,16 +2392,25 @@ texp :: { LHsExpr RdrName } -- View patterns get parenthesized above | exp '->' texp {% ams (sLL $1 $> $ EViewPat $1 $3) [mu AnnRarrow $2] } --- Always at least one comma -tup_exprs :: { [LHsTupArg RdrName] } +-- Always at least one comma or bar. +tup_exprs :: { SumOrTuple } : texp commas_tup_tail {% do { addAnnotation (gl $1) AnnComma (fst $2) - ; return ((sL1 $1 (Present $1)) : snd $2) } } + ; return (Tuple ((sL1 $1 (Present $1)) : snd $2)) } } + + | texp bars + {% do { mapM_ (\ll -> addAnnotation ll AnnVbar ll) (fst $2) + ; return (Sum 1 (snd $2 + 1) $1) } } | commas tup_tail {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1) ; return - (map (\l -> L l missingTupArg) (fst $1) ++ $2) } } + (Tuple (map (\l -> L l missingTupArg) (fst $1) ++ $2)) } } + + | bars texp bars0 + {% do { mapM_ (\ll -> addAnnotation ll AnnVbar ll) (fst $1) + ; mapM_ (\ll -> addAnnotation ll AnnVbar ll) (fst $3) + ; return (Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2) } } -- Always starts with commas; always follows an expr commas_tup_tail :: { (SrcSpan,[LHsTupArg RdrName]) } @@ -3121,6 +3138,14 @@ commas :: { ([SrcSpan],Int) } -- One or more commas : commas ',' { ((fst $1)++[gl $2],snd $1 + 1) } | ',' { ([gl $1],1) } +bars0 :: { ([SrcSpan],Int) } -- Zero or more bars + : bars { $1 } + | { ([], 0) } + +bars :: { ([SrcSpan],Int) } -- One or more bars + : bars '|' { ((fst $1)++[gl $2],snd $1 + 1) } + | '|' { ([gl $1],1) } + ----------------------------------------------------------------------------- -- Documentation comments |