[project @ 2003-05-21 12:38:36 by simonmar]

[ghc-hetmet.git] / ghc / compiler / parser / RdrHsSyn.lhs

diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index 729b416..5624a2d 100644 (file)
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -43,10 +43,12 @@ module RdrHsSyn (
        RdrBinding(..),
        RdrMatch(..),
 
+       main_RDR_Unqual,
+
        extractHsTyRdrNames,  extractHsTyRdrTyVars, 
        extractHsCtxtRdrTyVars, extractGenericPatTyVars,
  
-       mkHsOpApp, mkClassDecl, mkClassOpSigDM, 
+       mkHsOpApp, mkClassDecl, 
        mkHsNegApp, mkNPlusKPat, mkHsIntegral, mkHsFractional,
        mkHsDo, mkHsSplice, mkSigDecls,
         mkTyData, mkPrefixCon, mkRecCon,
@@ -56,7 +58,6 @@ module RdrHsSyn (
        cvBinds,
        cvMonoBindsAndSigs,
        cvTopDecls,
-       cvClassOpSig, 
        findSplice, addImpDecls, emptyGroup, mkGroup,
 
        -- Stuff to do with Foreign declarations
@@ -154,6 +155,12 @@ type RdrNameFixitySig              = FixitySig             RdrName
 type RdrNameHsRecordBinds      = HsRecordBinds         RdrName
 \end{code}
 
+\begin{code}
+main_RDR_Unqual :: RdrName
+main_RDR_Unqual = mkUnqual varName FSLIT("main")
+       -- We definitely don't want an Orig RdrName, because
+       -- main might, in principle, be imported into module Main
+\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -237,7 +244,9 @@ Similarly for mkConDecl, mkClassOpSig and default-method names.
 \begin{code}
 mkClassDecl (cxt, cname, tyvars) fds sigs mbinds loc
   = ClassDecl { tcdCtxt = cxt, tcdName = cname, tcdTyVars = tyvars,
-               tcdFDs = fds,  tcdSigs = sigs,  tcdMeths = mbinds,
+               tcdFDs = fds,  
+               tcdSigs = map cvClassOpSig sigs,        -- Convert to class-op sigs
+               tcdMeths = mbinds,
                tcdLoc = loc }
 
 mkTyData new_or_data (context, tname, tyvars) data_cons maybe src
@@ -245,10 +254,13 @@ mkTyData new_or_data (context, tname, tyvars) data_cons maybe src
             tcdTyVars = tyvars,  tcdCons = data_cons, 
             tcdDerivs = maybe,   tcdLoc = src, tcdGeneric = Nothing }
 
-mkClassOpSigDM op ty loc
-  = ClassOpSig op (DefMeth dm_rn) ty loc
+cvClassOpSig :: RdrNameSig -> RdrNameSig
+cvClassOpSig (Sig var poly_ty src_loc) 
+  = ClassOpSig var (DefMeth dm_rn) poly_ty src_loc
   where
-    dm_rn = mkRdrUnqual (mkDefaultMethodOcc (rdrNameOcc op))
+    dm_rn = mkRdrUnqual (mkDefaultMethodOcc (rdrNameOcc var))
+cvClassOpSig sig 
+  = sig
 \end{code}
 
 \begin{code}
@@ -316,22 +328,6 @@ data RdrMatch
 
 %************************************************************************
 %*                                                                     *
-\subsection[cvDecls]{Convert various top-level declarations}
-%*                                                                     *
-%************************************************************************
-
-We make a point not to throw any user-pragma ``sigs'' at
-these conversion functions:
-
-\begin{code}
-cvClassOpSig :: RdrNameSig -> RdrNameSig
-cvClassOpSig (Sig var poly_ty src_loc) = mkClassOpSigDM var poly_ty src_loc
-cvClassOpSig sig                      = sig
-\end{code}
-
-
-%************************************************************************
-%*                                                                     *
 \subsection[cvBinds-etc]{Converting to @HsBinds@, @MonoBinds@, etc.}
 %*                                                                     *
 %************************************************************************
@@ -516,11 +512,13 @@ checkInstType t
                returnP (HsForAllTy Nothing [] dict_ty)
 
 checkTyVars :: [RdrNameHsType] -> P [RdrNameHsTyVar]
-checkTyVars tvs = mapP chk tvs
-               where
-                 chk (HsKindSig (HsTyVar tv) k) = returnP (IfaceTyVar tv k)
-                 chk (HsTyVar tv)               = returnP (UserTyVar tv)
-                 chk other                      = parseError "Type found where type variable expected"
+checkTyVars tvs 
+  = mapP chk tvs
+  where
+       --  Check that the name space is correct!
+    chk (HsKindSig (HsTyVar tv) k) | isRdrTyVar tv = returnP (IfaceTyVar tv k)
+    chk (HsTyVar tv)              | isRdrTyVar tv = returnP (UserTyVar tv)
+    chk other                     = parseError "Type found where type variable expected"
 
 checkTyClHdr :: RdrNameHsType -> P (RdrName, [RdrNameHsTyVar])
 -- The header of a type or class decl should look like