[project @ 2000-12-07 09:12:01 by simonpj]

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

diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index 54e9408..d7ad728 100644 (file)
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -49,7 +49,7 @@ module RdrHsSyn (
        extractRuleBndrsTyVars,
        extractHsCtxtRdrTyVars, extractGenericPatTyVars,
  
-       mkHsOpApp, mkClassDecl, mkClassOpSig, mkConDecl,
+       mkHsOpApp, mkClassDecl, mkClassOpSigDM, mkConDecl,
        mkHsNegApp, 
 
        cvBinds,
@@ -160,8 +160,6 @@ extract_ty (HsListTy ty)              acc = extract_ty ty acc
 extract_ty (HsTupleTy _ tys)          acc = foldr extract_ty acc tys
 extract_ty (HsFunTy ty1 ty2)          acc = extract_ty ty1 (extract_ty ty2 acc)
 extract_ty (HsPredTy p)                      acc = extract_pred p acc
-extract_ty (HsUsgTy usg ty)           acc = extract_ty ty acc
-extract_ty (HsUsgForAllTy uv ty)      acc = extract_ty ty acc
 extract_ty (HsTyVar tv)               acc = tv : acc
 extract_ty (HsForAllTy Nothing ctxt ty) acc = extract_ctxt ctxt (extract_ty ty acc)
 -- Generics
@@ -213,7 +211,9 @@ Similarly for mkConDecl, mkClassOpSig and default-method names.
   
 \begin{code}
 mkClassDecl cxt cname tyvars fds sigs mbinds loc
-  = ClassDecl cxt cname tyvars fds sigs mbinds new_names loc
+  = ClassDecl { tcdCtxt = cxt, tcdName = cname, tcdTyVars = tyvars,
+               tcdFDs = fds,  tcdSigs = sigs,  tcdMeths = mbinds,
+               tcdSysNames = new_names, tcdLoc = loc }
   where
     cls_occ  = rdrNameOcc cname
     data_occ = mkClassDataConOcc cls_occ
@@ -236,15 +236,14 @@ mkTyData new_or_data context tname list_var list_con i maybe src
   = let t_occ  = rdrNameOcc tname
         name1 = mkRdrUnqual (mkGenOcc1 t_occ) 
        name2 = mkRdrUnqual (mkGenOcc2 t_occ) 
-    in TyData new_or_data context 
-              tname list_var list_con i maybe src name1 name2
+    in TyData { tcdND = new_or_data, tcdCtxt = context, tcdName = tname,
+               tcdTyVars = list_var, tcdCons = list_con, tcdNCons = i,
+               tcdDerivs = maybe, tcdLoc = src, tcdSysNames = [name1, name2] }
 
-mkClassOpSig (DefMeth x) op ty loc
-  = ClassOpSig op (Just (DefMeth dm_rn)) ty loc
+mkClassOpSigDM op ty loc
+  = ClassOpSig op (DefMeth dm_rn) ty loc
   where
     dm_rn = mkRdrUnqual (mkDefaultMethodOcc (rdrNameOcc op))
-mkClassOpSig x op ty loc =
-    ClassOpSig op (Just x) ty loc
 
 mkConDecl cname ex_vars cxt details loc
   = ConDecl cname wkr_name ex_vars cxt details loc
@@ -333,7 +332,7 @@ cvValSig      sig = sig
 
 cvInstDeclSig sig = sig
 
-cvClassOpSig (Sig var poly_ty src_loc) = ClassOpSig var Nothing poly_ty src_loc
+cvClassOpSig (Sig var poly_ty src_loc) = mkClassOpSigDM var poly_ty src_loc
 cvClassOpSig sig                      = sig
 \end{code}