-- ---------------------------------------------------------------------------
{
-{-# OPTIONS -Wwarn -w -XNoMonomorphismRestriction #-}
--- The NoMonomorphismRestriction deals with a Happy infelicity
--- With OutsideIn's more conservativ monomorphism restriction
--- we aren't generalising
--- notHappyAtAll = error "urk"
--- which is terrible. Switching off the restriction allows
--- the generalisation. Better would be to make Happy generate
--- an appropriate signature.
-
+{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
+{-# OPTIONS -Wwarn -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
'dynamic' { L _ ITdynamic }
'safe' { L _ ITsafe }
'threadsafe' { L _ ITthreadsafe } -- ToDo: remove deprecated alias
+ 'interruptible' { L _ ITinterruptible }
'unsafe' { L _ ITunsafe }
'mdo' { L _ ITmdo }
'family' { L _ ITfamily }
'{-# WARNING' { L _ ITwarning_prag }
'{-# UNPACK' { L _ ITunpack_prag }
'{-# ANN' { L _ ITann_prag }
+ '{-# VECTORISE' { L _ ITvect_prag }
+ '{-# VECTORISE_SCALAR' { L _ ITvect_scalar_prag }
'#-}' { L _ ITclose_prag }
'..' { L _ ITdotdot } -- reserved symbols
| '{-# DEPRECATED' deprecations '#-}' { $2 }
| '{-# WARNING' warnings '#-}' { $2 }
| '{-# RULES' rules '#-}' { $2 }
+ | '{-# VECTORISE_SCALAR' qvar '#-}' { unitOL $ LL $ VectD (HsVect $2 Nothing) }
+ | '{-# VECTORISE' qvar '=' exp '#-}' { unitOL $ LL $ VectD (HsVect $2 (Just $4)) }
| annotation { unitOL $1 }
| decl { unLoc $1 }
safety :: { Safety }
: 'unsafe' { PlayRisky }
| 'safe' { PlaySafe False }
+ | 'interruptible' { PlayInterruptible }
| 'threadsafe' { PlaySafe True } -- deprecated alias
fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
| docsection { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
decl :: { Located (OrdList (LHsDecl RdrName)) }
- : sigdecl { $1 }
- | '!' aexp rhs {% do { pat <- checkPattern $2;
- return (LL $ unitOL $ LL $ ValD (
- PatBind (LL $ BangPat pat) (unLoc $3)
- placeHolderType placeHolderNames)) } }
- | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3;
- let { l = comb2 $1 $> };
- return $! (sL l (unitOL $! (sL l $ ValD r))) } }
- | docdecl { LL $ unitOL $1 }
+ : sigdecl { $1 }
+
+ | '!' aexp rhs {% do { let { e = LL (SectionR (LL (HsVar bang_RDR)) $2) };
+ pat <- checkPattern e;
+ return $ LL $ unitOL $ LL $ ValD $
+ PatBind pat (unLoc $3)
+ placeHolderType placeHolderNames } }
+ -- Turn it all into an expression so that
+ -- checkPattern can check that bangs are enabled
+
+ | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3;
+ let { l = comb2 $1 $> };
+ return $! (sL l (unitOL $! (sL l $ ValD r))) } }
+ | docdecl { LL $ unitOL $1 }
rhs :: { Located (GRHSs RdrName) }
: '=' exp wherebinds { sL (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
| 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 }
| 'if' exp optSemi 'then' exp optSemi 'else' exp
{% checkDoAndIfThenElse $2 $3 $5 $6 $8 >>
- return (LL $ HsIf $2 $5 $8) }
+ return (LL $ mkHsIf $2 $5 $8) }
| 'case' exp 'of' altslist { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
| '-' fexp { LL $ NegApp $2 noSyntaxExpr }
return (L loc (mkHsDo DoExpr stmts body)) }
| 'mdo' stmtlist {% let loc = comb2 $1 $2 in
checkDo loc (unLoc $2) >>= \ (stmts,body) ->
- return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
+ return (L loc (mkHsDo MDoExpr
+ [L loc (mkRecStmt stmts)]
+ body)) }
| scc_annot exp { LL $ if opt_SccProfilingOn
then HsSCC (unLoc $1) $2
else HsPar $2 }
| RATIONAL { sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) placeHolderType) }
-- N.B.: sections get parsed by these next two productions.
- -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't correct Haskell98
- -- (you'd have to write '((+ 3), (4 -))')
+ -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
+ -- correct Haskell (you'd have to write '((+ 3), (4 -))')
-- but the less cluttered version fell out of having texps.
| '(' texp ')' { LL (HsPar $2) }
| '(' tup_exprs ')' { LL (ExplicitTuple $2 Boxed) }
-- Note [Parsing sections]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- We include left and right sections here, which isn't
- -- technically right according to Haskell 98. For example
- -- (3 +, True) isn't legal
+ -- technically right according to the Haskell standard.
+ -- For example (3 +, True) isn't legal.
-- However, we want to parse bang patterns like
-- (!x, !y)
-- and it's convenient to do so here as a section
| special_id { L1 $! mkUnqual tvName (unLoc $1) }
| 'unsafe' { L1 $! mkUnqual tvName (fsLit "unsafe") }
| 'safe' { L1 $! mkUnqual tvName (fsLit "safe") }
+ | 'interruptible' { L1 $! mkUnqual tvName (fsLit "interruptible") }
| 'threadsafe' { L1 $! mkUnqual tvName (fsLit "threadsafe") }
tyvarsym :: { Located RdrName }
| special_id { L1 $! mkUnqual varName (unLoc $1) }
| 'unsafe' { L1 $! mkUnqual varName (fsLit "unsafe") }
| 'safe' { L1 $! mkUnqual varName (fsLit "safe") }
+ | 'interruptible' { L1 $! mkUnqual varName (fsLit "interruptible") }
| 'threadsafe' { L1 $! mkUnqual varName (fsLit "threadsafe") }
| 'forall' { L1 $! mkUnqual varName (fsLit "forall") }
| 'family' { L1 $! mkUnqual varName (fsLit "family") }
-- These special_ids are treated as keywords in various places,
-- but as ordinary ids elsewhere. 'special_id' collects all these
--- except 'unsafe', 'forall', and 'family' whose treatment differs
+-- except 'unsafe', 'interruptible', 'forall', and 'family' whose treatment differs
-- depending on context
special_id :: { Located FastString }
special_id