Commit 2a6d497b authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Massive patch for the first months work adding System FC to GHC #24

Broken up massive patch -=chak
Original log message:  
This is (sadly) all done in one patch to avoid Darcs bugs.
It's not complete work... more FC stuff to come.  A compiler
using just this patch will fail dismally.
parent e69ddd9c
......@@ -83,7 +83,7 @@ import Id ( Id )
import Type ( TyThing(..) )
import Class ( Class, classSelIds, classTyCon )
import TyCon ( TyCon, tyConSelIds, tyConDataCons )
import TyCon ( TyCon, tyConSelIds, tyConDataCons, isNewTyCon, newTyConCo )
import DataCon ( dataConImplicitIds )
import PrelNames ( gHC_PRIM )
import Packages ( PackageId )
......@@ -618,13 +618,16 @@ mkPrintUnqualified env = (qual_name, qual_mod)
\begin{code}
implicitTyThings :: TyThing -> [TyThing]
-- If you change this, make sure you change LoadIface.ifaceDeclSubBndrs in sync
implicitTyThings (AnId id) = []
-- For type constructors, add the data cons (and their extras),
-- and the selectors and generic-programming Ids too
--
-- Newtypes don't have a worker Id, so don't generate that?
implicitTyThings (ATyCon tc) = map AnId (tyConSelIds tc) ++
implicitTyThings (ATyCon tc) = implicitNewCoTyCon tc ++
map AnId (tyConSelIds tc) ++
concatMap (extras_plus . ADataCon) (tyConDataCons tc)
-- For classes, add the class TyCon too (and its extras)
......@@ -636,6 +639,10 @@ implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++
-- For data cons add the worker and wrapper (if any)
implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
-- For newtypes, add the implicit coercion tycon
implicitNewCoTyCon tc | isNewTyCon tc = [ATyCon (newTyConCo tc)]
| otherwise = []
extras_plus thing = thing : implicitTyThings thing
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
......
......@@ -17,7 +17,9 @@ module PprTyThing (
#include "HsVersions.h"
import qualified GHC
import GHC ( TyThing(..), SrcLoc )
import DataCon ( dataConResTys )
import Outputable
-- -----------------------------------------------------------------------------
......@@ -129,12 +131,15 @@ pprDataCon exts dataCon = pprAlgTyCon exts tyCon (== dataCon) (const True)
where tyCon = GHC.dataConTyCon dataCon
pprDataConDecl exts gadt_style show_label dataCon
= error "kevind stub"
{-
| not gadt_style = ppr_fields tys_w_strs
| otherwise = ppr_bndr dataCon <+> dcolon <+>
sep [ ppr_tvs, GHC.pprThetaArrow theta, pp_tau ]
where
(tyvars, theta, argTypes, tyCon, res_tys) = GHC.dataConSig dataCon
(tyvars, theta, argTypes, tyCon) = GHC.dataConSig dataCon
labels = GHC.dataConFieldLabels dataCon
res_tys = dataConResTys dataCon
qualVars = filter (flip notElem (GHC.tyConTyVars tyCon)) tyvars
stricts = GHC.dataConStrictMarks dataCon
tys_w_strs = zip stricts argTypes
......@@ -171,7 +176,7 @@ pprDataConDecl exts gadt_style show_label dataCon
= ppr_bndr dataCon <+>
braces (sep (punctuate comma (ppr_trim maybe_show_label
(zip labels fields))))
-}
pprClass exts cls
| null methods =
pprClassHdr exts cls
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment