[project @ 2001-05-08 10:58:48 by simonmar]

[ghc-hetmet.git] / ghc / compiler / parser / Parser.y

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 7631659..8894a00 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.55 2001/02/26 15:06:59 simonmar Exp $
+$Id: Parser.y,v 1.60 2001/05/07 14:38:15 simonmar Exp $
 
 Haskell grammar.
 
@@ -328,7 +328,11 @@ topdecls :: { [RdrBinding] }
        | 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
@@ -382,8 +386,8 @@ decls       :: { [RdrBinding] }
 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) }
@@ -424,7 +428,7 @@ rules       :: { RdrBinding }
        |  {- 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] }
@@ -684,10 +688,10 @@ infixexp :: { RdrNameHsExpr }
                                                (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 }
@@ -810,10 +814,10 @@ alts1     :: { [RdrNameMatch] }
        | 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] }
@@ -853,7 +857,7 @@ maybe_stmt :: { Maybe RdrNameStmt }
        | {- 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 }