Commit 884ec3bb authored by simonmar's avatar simonmar
Browse files

[project @ 1999-06-28 15:42:33 by simonmar]

Fix some pretty subtle bugs in the lexing of qualified names.
parent e73744d4
......@@ -96,15 +96,13 @@ Laziness, you know it makes sense :-)
\begin{code}
data Token
= ITas -- Haskell keywords
| ITcase
= ITcase -- Haskell keywords
| ITclass
| ITdata
| ITdefault
| ITderiving
| ITdo
| ITelse
| IThiding
| ITif
| ITimport
| ITin
......@@ -116,7 +114,6 @@ data Token
| ITmodule
| ITnewtype
| ITof
| ITqualified
| ITthen
| ITtype
| ITwhere
......@@ -245,7 +242,6 @@ pragmaKeywordsFM = listToUFM $
haskellKeywordsFM = listToUFM $
map (\ (x,y) -> (_PK_ x,y))
[( "_", ITunderscore ),
( "as", ITas ),
( "case", ITcase ),
( "class", ITclass ),
( "data", ITdata ),
......@@ -253,7 +249,6 @@ haskellKeywordsFM = listToUFM $
( "deriving", ITderiving ),
( "do", ITdo ),
( "else", ITelse ),
( "hiding", IThiding ),
( "if", ITif ),
( "import", ITimport ),
( "in", ITin ),
......@@ -265,7 +260,6 @@ haskellKeywordsFM = listToUFM $
( "module", ITmodule ),
( "newtype", ITnewtype ),
( "of", ITof ),
( "qualified", ITqualified ),
( "then", ITthen ),
( "type", ITtype ),
( "where", ITwhere ),
......@@ -341,6 +335,10 @@ haskellKeySymsFM = listToUFM $
,("!", ITbang)
,(".", ITdot) -- sadly, for 'forall a . t'
]
not_special_op ITminus = False
not_special_op ITbang = False
not_special_op _ = True
\end{code}
-----------------------------------------------------------------------------
......@@ -980,8 +978,9 @@ lex_id3 cont glaexts mod buf just_a_conid
new_buf = mergeLexemes buf buf'
in
case lookupUFM haskellKeySymsFM lexeme of {
Just kwd_token -> just_a_conid; -- avoid M.:: etc.
Nothing -> cont (mk_qvar_token mod lexeme) new_buf
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
}}
| otherwise =
......@@ -1003,8 +1002,6 @@ lex_id3 cont glaexts mod buf just_a_conid
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.
}}}
......
......@@ -14,6 +14,10 @@ module ParseUtil (
, mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp
, groupBindings
, checkAs
, checkHiding
, checkQualified
, checkPrec -- String -> P String
, checkCallConv -- FAST_STRING -> P CallConv
, checkContext -- HsType -> P HsContext
......@@ -33,10 +37,9 @@ module ParseUtil (
, funTyCon_RDR
-- pseudo-keywords, in var and tyvar forms (all :: RdrName)
, as_var_RDR, hiding_var_RDR, qualified_var_RDR, forall_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
......@@ -69,6 +72,9 @@ parseError s =
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 "),
......@@ -76,6 +82,18 @@ srcParseErr s l
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
......@@ -428,27 +446,18 @@ unitName = SLIT("()")
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.7 1999/06/25 14:38:54 simonmar Exp $
$Id: Parser.y,v 1.8 1999/06/28 15:42:33 simonmar Exp $
Haskell grammar.
......@@ -61,7 +61,6 @@ Conflicts: 14 shift/reduce
%token
'_' { ITunderscore } -- Haskell keywords
'as' { ITas }
'case' { ITcase }
'class' { ITclass }
'data' { ITdata }
......@@ -69,7 +68,6 @@ Conflicts: 14 shift/reduce
'deriving' { ITderiving }
'do' { ITdo }
'else' { ITelse }
'hiding' { IThiding }
'if' { ITif }
'import' { ITimport }
'in' { ITin }
......@@ -81,7 +79,6 @@ Conflicts: 14 shift/reduce
'module' { ITmodule }
'newtype' { ITnewtype }
'of' { ITof }
'qualified' { ITqualified }
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
......@@ -860,9 +857,6 @@ qvarid :: { RdrName }
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 }
......@@ -871,14 +865,16 @@ varid :: { RdrName }
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
......@@ -970,9 +966,6 @@ qtycls :: { RdrName }
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 }
......
......@@ -69,9 +69,6 @@ import Ratio ( (%) )
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
'as' { ITas }
'qualified' { ITqualified }
'hiding' { IThiding }
'forall' { ITforall } -- GHC extension keywords
'foreign' { ITforeign }
......@@ -459,9 +456,6 @@ var_fs :: { EncodedFS }
: VARID { $1 }
| VARSYM { $1 }
| '!' { SLIT("!") }
| 'as' { SLIT("as") }
| 'qualified' { SLIT("qualified") }
| 'hiding' { SLIT("hiding") }
| 'forall' { SLIT("forall") }
| 'foreign' { SLIT("foreign") }
| 'export' { SLIT("export") }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment