\begin{code}
data Token
- = ITcase -- Haskell keywords
+ = ITas -- Haskell keywords
+ | ITcase
| ITclass
| ITdata
| ITdefault
| ITderiving
| ITdo
| ITelse
+ | IThiding
| ITif
| ITimport
| ITin
| ITmodule
| ITnewtype
| ITof
+ | ITqualified
| ITthen
| ITtype
| ITwhere
haskellKeywordsFM = listToUFM $
map (\ (x,y) -> (_PK_ x,y))
[( "_", ITunderscore ),
+ ( "as", ITas ),
( "case", ITcase ),
( "class", ITclass ),
( "data", ITdata ),
( "deriving", ITderiving ),
( "do", ITdo ),
( "else", ITelse ),
+ ( "hiding", IThiding ),
( "if", ITif ),
( "import", ITimport ),
( "in", ITin ),
( "module", ITmodule ),
( "newtype", ITnewtype ),
( "of", ITof ),
+ ( "qualified", ITqualified ),
( "then", ITthen ),
( "type", ITtype ),
( "where", ITwhere ),
,("!", ITbang)
,(".", ITdot) -- sadly, for 'forall a . t'
]
-
-not_special_op ITminus = False
-not_special_op ITbang = False
-not_special_op _ = True
\end{code}
-----------------------------------------------------------------------------
-- real lexeme is M.<sym>
new_buf = mergeLexemes buf buf'
in
- case lookupUFM haskellKeySymsFM lexeme of {
- Just kwd_token | not_special_op kwd_token
- -> just_a_conid; -- avoid M.::, but not M.!
- other -> cont (mk_qvar_token mod lexeme) new_buf
- }}
+ cont (mk_qvar_token mod lexeme) new_buf
+ -- wrong, but arguably morally right: M... is now a qvarsym
+ }
| otherwise =
let
case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM lexeme of {
Just kwd_token -> just_a_conid; -- avoid M.where etc.
Nothing -> is_a_qvarid
+ -- TODO: special ids (as, qualified, hiding) shouldn't be
+ -- recognised as keywords here. ie. M.as is a qualified varid.
}}}
, mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp
, groupBindings
- , checkAs
- , checkHiding
- , checkQualified
-
, checkPrec -- String -> P String
, checkCallConv -- FAST_STRING -> P CallConv
, checkContext -- HsType -> P HsContext
, funTyCon_RDR
-- pseudo-keywords, in var and tyvar forms (all :: RdrName)
- , forall_var_RDR
+ , as_var_RDR, hiding_var_RDR, qualified_var_RDR, forall_var_RDR
, export_var_RDR, label_var_RDR, dynamic_var_RDR, unsafe_var_RDR
+ , as_tyvar_RDR, hiding_tyvar_RDR, qualified_tyvar_RDR
, export_tyvar_RDR, label_tyvar_RDR, dynamic_tyvar_RDR
, unsafe_tyvar_RDR
getSrcLocP `thenP` \ loc ->
failMsgP (hcat [ppr loc, text ": ", text s])
-parseErrorOnInput :: P a
-parseErrorOnInput buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
-
srcParseErr :: StringBuffer -> SrcLoc -> Message
srcParseErr s l
= hcat [ppr l, ptext SLIT(": parse error on input "),
cbot = panic "CCall:result_ty"
-----------------------------------------------------------------------------
--- Special Ids
-
-checkAs, checkQualified, checkHiding :: FAST_STRING -> P ()
-
-checkAs s | s == SLIT("as") = returnP ()
- | otherwise = parseErrorOnInput
-checkQualified s | s == SLIT("qualified") = returnP ()
- | otherwise = parseErrorOnInput
-checkHiding s | s == SLIT("hiding") = returnP ()
- | otherwise = parseErrorOnInput
-
------------------------------------------------------------------------------
-- splitForConApp
-- When parsing data declarations, we sometimes inadvertently parse
funName = SLIT("(->)")
listName = SLIT("[]")
+asName = SLIT("as")
+hidingName = SLIT("hiding")
+qualifiedName = SLIT("qualified")
forallName = SLIT("forall")
exportName = SLIT("export")
labelName = SLIT("label")
dynamicName = SLIT("dynamic")
unsafeName = SLIT("unsafe")
+as_var_RDR = mkSrcUnqual varName asName
+hiding_var_RDR = mkSrcUnqual varName hidingName
+qualified_var_RDR = mkSrcUnqual varName qualifiedName
forall_var_RDR = mkSrcUnqual varName forallName
export_var_RDR = mkSrcUnqual varName exportName
label_var_RDR = mkSrcUnqual varName labelName
dynamic_var_RDR = mkSrcUnqual varName dynamicName
unsafe_var_RDR = mkSrcUnqual varName unsafeName
+as_tyvar_RDR = mkSrcUnqual tvName asName
+hiding_tyvar_RDR = mkSrcUnqual tvName hidingName
+qualified_tyvar_RDR = mkSrcUnqual tvName qualifiedName
export_tyvar_RDR = mkSrcUnqual tvName exportName
label_tyvar_RDR = mkSrcUnqual tvName labelName
dynamic_tyvar_RDR = mkSrcUnqual tvName dynamicName
{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.8 1999/06/28 15:42:33 simonmar Exp $
+$Id: Parser.y,v 1.9 1999/06/28 16:42:23 simonmar Exp $
Haskell grammar.
%token
'_' { ITunderscore } -- Haskell keywords
+ 'as' { ITas }
'case' { ITcase }
'class' { ITclass }
'data' { ITdata }
'deriving' { ITderiving }
'do' { ITdo }
'else' { ITelse }
+ 'hiding' { IThiding }
'if' { ITif }
'import' { ITimport }
'in' { ITin }
'module' { ITmodule }
'newtype' { ITnewtype }
'of' { ITof }
+ 'qualified' { ITqualified }
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
varid :: { RdrName }
: VARID { mkSrcUnqual varName $1 }
+ | 'as' { as_var_RDR }
+ | 'qualified' { qualified_var_RDR }
+ | 'hiding' { hiding_var_RDR }
| 'forall' { forall_var_RDR }
| 'export' { export_var_RDR }
| 'label' { label_var_RDR }
varid_no_unsafe :: { RdrName }
: VARID { mkSrcUnqual varName $1 }
+ | 'as' { as_var_RDR }
+ | 'qualified' { qualified_var_RDR }
+ | 'hiding' { hiding_var_RDR }
| 'forall' { forall_var_RDR }
| 'export' { export_var_RDR }
| 'label' { label_var_RDR }
| 'dynamic' { dynamic_var_RDR }
--- ``special'' Ids
-'as' :: { () } : VARID {% checkAs $1 }
-'qualified' :: { () } : VARID {% checkQualified $1 }
-'hiding' :: { () } : VARID {% checkHiding $1 }
-
-----------------------------------------------------------------------------
-- ConIds
tyvar :: { RdrName }
: VARID { mkSrcUnqual tvName $1 }
+ | 'as' { as_tyvar_RDR }
+ | 'qualified' { qualified_tyvar_RDR }
+ | 'hiding' { hiding_tyvar_RDR }
| 'export' { export_var_RDR }
| 'label' { label_var_RDR }
| 'dynamic' { dynamic_var_RDR }
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
+ 'as' { ITas }
+ 'qualified' { ITqualified }
+ 'hiding' { IThiding }
'forall' { ITforall } -- GHC extension keywords
'foreign' { ITforeign }
: VARID { $1 }
| VARSYM { $1 }
| '!' { SLIT("!") }
+ | 'as' { SLIT("as") }
+ | 'qualified' { SLIT("qualified") }
+ | 'hiding' { SLIT("hiding") }
| 'forall' { SLIT("forall") }
| 'foreign' { SLIT("foreign") }
| 'export' { SLIT("export") }