[project @ 2000-02-09 18:32:09 by lewie]

Misc. fixes to implicit parameters support.

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 }