PRIMCHAR { L _ (ITprimchar _) }
PRIMSTRING { L _ (ITprimstring _) }
PRIMINTEGER { L _ (ITprimint _) }
+ PRIMWORD { L _ (ITprimword _) }
PRIMFLOAT { L _ (ITprimfloat _) }
PRIMDOUBLE { L _ (ITprimdouble _) }
Nothing)) }
maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
- : moduleheader { (fst $1, snd $1) }
+ : moduleheader { $1 }
| {- empty -} { (emptyHaddockModInfo, Nothing) }
missing_module_keyword :: { () }
| data_or_newtype tycl_hdr constrs deriving
{% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
; checkTyVars tparms -- no type pattern
- ; return $
- L (comb4 $1 $2 $3 $4)
+ ; return $!
+ sL (comb4 $1 $2 $3 $4)
-- We need the location on tycl_hdr in case
-- constrs and deriving are both empty
(mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
deriving
{% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
; checkTyVars tparms -- can have type pats
- ; return $
- L (comb4 $1 $2 $4 $5)
+ ; return $!
+ sL (comb4 $1 $2 $4 $5)
(mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
(unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
scc_annot :: { Located FastString }
: '_scc_' STRING {% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
- (return $ LL $ getSTRING $2) }
- | '{-# SCC' STRING '#-}' { LL $ getSTRING $2 }
+ ( do scc <- getSCC $2; return $ LL scc ) }
+ | '{-# SCC' STRING '#-}' {% do scc <- getSCC $2; return $ LL scc }
hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
: '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
: CHAR { L1 $ HsChar $ getCHAR $1 }
| STRING { L1 $ HsString $ getSTRING $1 }
| PRIMINTEGER { L1 $ HsIntPrim $ getPRIMINTEGER $1 }
+ | PRIMWORD { L1 $ HsWordPrim $ getPRIMWORD $1 }
| PRIMCHAR { L1 $ HsCharPrim $ getPRIMCHAR $1 }
| PRIMSTRING { L1 $ HsStringPrim $ getPRIMSTRING $1 }
| PRIMFLOAT { L1 $ HsFloatPrim $ getPRIMFLOAT $1 }
getPRIMCHAR (L _ (ITprimchar x)) = x
getPRIMSTRING (L _ (ITprimstring x)) = x
getPRIMINTEGER (L _ (ITprimint x)) = x
+getPRIMWORD (L _ (ITprimword x)) = x
getPRIMFLOAT (L _ (ITprimfloat x)) = x
getPRIMDOUBLE (L _ (ITprimdouble x)) = x
getTH_ID_SPLICE (L _ (ITidEscape x)) = x
getDOCNAMED (L _ (ITdocCommentNamed x)) = x
getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
+getSCC :: Located Token -> P FastString
+getSCC lt = do let s = getSTRING lt
+ err = "Spaces are not allowed in SCCs"
+ -- We probably actually want to be more restrictive than this
+ if ' ' `elem` unpackFS s
+ then failSpanMsgP (getLoc lt) (text err)
+ else return s
+
-- Utilities for combining source spans
comb2 :: Located a -> Located b -> SrcSpan
comb2 a b = a `seq` b `seq` combineLocs a b