diff options
Diffstat (limited to 'ghc/compiler/parser')
| -rw-r--r-- | ghc/compiler/parser/Lex.lhs | 2 | ||||
| -rw-r--r-- | ghc/compiler/parser/ParseUtil.lhs | 16 | ||||
| -rw-r--r-- | ghc/compiler/parser/Parser.y | 9 |
3 files changed, 19 insertions, 8 deletions
diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs index 8dae914d65..7d74bedfc8 100644 --- a/ghc/compiler/parser/Lex.lhs +++ b/ghc/compiler/parser/Lex.lhs @@ -595,7 +595,7 @@ lexToken cont glaexts buf = cont (ITunknown "\NUL") (stepOn buf) '?'# | flag glaexts && is_lower (lookAhead# buf 1#) -> - lex_ip cont (setCurrentPos# buf 1#) + lex_ip cont (stepOn buf) c | is_digit c -> lex_num cont glaexts 0 buf | is_symbol c -> lex_sym cont buf | is_upper c -> lex_con cont glaexts buf diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs index b410fee27c..c396e3f936 100644 --- a/ghc/compiler/parser/ParseUtil.lhs +++ b/ghc/compiler/parser/ParseUtil.lhs @@ -136,13 +136,21 @@ checkInstType t checkContext :: RdrNameHsType -> P RdrNameContext checkContext (MonoTupleTy ts True) - = mapP (\t -> checkAssertion t []) ts `thenP` \cs -> - returnP (map (uncurry HsPClass) cs) + = mapP (\t -> checkPred t []) ts `thenP` \ps -> + returnP ps checkContext (MonoTyVar t) -- empty contexts are allowed | t == unitTyCon_RDR = returnP [] checkContext t - = checkAssertion t [] `thenP` \(c,ts) -> - returnP [HsPClass c ts] + = checkPred t [] `thenP` \p -> + returnP [p] + +checkPred :: RdrNameHsType -> [RdrNameHsType] + -> P (HsPred RdrName) +checkPred (MonoTyVar t) args@(_:_) | not (isRdrTyVar t) + = returnP (HsPClass t args) +checkPred (MonoTyApp l r) args = checkPred l (r:args) +checkPred (MonoIParamTy n ty) [] = returnP (HsPIParam n ty) +checkPred _ _ = parseError "Illegal class assertion" checkAssertion :: RdrNameHsType -> [RdrNameHsType] -> P (HsClassAssertion RdrName) diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 759c2dcff1..a94edffad1 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.19 2000/01/28 20:52:39 lewie Exp $ +$Id: Parser.y,v 1.20 2000/02/09 18:32:10 lewie Exp $ Haskell grammar. @@ -35,6 +35,7 @@ import GlaExts {- ----------------------------------------------------------------------------- Conflicts: 14 shift/reduce + (note: it's currently 21 -- JRL, 31/1/2000) 8 for abiguity in 'if x then y else z + 1' (shift parses as 'if x then y else (z + 1)', as per longest-parse rule) @@ -85,7 +86,6 @@ Conflicts: 14 shift/reduce 'then' { ITthen } 'type' { ITtype } 'where' { ITwhere } - 'with' { ITwith } '_scc_' { ITscc } 'forall' { ITforall } -- GHC extension keywords @@ -94,6 +94,7 @@ Conflicts: 14 shift/reduce 'label' { ITlabel } 'dynamic' { ITdynamic } 'unsafe' { ITunsafe } + 'with' { ITwith } 'stdcall' { ITstdcallconv } 'ccall' { ITccallconv } '_ccall_' { ITccall (False, False, False) } @@ -174,7 +175,8 @@ Conflicts: 14 shift/reduce QCONID { ITqconid $$ } QVARSYM { ITqvarsym $$ } QCONSYM { ITqconsym $$ } - IPVARID { ITipvarid $$ } + + IPVARID { ITipvarid $$ } -- GHC extension PRAGMA { ITpragma $$ } @@ -489,6 +491,7 @@ type :: { RdrNameHsType } btype :: { RdrNameHsType } : btype atype { MonoTyApp $1 $2 } + | IPVARID '::' type { MonoIParamTy (mkSrcUnqual ipName $1) $3 } | atype { $1 } atype :: { RdrNameHsType } |