{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.54 2001/02/20 15:36:55 simonpj Exp $
+$Id: Parser.y,v 1.60 2001/05/07 14:38:15 simonmar Exp $
Haskell grammar.
-}
{
-module Parser ( parseModule, parseExpr ) where
+module Parser ( parseModule, parseStmt ) where
import HsSyn
import HsTypes ( mkHsTupCon )
%monad { P } { thenP } { returnP }
%lexer { lexer } { ITeof }
%name parseModule module
-%name parseExpr exp
+%name parseStmt maybe_stmt
%tokentype { Token }
%%
| topdecl { [$1] }
topdecl :: { RdrBinding }
- : srcloc 'type' simpletype '=' sigtype
+ : srcloc 'type' simpletype '=' ctype
+ -- Note ctype, not sigtype.
+ -- We allow an explicit for-all but we don't insert one
+ -- in type Foo a = (b,b)
+ -- Instead we just say b is out of scope
{ RdrHsDecl (TyClD (TySynonym (fst $3) (snd $3) $5 $1)) }
| srcloc 'data' ctype '=' constrs deriving
decl :: { RdrBinding }
: fixdecl { $1 }
| valdef { $1 }
- | '{-# INLINE' srcloc opt_phase qvar '#-}' { RdrSig (InlineSig $4 $3 $2) }
- | '{-# NOINLINE' srcloc opt_phase qvar '#-}' { RdrSig (NoInlineSig $4 $3 $2) }
+ | '{-# INLINE' srcloc opt_phase qvar '#-}' { RdrSig (InlineSig $4 $3 $2) }
+ | '{-# NOINLINE' srcloc opt_phase qvar '#-}' { RdrSig (NoInlineSig $4 $3 $2) }
| '{-# SPECIALISE' srcloc qvar '::' sigtypes '#-}'
{ foldr1 RdrAndBindings
(map (\t -> RdrSig (SpecSig $3 t $2)) $5) }
| {- empty -} { RdrNullBind }
rule :: { RdrBinding }
- : STRING rule_forall fexp '=' srcloc exp
+ : STRING rule_forall infixexp '=' srcloc exp
{ RdrHsDecl (RuleD (HsRule $1 [] $2 $3 $6 $5)) }
rule_forall :: { [RdrNameRuleBndr] }
(panic "fixity") $3 )}
exp10 :: { RdrNameHsExpr }
- : '\\' aexp aexps opt_asig '->' srcloc exp
- {% checkPatterns ($2 : reverse $3) `thenP` \ ps ->
- returnP (HsLam (Match [] ps $4
- (GRHSs (unguardedRHS $7 $6)
+ : '\\' srcloc aexp aexps opt_asig '->' srcloc exp
+ {% checkPatterns $2 ($3 : reverse $4) `thenP` \ ps ->
+ returnP (HsLam (Match [] ps $5
+ (GRHSs (unguardedRHS $8 $7)
EmptyBinds Nothing))) }
| 'let' declbinds 'in' exp { HsLet $2 $4 }
| 'if' srcloc exp 'then' exp 'else' exp { HsIf $3 $5 $7 $2 }
| 'case' srcloc exp 'of' altslist { HsCase $3 $5 $2 }
| '-' fexp { mkHsNegApp $2 }
- | srcloc 'do' stmtlist { HsDo DoStmt $3 $1 }
+ | srcloc 'do' stmtlist { HsDo DoExpr $3 $1 }
| '_ccall_' ccallid aexps0 { HsCCall $2 $3 False False cbot }
| '_ccall_GC_' ccallid aexps0 { HsCCall $2 $3 True False cbot }
body qss = [ParStmt (map reverse qss)] }
in
returnP ( HsDo ListComp
- (reverse (ReturnStmt $1 : body $3))
+ (reverse (ExprStmt $1 $2 : body $3))
$2
)
}
| '|' quals { [$2] }
quals :: { [RdrNameStmt] }
- : quals ',' qual { $3 : $1 }
- | qual { [$1] }
-
-qual :: { RdrNameStmt }
- : srcloc infixexp '<-' exp {% checkPattern $2 `thenP` \p ->
- returnP (BindStmt p $4 $1) }
- | srcloc exp { GuardStmt $2 $1 }
- | srcloc 'let' declbinds { LetStmt $3 }
+ : quals ',' stmt { $3 : $1 }
+ | stmt { [$1] }
-----------------------------------------------------------------------------
-- Case alternatives
| alt { [$1] }
alt :: { RdrNameMatch }
- : infixexp opt_sig ralt wherebinds
- {% (checkPattern $1 `thenP` \p ->
- returnP (Match [] [p] $2
- (GRHSs $3 $4 Nothing)) )}
+ : srcloc infixexp opt_sig ralt wherebinds
+ {% (checkPattern $1 $2 `thenP` \p ->
+ returnP (Match [] [p] $3
+ (GRHSs $4 $5 Nothing)) )}
ralt :: { [RdrNameGRHS] }
: '->' srcloc exp { [GRHS [ExprStmt $3 $2] $2] }
| stmts1 ';' { $1 }
| stmt { [$1] }
+-- for typing stmts at the GHCi prompt, where the input may consist of
+-- just comments.
+maybe_stmt :: { Maybe RdrNameStmt }
+ : stmt { Just $1 }
+ | {- nothing -} { Nothing }
+
stmt :: { RdrNameStmt }
- : srcloc infixexp '<-' exp {% checkPattern $2 `thenP` \p ->
+ : srcloc infixexp '<-' exp {% checkPattern $1 $2 `thenP` \p ->
returnP (BindStmt p $4 $1) }
| srcloc exp { ExprStmt $2 $1 }
| srcloc 'let' declbinds { LetStmt $3 }