mkSrcLoc, mkSrcSpan )
import Module
import StaticFlags ( opt_SccProfilingOn, opt_Hpc )
-import Type ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
+import Type ( Kind, liftedTypeKind, unliftedTypeKind )
+import Coercion ( mkArrowKind )
import Class ( FunDep )
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
- Activation(..), RuleMatchInfo(..), defaultInlineSpec )
+ Activation(..), RuleMatchInfo(..), defaultInlinePragma )
import DynFlags
import OrdList
import HaddockUtils
| stand_alone_deriving { unitOL (LL (DerivD (unLoc $1))) }
| 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
| 'foreign' fdecl { unitOL (LL (unLoc $2)) }
- | '{-# DEPRECATED' deprecations '#-}' { $2 }
- | '{-# WARNING' warnings '#-}' { $2 }
+ | '{-# DEPRECATED' deprecations '#-}' { $2 }
+ | '{-# WARNING' warnings '#-}' { $2 }
| '{-# RULES' rules '#-}' { $2 }
| annotation { unitOL $1 }
| decl { unLoc $1 }
| '[:' ctype ':]' { LL $ HsPArrTy $2 }
| '(' ctype ')' { LL $ HsParTy $2 }
| '(' ctype '::' kind ')' { LL $ HsKindSig $2 (unLoc $4) }
+ | quasiquote { L1 (HsQuasiQuoteTy (unLoc $1)) }
| '$(' exp ')' { LL $ HsSpliceTy (mkHsSplice $2 ) }
| TH_ID_SPLICE { LL $ HsSpliceTy (mkHsSplice
(L1 $ HsVar (mkUnqual varName
(getTH_ID_SPLICE $1)))) } -- $x
+
-- Generics
| INTEGER { L1 (HsNumTy (getINTEGER $1)) }
-----------------------------------------------------------------------------
-- Value definitions
-{- There's an awkward overlap with a type signature. Consider
+{- Note [Declaration/signature overlap]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There's an awkward overlap with a type signature. Consider
f :: Int -> Int = ...rhs...
Then we can't tell whether it's a type signature or a value
definition with a result signature until we see the '='.
: '|' guardquals '=' exp { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
- : infixexp '::' sigtypedoc
- {% do s <- checkValSig $1 $3;
- return (LL $ unitOL (LL $ SigD s)) }
- -- See the above notes for why we need infixexp here
+ : infixexp '::' sigtypedoc {% do s <- checkValSig $1 $3
+ ; return (LL $ unitOL (LL $ SigD s)) }
+ -- See Note [Declaration/signature overlap] for why we need infixexp here
| var ',' sig_vars '::' sigtypedoc
{ LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
| infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
| n <- unLoc $3 ] }
| '{-# INLINE' activation qvar '#-}'
- { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 FunLike (getINLINE $1)))) }
+ { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma $2 FunLike (getINLINE $1)))) }
| '{-# INLINE_CONLIKE' activation qvar '#-}'
- { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 ConLike (getINLINE_CONLIKE $1)))) }
+ { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma $2 ConLike (getINLINE_CONLIKE $1)))) }
| '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
- { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
+ { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlinePragma)
| t <- $4] }
| '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
- { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 FunLike (getSPEC_INLINE $1)))
+ { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlinePragma $2 FunLike (getSPEC_INLINE $1)))
| t <- $5] }
| '{-# SPECIALISE' 'instance' inst_type '#-}'
- { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
+ { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
-----------------------------------------------------------------------------
-- Expressions
+quasiquote :: { Located (HsQuasiQuote RdrName) }
+ : TH_QUASIQUOTE { let { loc = getLoc $1
+ ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
+ ; quoterId = mkUnqual varName quoter }
+ in L1 (mkHsQuasiQuote quoterId quoteSpan quote) }
+
exp :: { LHsExpr RdrName }
: infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
| infixexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
(getTH_ID_SPLICE $1)))) } -- $x
| '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
- | TH_QUASIQUOTE { let { loc = getLoc $1
- ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
- ; quoterId = mkUnqual varName quoter
- }
- in sL loc $ HsQuasiQuoteE (mkHsQuasiQuote quoterId quoteSpan quote) }
+
| TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
| '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
| '[p|' infixexp '|]' {% checkPattern $2 >>= \p ->
return (LL $ HsBracket (PatBr p)) }
- | '[d|' cvtopbody '|]' {% checkDecBrGroup $2 >>= \g ->
- return (LL $ HsBracket (DecBr g)) }
+ | '[d|' cvtopbody '|]' { LL $ HsBracket (DecBrL $2) }
+ | quasiquote { L1 (HsQuasiQuoteE (unLoc $1)) }
-- arrow notation extension
| '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) }
| qopm infixexp { LL $ SectionR $1 $2 }
-- View patterns get parenthesized above
- | exp '->' exp { LL $ EViewPat $1 $3 }
+ | exp '->' texp { LL $ EViewPat $1 $3 }
-- Always at least one comma
tup_exprs :: { [HsTupArg RdrName] }
flattenedpquals :: { Located [LStmt RdrName] }
: pquals { case (unLoc $1) of
- ParStmt [(qs, _)] -> L1 qs
+ [qs] -> L1 qs
-- We just had one thing in our "parallel" list so
-- we simply return that thing directly
- _ -> L1 [$1]
+ qss -> L1 [L1 $ ParStmt [(qs, undefined) | qs <- qss]]
-- We actually found some actual parallel lists so
- -- we leave them into as a ParStmt
+ -- we wrap them into as a ParStmt
}
-pquals :: { LStmt RdrName }
- : pquals1 { L1 (ParStmt [(qs, undefined) | qs <- (reverse (unLoc $1))]) }
-
-pquals1 :: { Located [[LStmt RdrName]] }
- : pquals1 '|' squals { LL (unLoc $3 : unLoc $1) }
- | squals { L (getLoc $1) [unLoc $1] }
-
-squals :: { Located [LStmt RdrName] }
- : squals1 { L (getLoc $1) (reverse (unLoc $1)) }
-
-squals1 :: { Located [LStmt RdrName] }
- : transformquals1 { LL (unLoc $1) }
+pquals :: { Located [[LStmt RdrName]] }
+ : squals '|' pquals { L (getLoc $2) (reverse (unLoc $1) : unLoc $3) }
+ | squals { L (getLoc $1) [reverse (unLoc $1)] }
-transformquals1 :: { Located [LStmt RdrName] }
- : transformquals1 ',' transformqual { LL $ [LL ((unLoc $3) (unLoc $1))] }
- | transformquals1 ',' qual { LL ($3 : unLoc $1) }
--- | transformquals1 ',' '{|' pquals '|}' { LL ($4 : unLoc $1) }
- | transformqual { LL $ [LL ((unLoc $1) [])] }
- | qual { L1 [$1] }
--- | '{|' pquals '|}' { L1 [$2] }
+squals :: { Located [LStmt RdrName] } -- In reverse order, because the last
+ -- one can "grab" the earlier ones
+ : squals ',' transformqual { LL [L (getLoc $3) ((unLoc $3) (reverse (unLoc $1)))] }
+ | squals ',' qual { LL ($3 : unLoc $1) }
+ | transformqual { LL [L (getLoc $1) ((unLoc $1) [])] }
+ | qual { L1 [$1] }
+-- | transformquals1 ',' '{|' pquals '|}' { LL ($4 : unLoc $1) }
+-- | '{|' pquals '|}' { L1 [$2] }
-- It is possible to enable bracketing (associating) qualifier lists by uncommenting the lines with {| |}
-- a program that makes use of this temporary syntax you must supply that flag to GHC
transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) }
- : 'then' exp { LL $ \leftStmts -> (mkTransformStmt (reverse leftStmts) $2) }
+ -- Function is applied to a list of stmts *in order*
+ : 'then' exp { LL $ \leftStmts -> (mkTransformStmt leftStmts $2) }
-- >>>
- | 'then' exp 'by' exp { LL $ \leftStmts -> (mkTransformByStmt (reverse leftStmts) $2 $4) }
- | 'then' 'group' 'by' exp { LL $ \leftStmts -> (mkGroupByStmt (reverse leftStmts) $4) }
+ | 'then' exp 'by' exp { LL $ \leftStmts -> (mkTransformByStmt leftStmts $2 $4) }
+ | 'then' 'group' 'by' exp { LL $ \leftStmts -> (mkGroupByStmt leftStmts $4) }
-- <<<
-- These two productions deliberately have a shift-reduce conflict. I have made 'group' into a special_id,
-- which means you can enable TransformListComp while still using Data.List.group. However, this makes the two
-- This is rather dubious: the user might be confused as to how to parse this statement. However, it is a good
-- practical choice. NB: Data.List.group :: [a] -> [[a]], so using the first production would not even type check
-- if /that/ is the group function we conflict with.
- | 'then' 'group' 'using' exp { LL $ \leftStmts -> (mkGroupUsingStmt (reverse leftStmts) $4) }
- | 'then' 'group' 'by' exp 'using' exp { LL $ \leftStmts -> (mkGroupByUsingStmt (reverse leftStmts) $4 $6) }
+ | 'then' 'group' 'using' exp { LL $ \leftStmts -> (mkGroupUsingStmt leftStmts $4) }
+ | 'then' 'group' 'by' exp 'using' exp { LL $ \leftStmts -> (mkGroupByUsingStmt leftStmts $4 $6) }
-----------------------------------------------------------------------------
-- Parallel array expressions
fileSrcSpan :: P SrcSpan
fileSrcSpan = do
l <- getSrcLoc;
- let loc = mkSrcLoc (srcLocFile l) 1 0;
+ let loc = mkSrcLoc (srcLocFile l) 1 1;
return (mkSrcSpan loc loc)
}
projects / ghc-hetmet.git / blobdiff