From 9e4a57507258b242de787bd4263887ba90760139 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 10 Mar 2005 08:56:37 +0000
Subject: [PATCH] [project @ 2005-03-10 08:56:35 by simonpj] Wibbles to infix
 operators; please merge

---
 ghc/compiler/parser/Parser.y.pp  |    2 +-
 ghc/compiler/parser/RdrHsSyn.lhs |   49 +++++++++++++++++++-------------------
 2 files changed, 26 insertions(+), 25 deletions(-)

diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp
index 1096c5c..9378f76 100644
--- a/ghc/compiler/parser/Parser.y.pp
+++ b/ghc/compiler/parser/Parser.y.pp
@@ -775,7 +775,7 @@ btype :: { LHsType RdrName }
 
 atype :: { LHsType RdrName }
 	: gtycon			{ L1 (HsTyVar (unLoc $1)) }
-	| tyvarid			{ L1 (HsTyVar (unLoc $1)) }
+	| tyvar				{ L1 (HsTyVar (unLoc $1)) }
 	| strict_mark atype		{ LL (HsBangTy (unLoc $1) $2) }
 	| '(' type ',' comma_types1 ')'	{ LL $ HsTupleTy Boxed  ($2:$4) }
 	| '(#' comma_types1 '#)'	{ LL $ HsTupleTy Unboxed $2     }
diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index e94eb61..5a258a1 100644
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -89,34 +89,35 @@ extractHsRhoRdrTyVars :: LHsContext RdrName -> LHsType RdrName -> [Located RdrNa
 extractHsRhoRdrTyVars ctxt ty 
  = nubBy eqLocated $ extract_lctxt ctxt (extract_lty ty [])
 
-extract_lctxt ctxt acc = foldr (extract_pred.unLoc) acc (unLoc ctxt)
+extract_lctxt ctxt acc = foldr (extract_pred . unLoc) acc (unLoc ctxt)
 
 extract_pred (HsClassP cls tys) acc	= foldr extract_lty acc tys
 extract_pred (HsIParam n ty) acc	= extract_lty ty acc
 
-extract_lty (L loc (HsTyVar tv)) acc
-  | isRdrTyVar tv = L loc tv : acc
-  | otherwise = acc
-extract_lty ty acc = extract_ty (unLoc ty) acc
-
-extract_ty (HsBangTy _ ty)           acc = extract_lty ty acc
-extract_ty (HsAppTy ty1 ty2)         acc = extract_lty ty1 (extract_lty ty2 acc)
-extract_ty (HsListTy ty)             acc = extract_lty ty acc
-extract_ty (HsPArrTy ty)             acc = extract_lty ty acc
-extract_ty (HsTupleTy _ tys)         acc = foldr extract_lty acc tys
-extract_ty (HsFunTy ty1 ty2)         acc = extract_lty ty1 (extract_lty ty2 acc)
-extract_ty (HsPredTy p)		     acc = extract_pred p acc
-extract_ty (HsOpTy ty1 nam ty2)      acc = extract_lty ty1 (extract_lty ty2 acc)
-extract_ty (HsParTy ty)              acc = extract_lty ty acc
-extract_ty (HsNumTy num)             acc = acc
-extract_ty (HsSpliceTy _)            acc = acc	-- Type splices mention no type variables
-extract_ty (HsKindSig ty k)	     acc = extract_lty ty acc
-extract_ty (HsForAllTy exp [] cx ty) acc = extract_lctxt cx (extract_lty ty acc)
-extract_ty (HsForAllTy exp tvs cx ty) 
-                                acc = (filter ((`notElem` locals) . unLoc) $
-				       extract_lctxt cx (extract_lty ty [])) ++ acc
-				    where
-				      locals = hsLTyVarNames tvs
+extract_lty (L loc ty) acc 
+  = case ty of
+      HsTyVar tv 	        -> extract_tv loc tv acc
+      HsBangTy _ ty            	-> extract_lty ty acc
+      HsAppTy ty1 ty2          	-> extract_lty ty1 (extract_lty ty2 acc)
+      HsListTy ty              	-> extract_lty ty acc
+      HsPArrTy ty              	-> extract_lty ty acc
+      HsTupleTy _ tys          	-> foldr extract_lty acc tys
+      HsFunTy ty1 ty2          	-> extract_lty ty1 (extract_lty ty2 acc)
+      HsPredTy p		-> extract_pred p acc
+      HsOpTy ty1 (L loc tv) ty2 -> extract_tv loc tv (extract_lty ty1 (extract_lty ty2 acc))
+      HsParTy ty               	-> extract_lty ty acc
+      HsNumTy num              	-> acc
+      HsSpliceTy _             	-> acc	-- Type splices mention no type variables
+      HsKindSig ty k	        -> extract_lty ty acc
+      HsForAllTy exp [] cx ty   -> extract_lctxt cx (extract_lty ty acc)
+      HsForAllTy exp tvs cx ty  -> acc ++ (filter ((`notElem` locals) . unLoc) $
+					   extract_lctxt cx (extract_lty ty []))
+				where
+				   locals = hsLTyVarNames tvs
+
+extract_tv :: SrcSpan -> RdrName -> [Located RdrName] -> [Located RdrName]
+extract_tv loc tv acc | isRdrTyVar tv = L loc tv : acc
+		      | otherwise     = acc
 
 extractGenericPatTyVars :: LHsBinds RdrName -> [Located RdrName]
 -- Get the type variables out of the type patterns in a bunch of
-- 
1.7.10.4