-- ---------------------------------------------------------------------------
{
-module Parser ( parseModule, parseStmt, parseIdentifier, parseIface ) where
+module Parser ( parseModule, parseStmt, parseIdentifier, parseIface, parseType ) where
#define INCLUDE #include
INCLUDE "HsVersions.h"
import OccName ( UserFS, varName, dataName, tcClsName, tvName )
import DataCon ( DataCon, dataConName )
import SrcLoc ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
- SrcSpan, combineLocs, mkGeneralSrcSpan, srcLocFile )
+ SrcSpan, combineLocs, srcLocFile,
+ mkSrcLoc, mkSrcSpan )
import Module
import CmdLineOpts ( opt_SccProfilingOn )
import Type ( Kind, mkArrowKind, liftedTypeKind )
1 for ambiguity in 'if x then y else z :: T' [State 136]
(shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
+4 for ambiguity in 'if x then y else z -< e'
+ (shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
+
8 for ambiguity in 'e :: a `b` c'. Does this mean [States 160,246]
(e::a) `b` c, or
(e :: (a `b` c))
%name parseStmt maybe_stmt
%name parseIdentifier identifier
%name parseIface iface
+%name parseType ctype
%tokentype { Located Token }
%%
: {- empty -} { Nothing }
| '::' atype { Just $2 }
-sigtypes :: { [LHsType RdrName] }
+sigtypes1 :: { [LHsType RdrName] }
: sigtype { [ $1 ] }
- | sigtypes ',' sigtype { $3 : $1 }
+ | sigtype ',' sigtypes1 { $1 : $3 }
sigtype :: { LHsType RdrName }
: ctype { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
: btype {% checkContext $1 }
type :: { LHsType RdrName }
- : ipvar '::' gentype { LL (HsPredTy (LL $ HsIParam (unLoc $1) $3)) }
+ : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
| gentype { $1 }
gentype :: { LHsType RdrName }
inst_type :: { LHsType RdrName }
: ctype {% checkInstType $1 }
+inst_types1 :: { [LHsType RdrName] }
+ : inst_type { [$1] }
+ | inst_type ',' inst_types1 { $1 : $3 }
+
comma_types0 :: { [LHsType RdrName] }
: comma_types1 { $1 }
| {- empty -} { [] }
: '!' { L1 HsStrict }
| '{-# UNPACK' '#-}' '!' { LL HsUnbox }
-deriving :: { Located (Maybe (LHsContext RdrName)) }
- : {- empty -} { noLoc Nothing }
- | 'deriving' context { LL (Just $2) }
+-- We allow the odd-looking 'inst_type' in a deriving clause, so that
+-- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
+-- The 'C [a]' part is converted to an HsPredTy by checkInstType
+-- We don't allow a context, but that's sorted out by the type checker.
+deriving :: { Located (Maybe [LHsType RdrName]) }
+ : {- empty -} { noLoc Nothing }
+ | 'deriving' qtycon {% do { let { L loc tv = $2 }
+ ; p <- checkInstType (L loc (HsTyVar tv))
+ ; return (LL (Just [p])) } }
+ | 'deriving' '(' ')' { LL (Just []) }
+ | 'deriving' '(' inst_types1 ')' { LL (Just $3) }
-- Glasgow extension: allow partial
-- applications in derivings
{ LL $ unitOL (LL $ SigD (InlineSig True $3 $2)) }
| '{-# NOINLINE' inverse_activation qvar '#-}'
{ LL $ unitOL (LL $ SigD (InlineSig False $3 $2)) }
- | '{-# SPECIALISE' qvar '::' sigtypes '#-}'
+ | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
{ LL $ toOL [ LL $ SigD (SpecSig $2 t)
| t <- $4] }
| '{-# SPECIALISE' 'instance' inst_type '#-}'
exp :: { LHsExpr RdrName }
: infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 }
- | fexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
- | fexp '>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
- | fexp '-<<' exp { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
- | fexp '>>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
+ | infixexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
+ | infixexp '>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
+ | infixexp '-<<' exp { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
+ | infixexp '>>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
| infixexp { $1 }
infixexp :: { LHsExpr RdrName }
| '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
| TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
- | TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
+ | TH_VAR_QUOTE gcon { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr (unLoc $2)) }
| '[|' exp '|]' { LL $ HsBracket (ExpBr $2) }
sL :: SrcSpan -> a -> Located a
sL span a = span `seq` L span a
--- Make a source location that is just the filename. This seems slightly
--- neater than trying to construct the span of the text within the file.
+-- Make a source location for the file. We're a bit lazy here and just
+-- make a point SrcSpan at line 1, column 0. Strictly speaking we should
+-- try to find the span of the whole file (ToDo).
fileSrcSpan :: P SrcSpan
-fileSrcSpan = do l <- getSrcLoc; return (mkGeneralSrcSpan (srcLocFile l))
+fileSrcSpan = do
+ l <- getSrcLoc;
+ let loc = mkSrcLoc (srcLocFile l) 1 0;
+ return (mkSrcSpan loc loc)
}