X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FRdrHsSyn.lhs;h=7629070b5862d6aca00b2b22b41182358ced5533;hb=91c750cbd18e3d610b0db498ded38d5b3c5adfac;hp=ea3414769ee299f43d50847bc18a777d4c8b0e1b;hpb=788faebb40b51d37e73ed94dfc99460d39a1a811;p=ghc-hetmet.git

diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index ea34147..7629070 100644
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -43,14 +43,11 @@ module RdrHsSyn (
 	RdrMatch(..),
 	SigConverter,
 
-	extractHsTyRdrNames, 
-	extractHsTyRdrTyVars, extractHsTysRdrTyVars,
-	extractPatsTyVars, 
-	extractRuleBndrsTyVars,
+	extractHsTyRdrNames,  extractHsTyRdrTyVars, 
 	extractHsCtxtRdrTyVars, extractGenericPatTyVars,
  
 	mkHsOpApp, mkClassDecl, mkClassOpSigDM, mkConDecl,
-	mkHsNegApp, 
+	mkHsNegApp, mkNPlusKPat, mkHsIntegral, mkHsFractional,
 
 	cvBinds,
 	cvMonoBindsAndSigs,
@@ -62,13 +59,12 @@ module RdrHsSyn (
 #include "HsVersions.h"
 
 import HsSyn		-- Lots of it
-import HsPat		( collectSigTysFromPats )
 import OccName		( mkClassTyConOcc, mkClassDataConOcc, mkWorkerOcc,
                           mkSuperDictSelOcc, mkDefaultMethodOcc, mkGenOcc1,
 			  mkGenOcc2, 
                       	)
-import RdrName		( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc,
-			)
+import PrelNames	( minusName, negateName, fromIntegerName, fromRationalName )
+import RdrName		( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc, isRdrTyVar )
 import List		( nub )
 import BasicTypes	( RecFlag(..) )
 import Class            ( DefMeth (..) )
@@ -127,20 +123,11 @@ type RdrNameHsRecordBinds	= HsRecordBinds		RdrName RdrNamePat
 It's used when making the for-alls explicit.
 
 \begin{code}
-extractHsTyRdrNames :: HsType RdrName -> [RdrName]
+extractHsTyRdrNames :: RdrNameHsType -> [RdrName]
 extractHsTyRdrNames ty = nub (extract_ty ty [])
 
-extractHsTyRdrTyVars	 :: RdrNameHsType -> [RdrName]
-extractHsTyRdrTyVars ty =  filter isRdrTyVar (extractHsTyRdrNames ty)
-
-extractHsTysRdrTyVars	  :: [RdrNameHsType] -> [RdrName]
-extractHsTysRdrTyVars tys =  filter isRdrTyVar (nub (extract_tys tys))
-
-extractRuleBndrsTyVars :: [RuleBndr RdrName] -> [RdrName]
-extractRuleBndrsTyVars bndrs = filter isRdrTyVar (nub (foldr go [] bndrs))
-                           where
-                             go (RuleBndr _)       acc = acc
-                             go (RuleBndrSig _ ty) acc = extract_ty ty acc
+extractHsTyRdrTyVars :: RdrNameHsType -> [RdrName]
+extractHsTyRdrTyVars ty = nub (filter isRdrTyVar (extract_ty ty []))
 
 extractHsCtxtRdrNames :: HsContext RdrName -> [RdrName]
 extractHsCtxtRdrNames ty = nub (extract_ctxt ty [])
@@ -172,13 +159,6 @@ extract_ty (HsForAllTy (Just tvs) ctxt ty)
 				    where
 				      locals = hsTyVarNames tvs
 
-
-extractPatsTyVars :: [RdrNamePat] -> [RdrName]
-extractPatsTyVars = filter isRdrTyVar . 
-		    nub . 
-		    extract_tys .
-		    collectSigTysFromPats
-
 extractGenericPatTyVars :: RdrNameMonoBinds -> [RdrName]
 -- Get the type variables out of the type patterns in a bunch of
 -- possibly-generic bindings in a class declaration
@@ -189,8 +169,8 @@ extractGenericPatTyVars binds
     get (FunMonoBind _ _ ms _) acc = foldr get_m acc ms
     get other		       acc = acc
 
-    get_m (Match _ (TypePatIn ty : _) _ _) acc = extract_ty ty acc
-    get_m other				   acc = acc
+    get_m (Match (TypePatIn ty : _) _ _) acc = extract_ty ty acc
+    get_m other				 acc = acc
 \end{code}
 
 
@@ -232,7 +212,6 @@ mkClassDecl cxt cname tyvars fds sigs mbinds loc
       --  superclasses both called C!)
     new_names = mkClassDeclSysNames (tname, dname, dwname, sc_sel_names)
 
--- mkTyData :: ??
 mkTyData new_or_data context tname list_var list_con i maybe src
   = let t_occ  = rdrNameOcc tname
         name1 = mkRdrUnqual (mkGenOcc1 t_occ) 
@@ -269,9 +248,9 @@ mkHsNegApp (HsLit (HsIntPrim i))    = HsLit (HsIntPrim (-i))
 mkHsNegApp (HsLit (HsFloatPrim i))  = HsLit (HsFloatPrim (-i))  
 mkHsNegApp (HsLit (HsDoublePrim i)) = HsLit (HsDoublePrim (-i)) 
 
-mkHsNegApp (HsOverLit (HsIntegral   i)) = HsOverLit (HsIntegral   (-i))
-mkHsNegApp (HsOverLit (HsFractional f)) = HsOverLit (HsFractional (-f))
-mkHsNegApp expr 			= NegApp expr
+mkHsNegApp (HsOverLit (HsIntegral   i n)) = HsOverLit (HsIntegral   (-i) n)
+mkHsNegApp (HsOverLit (HsFractional f n)) = HsOverLit (HsFractional (-f) n)
+mkHsNegApp expr 		  	  = NegApp expr negateName
 \end{code}
 
 A useful function for building @OpApps@.  The operator is always a
@@ -281,6 +260,15 @@ variable, and we don't know the fixity yet.
 mkHsOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
 \end{code}
 
+These are the bits of syntax that contain rebindable names
+See RnEnv.lookupSyntaxName
+
+\begin{code}
+mkHsIntegral   i = HsIntegral   i fromIntegerName
+mkHsFractional f = HsFractional f fromRationalName
+mkNPlusKPat n k  = NPlusKPatIn n k minusName
+\end{code}
+
 
 %************************************************************************
 %*									*