Commit c52f850d authored by simonmar's avatar simonmar
Browse files

[project @ 1999-06-28 16:42:22 by simonmar]

Back out changes for "specialid"s.  It didn't work this way: there was
a conflict in the grammar.
parent 9a734fe7
......@@ -96,13 +96,15 @@ Laziness, you know it makes sense :-)
\begin{code}
data Token
= ITcase -- Haskell keywords
= ITas -- Haskell keywords
| ITcase
| ITclass
| ITdata
| ITdefault
| ITderiving
| ITdo
| ITelse
| IThiding
| ITif
| ITimport
| ITin
......@@ -114,6 +116,7 @@ data Token
| ITmodule
| ITnewtype
| ITof
| ITqualified
| ITthen
| ITtype
| ITwhere
......@@ -242,6 +245,7 @@ pragmaKeywordsFM = listToUFM $
haskellKeywordsFM = listToUFM $
map (\ (x,y) -> (_PK_ x,y))
[( "_", ITunderscore ),
( "as", ITas ),
( "case", ITcase ),
( "class", ITclass ),
( "data", ITdata ),
......@@ -249,6 +253,7 @@ haskellKeywordsFM = listToUFM $
( "deriving", ITderiving ),
( "do", ITdo ),
( "else", ITelse ),
( "hiding", IThiding ),
( "if", ITif ),
( "import", ITimport ),
( "in", ITin ),
......@@ -260,6 +265,7 @@ haskellKeywordsFM = listToUFM $
( "module", ITmodule ),
( "newtype", ITnewtype ),
( "of", ITof ),
( "qualified", ITqualified ),
( "then", ITthen ),
( "type", ITtype ),
( "where", ITwhere ),
......@@ -335,10 +341,6 @@ 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}
-----------------------------------------------------------------------------
......@@ -977,11 +979,9 @@ lex_id3 cont glaexts mod buf just_a_conid
-- 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
......@@ -1002,6 +1002,8 @@ 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,10 +14,6 @@ module ParseUtil (
, mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp
, groupBindings
, checkAs
, checkHiding
, checkQualified
, checkPrec -- String -> P String
, checkCallConv -- FAST_STRING -> P CallConv
, checkContext -- HsType -> P HsContext
......@@ -37,9 +33,10 @@ module ParseUtil (
, 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
......@@ -72,9 +69,6 @@ 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 "),
......@@ -82,18 +76,6 @@ 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
......@@ -446,18 +428,27 @@ 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.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.
......@@ -61,6 +61,7 @@ Conflicts: 14 shift/reduce
%token
'_' { ITunderscore } -- Haskell keywords
'as' { ITas }
'case' { ITcase }
'class' { ITclass }
'data' { ITdata }
......@@ -68,6 +69,7 @@ Conflicts: 14 shift/reduce
'deriving' { ITderiving }
'do' { ITdo }
'else' { ITelse }
'hiding' { IThiding }
'if' { ITif }
'import' { ITimport }
'in' { ITin }
......@@ -79,6 +81,7 @@ Conflicts: 14 shift/reduce
'module' { ITmodule }
'newtype' { ITnewtype }
'of' { ITof }
'qualified' { ITqualified }
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
......@@ -857,6 +860,9 @@ 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 }
......@@ -865,16 +871,14 @@ 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
......@@ -966,6 +970,9 @@ 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,6 +69,9 @@ import Ratio ( (%) )
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
'as' { ITas }
'qualified' { ITqualified }
'hiding' { IThiding }
'forall' { ITforall } -- GHC extension keywords
'foreign' { ITforeign }
......@@ -456,6 +459,9 @@ 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