Fix migrated AT support

Wed Jul 26 18:16:25 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Fix migrated AT support
  - Make it compile
  - Successfully parses and renames simple AT declarations
  - Should not affect non-AT programs

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 777ff64..59651a4 100644 (file)
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -153,7 +153,7 @@ Similarly for mkConDecl, mkClassOpSig and default-method names.
        *** See "THE NAMING STORY" in HsDecls ****
   
 \begin{code}
        *** See "THE NAMING STORY" in HsDecls ****
   
 \begin{code}

-mkClassDecl (cxt, cname, tyvars) fds sigs mbinds
+mkClassDecl (cxt, cname, tyvars) fds sigs mbinds ats

   = ClassDecl { tcdCtxt = cxt, tcdLName = cname, tcdTyVars = tyvars,
                tcdFDs = fds,  
                tcdSigs = sigs,
   = ClassDecl { tcdCtxt = cxt, tcdLName = cname, tcdTyVars = tyvars,
                tcdFDs = fds,  
                tcdSigs = sigs,

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 477307e..023a6cf 100644 (file)
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -15,8 +15,9 @@ module RnSource (
 import {-# SOURCE #-} RnExpr( rnLExpr )
 
 import HsSyn
 import {-# SOURCE #-} RnExpr( rnLExpr )
 
 import HsSyn

-import RdrName         ( RdrName, isRdrDataCon, isRdrTyVar, elemLocalRdrEnv, 
-                         globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE )
+import RdrName         ( RdrName, isRdrDataCon, isRdrTyVar, rdrNameOcc, 
+                         elemLocalRdrEnv, globalRdrEnvElts, GlobalRdrElt(..),
+                         isLocalGRE )

 import RdrHsSyn                ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
 import RnHsSyn
 import RnTypes         ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
 import RdrHsSyn                ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
 import RnHsSyn
 import RnTypes         ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )

@@ -41,7 +42,7 @@ import Outputable
 import SrcLoc          ( Located(..), unLoc, noLoc )
 import DynFlags        ( DynFlag(..) )
 import Maybes          ( seqMaybe )
 import SrcLoc          ( Located(..), unLoc, noLoc )
 import DynFlags        ( DynFlag(..) )
 import Maybes          ( seqMaybe )

-import Maybe            ( isNothing )
+import Maybe            ( isNothing, catMaybes )

 import Monad           ( liftM )
 import BasicTypes       ( Boxity(..) )
 \end{code}
 import Monad           ( liftM )
 import BasicTypes       ( Boxity(..) )
 \end{code}

@@ -513,7 +514,7 @@ rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
                   deriv_fvs) }
 
   | otherwise  -- GADT
                   deriv_fvs) }
 
   | otherwise  -- GADT

-  = ASSERT( null typats )       -- GADTs cannot have type patterns for now
+  = ASSERT( none typatsMaybe )    -- GADTs cannot have type patterns for now

     do { tycon' <- lookupLocatedTopBndrRn tycon
        ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
        ; tyvars' <- bindTyVarsRn data_doc tyvars 
     do { tycon' <- lookupLocatedTopBndrRn tycon
        ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
        ; tyvars' <- bindTyVarsRn data_doc tyvars 

@@ -536,6 +537,10 @@ rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
                     L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
                     other                 -> False
 
                     L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
                     other                 -> False
 

+    none Nothing   = True
+    none (Just []) = True
+    none _         = False
+

     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
     con_names = map con_names_helper condecls
 
     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
     con_names = map con_names_helper condecls
 

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index ecf4ac9..0454e34 100644 (file)
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -176,9 +176,8 @@ tcLocalInstDecl1 :: LInstDecl Name
        --
        -- We check for respectable instance type, and context
 tcLocalInstDecl1 decl@(L loc (InstDecl poly_ty binds uprags ats))
        --
        -- We check for respectable instance type, and context
 tcLocalInstDecl1 decl@(L loc (InstDecl poly_ty binds uprags ats))

+  -- !!!TODO: Handle the `ats' parameter!!! -=chak

   =    -- Prime error recovery, set source location
   =    -- Prime error recovery, set source location

-    ASSERT( null ats )
-      -- !!!TODO: Handle the `ats' parameter!!! -=chak

     recoverM (returnM Nothing)         $
     setSrcSpan loc                     $
     addErrCtxt (instDeclCtxt1 poly_ty) $
     recoverM (returnM Nothing)         $
     setSrcSpan loc                     $
     addErrCtxt (instDeclCtxt1 poly_ty) $