[project @ 2002-09-09 12:55:52 by simonpj]
[ghc-hetmet.git] / ghc / compiler / parser / RdrHsSyn.lhs
index c482844..2f16a89 100644 (file)
@@ -48,6 +48,7 @@ module RdrHsSyn (
  
        mkHsOpApp, mkClassDecl, mkClassOpSigDM, mkConDecl,
        mkHsNegApp, mkNPlusKPat, mkHsIntegral, mkHsFractional,
+       mkHsDo,
 
        cvBinds,
        cvMonoBindsAndSigs,
@@ -61,9 +62,8 @@ module RdrHsSyn (
 import HsSyn           -- Lots of it
 import OccName         ( mkClassTyConOcc, mkClassDataConOcc, mkWorkerOcc,
                           mkSuperDictSelOcc, mkDefaultMethodOcc, mkGenOcc1,
-                         mkGenOcc2, 
+                         mkGenOcc2
                        )
-import PrelNames       ( minusName, negateName, fromIntegerName, fromRationalName )
 import RdrName         ( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc, isRdrTyVar )
 import List            ( nub )
 import BasicTypes      ( RecFlag(..) )
@@ -149,8 +149,9 @@ extract_ty (HsFunTy ty1 ty2)          acc = extract_ty ty1 (extract_ty ty2 acc)
 extract_ty (HsPredTy p)                      acc = extract_pred p acc
 extract_ty (HsTyVar tv)               acc = tv : acc
 extract_ty (HsForAllTy Nothing cx ty) acc = extract_ctxt cx (extract_ty ty acc)
--- Generics
 extract_ty (HsOpTy ty1 nam ty2)       acc = extract_ty ty1 (extract_ty ty2 acc)
+extract_ty (HsParTy ty)               acc = extract_ty ty acc
+-- Generics
 extract_ty (HsNumTy num)              acc = acc
 extract_ty (HsKindSig ty k)          acc = extract_ty ty acc
 extract_ty (HsForAllTy (Just tvs) ctxt ty) 
@@ -213,12 +214,12 @@ mkClassDecl (cxt, cname, tyvars) fds sigs mbinds loc
       --  superclasses both called C!)
     new_names = mkClassDeclSysNames (tname, dname, dwname, sc_sel_names)
 
-mkTyData new_or_data (context, tname, tyvars) list_con i maybe src
+mkTyData new_or_data (context, tname, tyvars) data_cons maybe src
   = let t_occ  = rdrNameOcc tname
         name1 = mkRdrUnqual (mkGenOcc1 t_occ) 
        name2 = mkRdrUnqual (mkGenOcc2 t_occ) 
     in TyData { tcdND = new_or_data, tcdCtxt = context, tcdName = tname,
-               tcdTyVars = tyvars, tcdCons = list_con, tcdNCons = i,
+               tcdTyVars = tyvars, tcdCons = data_cons, 
                tcdDerivs = maybe, tcdLoc = src, tcdSysNames = [name1, name2] }
 
 mkClassOpSigDM op ty loc
@@ -237,21 +238,11 @@ mkHsNegApp :: RdrNameHsExpr -> RdrNameHsExpr
 -- If the type checker sees (negate 3#) it will barf, because negate
 -- can't take an unboxed arg.  But that is exactly what it will see when
 -- we write "-3#".  So we have to do the negation right now!
--- 
--- We also do the same service for boxed literals, because this function
--- is also used for patterns (which, remember, are parsed as expressions)
--- and pattern don't have negation in them.
--- 
--- Finally, it's important to represent minBound as minBound, and not
--- as (negate (-minBound)), becuase the latter is out of range. 
 
 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 n)) = HsOverLit (HsIntegral   (-i) n)
-mkHsNegApp (HsOverLit (HsFractional f n)) = HsOverLit (HsFractional (-f) n)
-mkHsNegApp expr                          = NegApp expr negateName
+mkHsNegApp expr                            = NegApp expr     placeHolderName
 \end{code}
 
 A useful function for building @OpApps@.  The operator is always a
@@ -265,9 +256,10 @@ 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
+mkHsIntegral   i      = HsIntegral   i  placeHolderName
+mkHsFractional f      = HsFractional f  placeHolderName
+mkNPlusKPat n k       = NPlusKPatIn n k placeHolderName
+mkHsDo ctxt stmts loc = HsDo ctxt stmts [] placeHolderType loc
 \end{code}