From 51f116efc047bf352fd2f29e167208deffa05895 Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 24 Feb 2004 16:44:27 +0000 Subject: [PATCH] [project @ 2004-02-24 16:44:26 by simonpj] --------------------------------------- Allow constructors to be specified in hi-boot files --------------------------------------- --- ghc/compiler/parser/Parser.y.pp | 8 +++-- ghc/compiler/parser/RdrHsSyn.lhs | 36 ++++++++++++++++++++-- ghc/docs/users_guide/separate_compilation.sgml | 38 ++++++++++++++++-------- 3 files changed, 64 insertions(+), 18 deletions(-) diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp index 8276bb5..fd7dab7 100644 --- a/ghc/compiler/parser/Parser.y.pp +++ b/ghc/compiler/parser/Parser.y.pp @@ -327,10 +327,12 @@ ifacedecl :: { HsDecl RdrName } { SigD (Sig $1 $3) } | 'type' syn_hdr '=' ctype { let (tc,tvs) = $2 in TyClD (TySynonym tc tvs $4) } - | 'data' tycl_hdr - { TyClD (mkTyData DataType (unLoc $2) [] Nothing) } - | 'newtype' tycl_hdr + | 'data' tycl_hdr constrs -- No deriving in hi-boot + { TyClD (mkTyData DataType (unLoc $2) (reverse (unLoc $3)) Nothing) } + | 'newtype' tycl_hdr -- Constructor is optional { TyClD (mkTyData NewType (unLoc $2) [] Nothing) } + | 'newtype' tycl_hdr '=' newconstr + { TyClD (mkTyData NewType (unLoc $2) [$4] Nothing) } | 'class' tycl_hdr fds { TyClD (mkClassDecl (unLoc $2) (unLoc $3) [] emptyBag) } diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs index 656fc34..45b015b 100644 --- a/ghc/compiler/parser/RdrHsSyn.lhs +++ b/ghc/compiler/parser/RdrHsSyn.lhs @@ -51,7 +51,7 @@ module RdrHsSyn ( import HsSyn -- Lots of it import IfaceType import HscTypes ( ModIface(..), emptyModIface, mkIfaceVerCache ) -import IfaceSyn ( IfaceDecl(..), IfaceIdInfo(..) ) +import IfaceSyn ( IfaceDecl(..), IfaceIdInfo(..), IfaceConDecl(..) ) import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc, isRdrTyVar, isRdrDataCon, isUnqual, getRdrName, isQual, setRdrNameSpace, rdrNameModule ) @@ -64,7 +64,7 @@ import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..), DNCallSpec(..), DNKind(..)) import OccName ( OccName, srcDataName, varName, isDataOcc, isTcOcc, occNameUserString, isValOcc ) -import BasicTypes ( initialVersion ) +import BasicTypes ( initialVersion, StrictnessMark(..) ) import TyCon ( DataConDetails(..) ) import Module ( ModuleName ) import SrcLoc @@ -246,7 +246,8 @@ hsIfaceDecl (TyClD decl@(TyData {})) ifName = rdrNameOcc (tcdName decl), ifTyVars = hsIfaceTvs (tcdTyVars decl), ifCtxt = hsIfaceCtxt (unLoc (tcdCtxt decl)), - ifCons = Unknown, ifRec = NonRecursive, + ifCons = hsIfaceCons (tcdCons decl), + ifRec = NonRecursive, ifVrcs = [], ifGeneric = False } -- I'm not sure that [] is right for ifVrcs, but -- since we don't use them I'm not going to fiddle @@ -261,6 +262,35 @@ hsIfaceDecl (TyClD decl@(ClassDecl {})) hsIfaceDecl decl = pprPanic "hsIfaceDecl" (ppr decl) +hsIfaceCons :: [LConDecl RdrName] -> DataConDetails IfaceConDecl +hsIfaceCons cons + | null cons -- data T a, meaning "constructors unspecified", not "no constructors" + = Unknown + | otherwise -- data T a = C1 | C2 + = DataCons (map (hsIfaceCon . unLoc) cons) + +hsIfaceCon :: ConDecl RdrName -> IfaceConDecl +hsIfaceCon (ConDecl lname ex_tvs ex_ctxt details) + = IfaceConDecl (get_occ lname) + (hsIfaceTvs ex_tvs) + (hsIfaceCtxt (unLoc ex_ctxt)) + (map (hsIfaceLType . getBangType . unLoc) args) + (map (hsStrictMark . getBangStrictness . unLoc) args) + flds + where + (args, flds) = case details of + PrefixCon args -> (args, []) + InfixCon a1 a2 -> ([a1,a2], []) + RecCon fs -> (map snd fs, map (get_occ . fst) fs) + get_occ lname = rdrNameOcc (unLoc lname) + +hsStrictMark :: HsBang -> StrictnessMark +-- Warning: in source files the {-# UNPACK #-} pragma (HsUnbox) is a request +-- but in an hi-boot file it's interpreted as the Truth! +hsStrictMark HsNoBang = NotMarkedStrict +hsStrictMark HsStrict = MarkedStrict +hsStrictMark HsUnbox = MarkedUnboxed + hsIfaceName rdr_name -- Qualify unqualifed occurrences -- with the module name | isUnqual rdr_name = LocalTop (rdrNameOcc rdr_name) diff --git a/ghc/docs/users_guide/separate_compilation.sgml b/ghc/docs/users_guide/separate_compilation.sgml index fe51108..262821e 100644 --- a/ghc/docs/users_guide/separate_compilation.sgml +++ b/ghc/docs/users_guide/separate_compilation.sgml @@ -948,6 +948,32 @@ newtype GHC.IOBase.IO a instances or derive them automatically. + + For data or newtype declaration, you may omit all +the constructors, thus: + +module A where + data TA + + (You must write all the type parameters, but omit the + '=' and everything that follows it.) In a source program + this would declare TA to have no constructors (a GHC extension: see ), + but in an hi-boot file it means "I don't know or care what the construtors are". + This is the most common form of data type declaration, because it's easy to get right. + + You can also write out the constructors but, if you do so, you must write + it out precisely as in its real definition. + It is especially delicate if you use a strictness annotation "!", + with or without an {-# UNPACK #-} pragma. In a source file + GHC may or may not choose to unbox the argument, but in an hi-boot file it's + assumed that you express the outcome of this decision. + (So in the cases where GHC decided not to unpack, you must not use the pragma.) + Tread with care. + + + For class declaration, you may not specify any class +operations. We could lift this restriction if it became tiresome. + Notice that we only put the declaration for the newtype @@ -955,18 +981,6 @@ newtype GHC.IOBase.IO a not the signature for f, since f isn't used by B. - If you want an hi-boot file to export a - data type, but you don't want to give its constructors (because - the constructors aren't used by the SOURCE-importing module), - you can write simply: - - -module A where -data TA - - - (You must write all the type parameters, but leave out the - '=' and everything that follows it.) -- 1.7.10.4