From b9312420f355a3b6f24f3bd732300d9e03f59268 Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 14 Mar 2002 15:47:55 +0000 Subject: [PATCH] [project @ 2002-03-14 15:47:52 by simonmar] Remove the interface file parser, and move .hi-boot parsing into the main parser. The syntax of .hi-boot files is now greatly improved in terms of readability; here's an example: module M where data T f :: T -> GHC.Base.Int note that (a) layout can be used (b) there's no explcit export list; everything declared is implicitly exported (c) Z-encoding of names is no longer required (d) Any identifier not declared in the current module must still be quailified with the module which originally defined it (eg. GHC.Base.Int above). We'd like to relax (d), but that will come later. --- ghc/compiler/basicTypes/DataCon.hi-boot-6 | 10 +- ghc/compiler/basicTypes/IdInfo.hi-boot-6 | 14 +- ghc/compiler/basicTypes/MkId.hi-boot-6 | 8 +- ghc/compiler/basicTypes/Module.hi-boot-6 | 6 +- ghc/compiler/basicTypes/Name.hi-boot-6 | 6 +- ghc/compiler/basicTypes/Var.hi-boot-6 | 13 +- ghc/compiler/codeGen/CgBindery.hi-boot-6 | 15 +- ghc/compiler/codeGen/CgExpr.hi-boot-6 | 6 +- ghc/compiler/codeGen/CgUsages.hi-boot-6 | 6 +- ghc/compiler/codeGen/ClosureInfo.hi-boot-6 | 8 +- ghc/compiler/coreSyn/CoreSyn.hi-boot-6 | 8 +- ghc/compiler/coreSyn/Subst.hi-boot-6 | 7 +- ghc/compiler/deSugar/DsExpr.hi-boot-6 | 8 +- ghc/compiler/deSugar/Match.hi-boot-6 | 31 +- ghc/compiler/hsSyn/HsExpr.hi-boot-6 | 18 +- ghc/compiler/nativeGen/MachMisc.hi-boot-6 | 13 +- ghc/compiler/nativeGen/StixPrim.hi-boot-6 | 6 +- ghc/compiler/parser/Ctype.lhs | 294 +-------- ghc/compiler/parser/Lex.lhs | 268 +-------- ghc/compiler/parser/ParseUtil.lhs | 25 +- ghc/compiler/parser/Parser.y | 58 +- ghc/compiler/rename/ParseIface.y | 892 ---------------------------- ghc/compiler/rename/RnBinds.hi-boot-6 | 9 +- ghc/compiler/rename/RnEnv.lhs | 4 +- ghc/compiler/rename/RnHiFiles.hi-boot-6 | 10 +- ghc/compiler/rename/RnHiFiles.lhs | 2 +- ghc/compiler/typecheck/TcEnv.hi-boot-6 | 6 +- ghc/compiler/typecheck/TcExpr.hi-boot-6 | 13 +- ghc/compiler/typecheck/TcMatches.hi-boot-6 | 13 +- ghc/compiler/typecheck/TcType.hi-boot-6 | 6 +- ghc/compiler/typecheck/TcUnify.hi-boot-6 | 6 +- ghc/compiler/types/Generics.hi-boot-6 | 6 +- ghc/compiler/types/PprType.hi-boot-6 | 8 +- ghc/compiler/types/TyCon.hi-boot-6 | 15 +- ghc/compiler/types/TypeRep.hi-boot-6 | 11 +- 35 files changed, 266 insertions(+), 1563 deletions(-) delete mode 100644 ghc/compiler/rename/ParseIface.y diff --git a/ghc/compiler/basicTypes/DataCon.hi-boot-6 b/ghc/compiler/basicTypes/DataCon.hi-boot-6 index 4359bbf..cdeeb9c 100644 --- a/ghc/compiler/basicTypes/DataCon.hi-boot-6 +++ b/ghc/compiler/basicTypes/DataCon.hi-boot-6 @@ -1,5 +1,5 @@ -__interface DataCon 1 0 where -__export DataCon DataCon dataConRepType isExistentialDataCon ; -1 data DataCon ; -1 dataConRepType :: DataCon -> TypeRep.Type ; -1 isExistentialDataCon :: DataCon -> GHCziBase.Bool ; +module DataCon where + +data DataCon +dataConRepType :: DataCon -> TypeRep.Type +isExistentialDataCon :: DataCon -> GHC.Base.Bool diff --git a/ghc/compiler/basicTypes/IdInfo.hi-boot-6 b/ghc/compiler/basicTypes/IdInfo.hi-boot-6 index ded7dfe..d29d826 100644 --- a/ghc/compiler/basicTypes/IdInfo.hi-boot-6 +++ b/ghc/compiler/basicTypes/IdInfo.hi-boot-6 @@ -1,8 +1,8 @@ -__interface IdInfo 1 0 where -__export IdInfo IdInfo GlobalIdDetails notGlobalId seqIdInfo vanillaIdInfo ; -1 data IdInfo ; -1 data GlobalIdDetails ; -1 notGlobalId :: GlobalIdDetails ; -1 seqIdInfo :: IdInfo -> GHCziBase.Z0T ; -1 vanillaIdInfo :: IdInfo ; +module IdInfo where +data IdInfo +data GlobalIdDetails + +notGlobalId :: GlobalIdDetails +seqIdInfo :: IdInfo -> GHC.Base.() +vanillaIdInfo :: IdInfo diff --git a/ghc/compiler/basicTypes/MkId.hi-boot-6 b/ghc/compiler/basicTypes/MkId.hi-boot-6 index 3d56963..0487ebe 100644 --- a/ghc/compiler/basicTypes/MkId.hi-boot-6 +++ b/ghc/compiler/basicTypes/MkId.hi-boot-6 @@ -1,5 +1,5 @@ -__interface MkId 1 0 where -__export MkId mkDataConId mkDataConWrapId ; -1 mkDataConId :: Name.Name -> DataCon.DataCon -> Var.Id ; -1 mkDataConWrapId :: DataCon.DataCon -> Var.Id ; +module MkId where + +mkDataConId :: Name.Name -> DataCon.DataCon -> Var.Id +mkDataConWrapId :: DataCon.DataCon -> Var.Id diff --git a/ghc/compiler/basicTypes/Module.hi-boot-6 b/ghc/compiler/basicTypes/Module.hi-boot-6 index cdc5fbf..7677859 100644 --- a/ghc/compiler/basicTypes/Module.hi-boot-6 +++ b/ghc/compiler/basicTypes/Module.hi-boot-6 @@ -1,4 +1,4 @@ -__interface Module 1 0 where -__export Module Module ; -1 data Module ; +module Module where + +data Module diff --git a/ghc/compiler/basicTypes/Name.hi-boot-6 b/ghc/compiler/basicTypes/Name.hi-boot-6 index 634d954..c4eeca4 100644 --- a/ghc/compiler/basicTypes/Name.hi-boot-6 +++ b/ghc/compiler/basicTypes/Name.hi-boot-6 @@ -1,3 +1,3 @@ -__interface Name 1 0 where -__export Name Name; -1 data Name ; +module Name where + +data Name diff --git a/ghc/compiler/basicTypes/Var.hi-boot-6 b/ghc/compiler/basicTypes/Var.hi-boot-6 index ee50bf2..2a9ec4f 100644 --- a/ghc/compiler/basicTypes/Var.hi-boot-6 +++ b/ghc/compiler/basicTypes/Var.hi-boot-6 @@ -1,8 +1,7 @@ -__interface Var 1 0 where -__export Var Var TyVar Id setIdName ; --- Used by Name -1 type Id = Var; -1 type TyVar = Var; -1 data Var ; -1 setIdName :: Id -> Name.Name -> Id ; +module Var where +-- Used by Name +type Id = Var +type TyVar = Var +data Var +setIdName :: Id -> Name.Name -> Id diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot-6 b/ghc/compiler/codeGen/CgBindery.hi-boot-6 index f375fcc..7d1f300 100644 --- a/ghc/compiler/codeGen/CgBindery.hi-boot-6 +++ b/ghc/compiler/codeGen/CgBindery.hi-boot-6 @@ -1,7 +1,8 @@ -__interface CgBindery 1 0 where -__export CgBindery CgBindings CgIdInfo VolatileLoc StableLoc nukeVolatileBinds; -1 type CgBindings = VarEnv.IdEnv CgIdInfo; -1 data CgIdInfo; -1 data VolatileLoc; -1 data StableLoc; -1 nukeVolatileBinds :: CgBindings -> CgBindings ; +module CgBindery where + +type CgBindings = VarEnv.IdEnv CgIdInfo +data CgIdInfo +data VolatileLoc +data StableLoc + +nukeVolatileBinds :: CgBindings -> CgBindings diff --git a/ghc/compiler/codeGen/CgExpr.hi-boot-6 b/ghc/compiler/codeGen/CgExpr.hi-boot-6 index 588e63f..dc2d75c 100644 --- a/ghc/compiler/codeGen/CgExpr.hi-boot-6 +++ b/ghc/compiler/codeGen/CgExpr.hi-boot-6 @@ -1,3 +1,3 @@ -__interface CgExpr 1 0 where -__export CgExpr cgExpr; -1 cgExpr :: StgSyn.StgExpr -> CgMonad.Code ; +module CgExpr where + +cgExpr :: StgSyn.StgExpr -> CgMonad.Code diff --git a/ghc/compiler/codeGen/CgUsages.hi-boot-6 b/ghc/compiler/codeGen/CgUsages.hi-boot-6 index abb98ce..9640603 100644 --- a/ghc/compiler/codeGen/CgUsages.hi-boot-6 +++ b/ghc/compiler/codeGen/CgUsages.hi-boot-6 @@ -1,3 +1,3 @@ -__interface CgUsages 1 0 where -__export CgUsages getSpRelOffset; -1 getSpRelOffset :: AbsCSyn.VirtualSpOffset -> CgMonad.FCode AbsCSyn.RegRelative ; +module CgUsages where + +getSpRelOffset :: AbsCSyn.VirtualSpOffset -> CgMonad.FCode AbsCSyn.RegRelative diff --git a/ghc/compiler/codeGen/ClosureInfo.hi-boot-6 b/ghc/compiler/codeGen/ClosureInfo.hi-boot-6 index 2291f93..d313ccd 100644 --- a/ghc/compiler/codeGen/ClosureInfo.hi-boot-6 +++ b/ghc/compiler/codeGen/ClosureInfo.hi-boot-6 @@ -1,4 +1,4 @@ -__interface ClosureInfo 1 0 where -__export ClosureInfo ClosureInfo LambdaFormInfo; -1 data LambdaFormInfo; -1 data ClosureInfo; +module ClosureInfo where + +data LambdaFormInfo +data ClosureInfo diff --git a/ghc/compiler/coreSyn/CoreSyn.hi-boot-6 b/ghc/compiler/coreSyn/CoreSyn.hi-boot-6 index 6031131..db6c755 100644 --- a/ghc/compiler/coreSyn/CoreSyn.hi-boot-6 +++ b/ghc/compiler/coreSyn/CoreSyn.hi-boot-6 @@ -1,6 +1,6 @@ -__interface CoreSyn 1 0 where -__export CoreSyn CoreExpr ; +module CoreSyn where -- Needed by Var.lhs -1 type CoreExpr = Expr Var.Var; -1 data Expr b ; +data Expr b +type CoreExpr = Expr Var.Var + diff --git a/ghc/compiler/coreSyn/Subst.hi-boot-6 b/ghc/compiler/coreSyn/Subst.hi-boot-6 index 7be51e9..065b99f 100644 --- a/ghc/compiler/coreSyn/Subst.hi-boot-6 +++ b/ghc/compiler/coreSyn/Subst.hi-boot-6 @@ -1,5 +1,4 @@ -__interface Subst 2 0 where -__export Subst Subst substTyWith ; -1 data Subst; -1 substTyWith :: [Var.TyVar] -> [TypeRep.Type] -> TypeRep.Type -> TypeRep.Type ; +module Subst where +data Subst +substTyWith :: [Var.TyVar] -> [TypeRep.Type] -> TypeRep.Type -> TypeRep.Type diff --git a/ghc/compiler/deSugar/DsExpr.hi-boot-6 b/ghc/compiler/deSugar/DsExpr.hi-boot-6 index 11c0fa0..5fffa1c 100644 --- a/ghc/compiler/deSugar/DsExpr.hi-boot-6 +++ b/ghc/compiler/deSugar/DsExpr.hi-boot-6 @@ -1,4 +1,4 @@ -__interface DsExpr 1 0 where -__export DsExpr dsExpr dsLet; -1 dsExpr :: TcHsSyn.TypecheckedHsExpr -> DsMonad.DsM CoreSyn.CoreExpr ; -1 dsLet :: TcHsSyn.TypecheckedHsBinds -> CoreSyn.CoreExpr -> DsMonad.DsM CoreSyn.CoreExpr ; +module DsExpr where + +dsExpr :: TcHsSyn.TypecheckedHsExpr -> DsMonad.DsM CoreSyn.CoreExpr +dsLet :: TcHsSyn.TypecheckedHsBinds -> CoreSyn.CoreExpr -> DsMonad.DsM CoreSyn.CoreExpr diff --git a/ghc/compiler/deSugar/Match.hi-boot-6 b/ghc/compiler/deSugar/Match.hi-boot-6 index 2e4d223..e7f5e1a 100644 --- a/ghc/compiler/deSugar/Match.hi-boot-6 +++ b/ghc/compiler/deSugar/Match.hi-boot-6 @@ -1,6 +1,25 @@ -__interface Match 1 0 where -__export Match match matchExport matchSimply matchSinglePat; -1 match :: [Var.Id] -> [DsUtils.EquationInfo] -> DsMonad.DsM DsUtils.MatchResult ; -1 matchExport :: [Var.Id] -> [DsUtils.EquationInfo] -> DsMonad.DsM DsUtils.MatchResult ; -1 matchSimply :: CoreSyn.CoreExpr -> HsExpr.HsMatchContext Var.Id -> TcHsSyn.TypecheckedPat -> CoreSyn.CoreExpr -> CoreSyn.CoreExpr -> DsMonad.DsM CoreSyn.CoreExpr ; -1 matchSinglePat :: CoreSyn.CoreExpr -> DsMonad.DsMatchContext -> TcHsSyn.TypecheckedPat -> DsUtils.MatchResult -> DsMonad.DsM DsUtils.MatchResult ; +module Match where + +match :: [Var.Id] + -> [DsUtils.EquationInfo] + -> DsMonad.DsM DsUtils.MatchResult + +matchExport + :: [Var.Id] + -> [DsUtils.EquationInfo] + -> DsMonad.DsM DsUtils.MatchResult + +matchSimply + :: CoreSyn.CoreExpr + -> HsExpr.HsMatchContext Var.Id + -> TcHsSyn.TypecheckedPat + -> CoreSyn.CoreExpr + -> CoreSyn.CoreExpr + -> DsMonad.DsM CoreSyn.CoreExpr + +matchSinglePat + :: CoreSyn.CoreExpr + -> DsMonad.DsMatchContext + -> TcHsSyn.TypecheckedPat + -> DsUtils.MatchResult + -> DsMonad.DsM DsUtils.MatchResult diff --git a/ghc/compiler/hsSyn/HsExpr.hi-boot-6 b/ghc/compiler/hsSyn/HsExpr.hi-boot-6 index bf952e3..fd32ceb 100644 --- a/ghc/compiler/hsSyn/HsExpr.hi-boot-6 +++ b/ghc/compiler/hsSyn/HsExpr.hi-boot-6 @@ -1,12 +1,14 @@ -__interface HsExpr 1 0 where -__export HsExpr HsExpr pprExpr Match GRHSs pprPatBind pprFunBind ; +module HsExpr where -1 data HsExpr i p ; -1 pprExpr :: __forall [i p] {Outputable.Outputable i, Outputable.Outputable p} => HsExpr.HsExpr i p -> Outputable.SDoc ; +data HsExpr i p +data Match a b +data GRHSs a b -1 data Match a b ; -1 data GRHSs a b ; +pprExpr :: (Outputable.Outputable i, Outputable.Outputable p) => + HsExpr.HsExpr i p -> Outputable.SDoc -1 pprPatBind :: __forall [i p] {Outputable.Outputable i, Outputable.Outputable p} => p -> HsExpr.GRHSs i p -> Outputable.SDoc ; -1 pprFunBind :: __forall [i p] {Outputable.Outputable i, Outputable.Outputable p} => i -> [HsExpr.Match i p] -> Outputable.SDoc ; +pprPatBind :: (Outputable.Outputable i, Outputable.Outputable p) => + p -> HsExpr.GRHSs i p -> Outputable.SDoc +pprFunBind :: (Outputable.Outputable i, Outputable.Outputable p) => + i -> [HsExpr.Match i p] -> Outputable.SDoc diff --git a/ghc/compiler/nativeGen/MachMisc.hi-boot-6 b/ghc/compiler/nativeGen/MachMisc.hi-boot-6 index 7d7b402..404ab2b 100644 --- a/ghc/compiler/nativeGen/MachMisc.hi-boot-6 +++ b/ghc/compiler/nativeGen/MachMisc.hi-boot-6 @@ -1,6 +1,7 @@ -__interface MachMisc 1 0 where -__export MachMisc Instr fixedHdrSize fmtAsmLbl underscorePrefix; -1 fixedHdrSize :: GHCziBase.Int ; -2 fmtAsmLbl :: GHCziBase.String -> GHCziBase.String ; -1 underscorePrefix :: GHCziBase.Bool ; -1 data Instr ; +module MachMisc where + +data Instr + +fixedHdrSize :: GHC.Base.Int +fmtAsmLbl :: GHC.Base.String -> GHC.Base.String +underscorePrefix :: GHC.Base.Bool diff --git a/ghc/compiler/nativeGen/StixPrim.hi-boot-6 b/ghc/compiler/nativeGen/StixPrim.hi-boot-6 index f1b3b9e..dcf9cc9 100644 --- a/ghc/compiler/nativeGen/StixPrim.hi-boot-6 +++ b/ghc/compiler/nativeGen/StixPrim.hi-boot-6 @@ -1,3 +1,3 @@ -__interface StixPrim 1 0 where -__export StixPrim amodeToStix; -1 amodeToStix :: AbsCSyn.CAddrMode -> Stix.StixExpr ; +module StixPrim where + +amodeToStix :: AbsCSyn.CAddrMode -> Stix.StixExpr diff --git a/ghc/compiler/parser/Ctype.lhs b/ghc/compiler/parser/Ctype.lhs index 645f31e..dc420ae 100644 --- a/ghc/compiler/parser/Ctype.lhs +++ b/ghc/compiler/parser/Ctype.lhs @@ -1,6 +1,8 @@ Character classification \begin{code} +{-# OPTIONS -#include "hs_ctype.h" #-} + module Ctype ( is_ident -- Char# -> Bool , is_symbol -- Char# -> Bool @@ -9,26 +11,20 @@ module Ctype , is_lower -- Char# -> Bool , is_upper -- Char# -> Bool , is_digit -- Char# -> Bool + , is_string -- Char# -> Bool ) where \end{code} \begin{code} import Bits ( Bits((.&.)) ) import Int ( Int32 ) +import Addr +import Char ( ord ) import GlaExts ( Char#, Char(..) ) \end{code} -Bit masks - -\begin{code} -cIdent, cSymbol, cAny, cSpace, cLower, cUpper, cDigit :: Int -cIdent = 1 -cSymbol = 2 -cAny = 4 -cSpace = 8 -cLower = 16 -cUpper = 32 -cDigit = 64 +#define NO_CDECLS +#include \end{code} The predicates below look costly, but aren't, GHC+GCC do a great job @@ -39,7 +35,17 @@ at the big case below. is_ctype :: Int -> Char# -> Bool is_ctype mask c = (fromIntegral (charType (C# c)) .&. fromIntegral mask) /= (0::Int32) -is_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit :: Char# -> Bool +cIdent, cSymbol, cAny, cSpace, cLower, cUpper, cDigit, cString :: Int +cIdent = C_Ident :: Int +cSymbol = C_Symbol :: Int +cAny = C_Any :: Int +cSpace = C_Space :: Int +cLower = C_Lower :: Int +cUpper = C_Upper :: Int +cDigit = C_Digit :: Int +cString = C_String :: Int + +is_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit, is_string :: Char# -> Bool is_ident = is_ctype cIdent is_symbol = is_ctype cSymbol is_any = is_ctype cAny @@ -47,268 +53,10 @@ is_space = is_ctype cSpace is_lower = is_ctype cLower is_upper = is_ctype cUpper is_digit = is_ctype cDigit -\end{code} +is_string = is_ctype cString -We really mean .|. instead of + below, but GHC currently doesn't do -any constant folding with bitops. *sigh* +foreign label "hs_char_types" hs_char_types :: Addr -\begin{code} charType :: Char -> Int -charType c = case c of - '\0' -> 0 -- \000 - '\1' -> 0 -- \001 - '\2' -> 0 -- \002 - '\3' -> 0 -- \003 - '\4' -> 0 -- \004 - '\5' -> 0 -- \005 - '\6' -> 0 -- \006 - '\7' -> 0 -- \007 - '\8' -> 0 -- \010 - '\9' -> cAny + cSpace -- \t - '\10' -> cAny + cSpace -- \n - '\11' -> cAny + cSpace -- \v - '\12' -> cAny + cSpace -- \f - '\13' -> cAny + cSpace -- ^M - '\14' -> 0 -- \016 - '\15' -> 0 -- \017 - '\16' -> 0 -- \020 - '\17' -> 0 -- \021 - '\18' -> 0 -- \022 - '\19' -> 0 -- \023 - '\20' -> 0 -- \024 - '\21' -> 0 -- \025 - '\22' -> 0 -- \026 - '\23' -> 0 -- \027 - '\24' -> 0 -- \030 - '\25' -> 0 -- \031 - '\26' -> 0 -- \032 - '\27' -> 0 -- \033 - '\28' -> 0 -- \034 - '\29' -> 0 -- \035 - '\30' -> 0 -- \036 - '\31' -> 0 -- \037 - '\32' -> cAny + cSpace -- - '\33' -> cAny + cSymbol -- ! - '\34' -> cAny -- " - '\35' -> cAny + cSymbol -- # - '\36' -> cAny + cSymbol -- $ - '\37' -> cAny + cSymbol -- % - '\38' -> cAny + cSymbol -- & - '\39' -> cAny + cIdent -- ' - '\40' -> cAny -- ( - '\41' -> cAny -- ) - '\42' -> cAny + cSymbol -- * - '\43' -> cAny + cSymbol -- + - '\44' -> cAny -- , - '\45' -> cAny + cSymbol -- - - '\46' -> cAny + cSymbol -- . - '\47' -> cAny + cSymbol -- / - '\48' -> cAny + cIdent + cDigit -- 0 - '\49' -> cAny + cIdent + cDigit -- 1 - '\50' -> cAny + cIdent + cDigit -- 2 - '\51' -> cAny + cIdent + cDigit -- 3 - '\52' -> cAny + cIdent + cDigit -- 4 - '\53' -> cAny + cIdent + cDigit -- 5 - '\54' -> cAny + cIdent + cDigit -- 6 - '\55' -> cAny + cIdent + cDigit -- 7 - '\56' -> cAny + cIdent + cDigit -- 8 - '\57' -> cAny + cIdent + cDigit -- 9 - '\58' -> cAny + cSymbol -- : - '\59' -> cAny -- ; - '\60' -> cAny + cSymbol -- < - '\61' -> cAny + cSymbol -- = - '\62' -> cAny + cSymbol -- > - '\63' -> cAny + cSymbol -- ? - '\64' -> cAny + cSymbol -- @ - '\65' -> cAny + cIdent + cUpper -- A - '\66' -> cAny + cIdent + cUpper -- B - '\67' -> cAny + cIdent + cUpper -- C - '\68' -> cAny + cIdent + cUpper -- D - '\69' -> cAny + cIdent + cUpper -- E - '\70' -> cAny + cIdent + cUpper -- F - '\71' -> cAny + cIdent + cUpper -- G - '\72' -> cAny + cIdent + cUpper -- H - '\73' -> cAny + cIdent + cUpper -- I - '\74' -> cAny + cIdent + cUpper -- J - '\75' -> cAny + cIdent + cUpper -- K - '\76' -> cAny + cIdent + cUpper -- L - '\77' -> cAny + cIdent + cUpper -- M - '\78' -> cAny + cIdent + cUpper -- N - '\79' -> cAny + cIdent + cUpper -- O - '\80' -> cAny + cIdent + cUpper -- P - '\81' -> cAny + cIdent + cUpper -- Q - '\82' -> cAny + cIdent + cUpper -- R - '\83' -> cAny + cIdent + cUpper -- S - '\84' -> cAny + cIdent + cUpper -- T - '\85' -> cAny + cIdent + cUpper -- U - '\86' -> cAny + cIdent + cUpper -- V - '\87' -> cAny + cIdent + cUpper -- W - '\88' -> cAny + cIdent + cUpper -- X - '\89' -> cAny + cIdent + cUpper -- Y - '\90' -> cAny + cIdent + cUpper -- Z - '\91' -> cAny -- [ - '\92' -> cAny + cSymbol -- backslash - '\93' -> cAny -- ] - '\94' -> cAny + cSymbol -- ^ - '\95' -> cAny + cIdent + cLower -- _ - '\96' -> cAny -- ` - '\97' -> cAny + cIdent + cLower -- a - '\98' -> cAny + cIdent + cLower -- b - '\99' -> cAny + cIdent + cLower -- c - '\100' -> cAny + cIdent + cLower -- d - '\101' -> cAny + cIdent + cLower -- e - '\102' -> cAny + cIdent + cLower -- f - '\103' -> cAny + cIdent + cLower -- g - '\104' -> cAny + cIdent + cLower -- h - '\105' -> cAny + cIdent + cLower -- i - '\106' -> cAny + cIdent + cLower -- j - '\107' -> cAny + cIdent + cLower -- k - '\108' -> cAny + cIdent + cLower -- l - '\109' -> cAny + cIdent + cLower -- m - '\110' -> cAny + cIdent + cLower -- n - '\111' -> cAny + cIdent + cLower -- o - '\112' -> cAny + cIdent + cLower -- p - '\113' -> cAny + cIdent + cLower -- q - '\114' -> cAny + cIdent + cLower -- r - '\115' -> cAny + cIdent + cLower -- s - '\116' -> cAny + cIdent + cLower -- t - '\117' -> cAny + cIdent + cLower -- u - '\118' -> cAny + cIdent + cLower -- v - '\119' -> cAny + cIdent + cLower -- w - '\120' -> cAny + cIdent + cLower -- x - '\121' -> cAny + cIdent + cLower -- y - '\122' -> cAny + cIdent + cLower -- z - '\123' -> cAny -- { - '\124' -> cAny + cSymbol -- | - '\125' -> cAny -- } - '\126' -> cAny + cSymbol -- ~ - '\127' -> 0 -- \177 - '\128' -> 0 -- \200 - '\129' -> 0 -- \201 - '\130' -> 0 -- \202 - '\131' -> 0 -- \203 - '\132' -> 0 -- \204 - '\133' -> 0 -- \205 - '\134' -> 0 -- \206 - '\135' -> 0 -- \207 - '\136' -> 0 -- \210 - '\137' -> 0 -- \211 - '\138' -> 0 -- \212 - '\139' -> 0 -- \213 - '\140' -> 0 -- \214 - '\141' -> 0 -- \215 - '\142' -> 0 -- \216 - '\143' -> 0 -- \217 - '\144' -> 0 -- \220 - '\145' -> 0 -- \221 - '\146' -> 0 -- \222 - '\147' -> 0 -- \223 - '\148' -> 0 -- \224 - '\149' -> 0 -- \225 - '\150' -> 0 -- \226 - '\151' -> 0 -- \227 - '\152' -> 0 -- \230 - '\153' -> 0 -- \231 - '\154' -> 0 -- \232 - '\155' -> 0 -- \233 - '\156' -> 0 -- \234 - '\157' -> 0 -- \235 - '\158' -> 0 -- \236 - '\159' -> 0 -- \237 - '\160' -> cSpace -- - '\161' -> cAny + cSymbol -- ¡ - '\162' -> cAny + cSymbol -- ¢ - '\163' -> cAny + cSymbol -- £ - '\164' -> cAny + cSymbol -- ¤ - '\165' -> cAny + cSymbol -- ¥ - '\166' -> cAny + cSymbol -- ¦ - '\167' -> cAny + cSymbol -- § - '\168' -> cAny + cSymbol -- ¨ - '\169' -> cAny + cSymbol -- © - '\170' -> cAny + cSymbol -- ª - '\171' -> cAny + cSymbol -- « - '\172' -> cAny + cSymbol -- ¬ - '\173' -> cAny + cSymbol -- ­ - '\174' -> cAny + cSymbol -- ® - '\175' -> cAny + cSymbol -- ¯ - '\176' -> cAny + cSymbol -- ° - '\177' -> cAny + cSymbol -- ± - '\178' -> cAny + cSymbol -- ² - '\179' -> cAny + cSymbol -- ³ - '\180' -> cAny + cSymbol -- ´ - '\181' -> cAny + cSymbol -- µ - '\182' -> cAny + cSymbol -- ¶ - '\183' -> cAny + cSymbol -- · - '\184' -> cAny + cSymbol -- ¸ - '\185' -> cAny + cSymbol -- ¹ - '\186' -> cAny + cSymbol -- º - '\187' -> cAny + cSymbol -- » - '\188' -> cAny + cSymbol -- ¼ - '\189' -> cAny + cSymbol -- ½ - '\190' -> cAny + cSymbol -- ¾ - '\191' -> cAny + cSymbol -- ¿ - '\192' -> cAny + cIdent + cUpper -- À - '\193' -> cAny + cIdent + cUpper -- Á - '\194' -> cAny + cIdent + cUpper -- Â - '\195' -> cAny + cIdent + cUpper -- Ã - '\196' -> cAny + cIdent + cUpper -- Ä - '\197' -> cAny + cIdent + cUpper -- Å - '\198' -> cAny + cIdent + cUpper -- Æ - '\199' -> cAny + cIdent + cUpper -- Ç - '\200' -> cAny + cIdent + cUpper -- È - '\201' -> cAny + cIdent + cUpper -- É - '\202' -> cAny + cIdent + cUpper -- Ê - '\203' -> cAny + cIdent + cUpper -- Ë - '\204' -> cAny + cIdent + cUpper -- Ì - '\205' -> cAny + cIdent + cUpper -- Í - '\206' -> cAny + cIdent + cUpper -- Î - '\207' -> cAny + cIdent + cUpper -- Ï - '\208' -> cAny + cIdent + cUpper -- Ð - '\209' -> cAny + cIdent + cUpper -- Ñ - '\210' -> cAny + cIdent + cUpper -- Ò - '\211' -> cAny + cIdent + cUpper -- Ó - '\212' -> cAny + cIdent + cUpper -- Ô - '\213' -> cAny + cIdent + cUpper -- Õ - '\214' -> cAny + cIdent + cUpper -- Ö - '\215' -> cAny + cSymbol + cLower -- × - '\216' -> cAny + cIdent + cUpper -- Ø - '\217' -> cAny + cIdent + cUpper -- Ù - '\218' -> cAny + cIdent + cUpper -- Ú - '\219' -> cAny + cIdent + cUpper -- Û - '\220' -> cAny + cIdent + cUpper -- Ü - '\221' -> cAny + cIdent + cUpper -- Ý - '\222' -> cAny + cIdent + cUpper -- Þ - '\223' -> cAny + cIdent -- ß - '\224' -> cAny + cIdent + cLower -- à - '\225' -> cAny + cIdent + cLower -- á - '\226' -> cAny + cIdent + cLower -- â - '\227' -> cAny + cIdent + cLower -- ã - '\228' -> cAny + cIdent + cLower -- ä - '\229' -> cAny + cIdent + cLower -- å - '\230' -> cAny + cIdent + cLower -- æ - '\231' -> cAny + cIdent + cLower -- ç - '\232' -> cAny + cIdent + cLower -- è - '\233' -> cAny + cIdent + cLower -- é - '\234' -> cAny + cIdent + cLower -- ê - '\235' -> cAny + cIdent + cLower -- ë - '\236' -> cAny + cIdent + cLower -- ì - '\237' -> cAny + cIdent + cLower -- í - '\238' -> cAny + cIdent + cLower -- î - '\239' -> cAny + cIdent + cLower -- ï - '\240' -> cAny + cIdent + cLower -- ð - '\241' -> cAny + cIdent + cLower -- ñ - '\242' -> cAny + cIdent + cLower -- ò - '\243' -> cAny + cIdent + cLower -- ó - '\244' -> cAny + cIdent + cLower -- ô - '\245' -> cAny + cIdent + cLower -- õ - '\246' -> cAny + cIdent + cLower -- ö - '\247' -> cAny + cSymbol -- ÷ - '\248' -> cAny + cIdent -- ø - '\249' -> cAny + cIdent + cLower -- ù - '\250' -> cAny + cIdent + cLower -- ú - '\251' -> cAny + cIdent + cLower -- û - '\252' -> cAny + cIdent + cLower -- ü - '\253' -> cAny + cIdent + cLower -- ý - '\254' -> cAny + cIdent + cLower -- þ - '\255' -> cAny + cIdent + cLower -- ÿ +charType c = ord (indexCharOffAddr hs_char_types (ord c)) \end{code} diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs index 2eb564a..344849d 100644 --- a/ghc/compiler/parser/Lex.lhs +++ b/ghc/compiler/parser/Lex.lhs @@ -16,14 +16,14 @@ An example that provokes the error is -------------------------------------------------------- \begin{code} - +{-# OPTIONS -#include "hs_ctype.h" #-} module Lex ( - ifaceParseErr, srcParseErr, + srcParseErr, -- Monad for parser Token(..), lexer, ParseResult(..), PState(..), - checkVersion, ExtFlags(..), mkPState, + ExtFlags(..), mkPState, StringBuffer, P, thenP, thenP_, returnP, mapP, failP, failMsgP, @@ -33,14 +33,10 @@ module Lex ( #include "HsVersions.h" -import Char ( isSpace, toUpper ) -import List ( isSuffixOf ) +import Char ( toUpper ) import PrelNames ( mkTupNameStr ) -import CmdLineOpts ( opt_HiVersion, opt_NoHiCheck ) import ForeignCall ( Safety(..) ) -import NewDemand ( StrictSig(..), Demand(..), Demands(..), - DmdResult(..), mkTopDmdType, evalDmd, lazyDmd ) import UniqFM ( listToUFM, lookupUFM ) import BasicTypes ( Boxity(..) ) import SrcLoc ( SrcLoc, incSrcLine, srcLocFile, srcLocLine, @@ -133,41 +129,7 @@ data Token | ITstdcallconv | ITccallconv | ITdotnet - - | ITinterface -- interface keywords - | IT__export - | ITdepends - | IT__forall - | ITletrec - | ITcoerce - | ITinlineMe - | ITinlineCall | ITccall (Bool,Bool,Safety) -- (is_dyn, is_casm, may_gc) - | ITdefaultbranch - | ITbottom - | ITinteger_lit - | ITfloat_lit - | ITword_lit - | ITword64_lit - | ITint64_lit - | ITrational_lit - | ITaddr_lit - | ITlabel_lit - | ITlit_lit - | ITstring_lit - | ITtypeapp - | ITusage - | ITfuall - | ITarity - | ITspecialise - | ITnocaf - | ITunfold - | ITstrict StrictSig - | ITrules - | ITcprinfo - | ITdeprecated - | IT__scc - | ITsccAllCafs | ITspecialise_prag -- Pragmas | ITsource_prag @@ -331,50 +293,7 @@ ghcExtensionKeywordsFM = listToUFM $ ("_ccall_", ITccall (False, False, PlayRisky)), ("_ccall_GC_", ITccall (False, False, PlaySafe False)), ("_casm_", ITccall (False, True, PlayRisky)), - ("_casm_GC_", ITccall (False, True, PlaySafe False)), - - -- interface keywords - ("__interface", ITinterface), - ("__export", IT__export), - ("__depends", ITdepends), - ("__forall", IT__forall), - ("__letrec", ITletrec), - ("__coerce", ITcoerce), - ("__inline_me", ITinlineMe), - ("__inline_call", ITinlineCall), - ("__depends", ITdepends), - ("__DEFAULT", ITdefaultbranch), - ("__bot", ITbottom), - ("__integer", ITinteger_lit), - ("__float", ITfloat_lit), - ("__int64", ITint64_lit), - ("__word", ITword_lit), - ("__word64", ITword64_lit), - ("__rational", ITrational_lit), - ("__addr", ITaddr_lit), - ("__label", ITlabel_lit), - ("__litlit", ITlit_lit), - ("__string", ITstring_lit), - ("__a", ITtypeapp), - ("__u", ITusage), - ("__fuall", ITfuall), - ("__A", ITarity), - ("__P", ITspecialise), - ("__C", ITnocaf), - ("__R", ITrules), - ("__D", ITdeprecated), - ("__U", ITunfold), - - ("__ccall", ITccall (False, False, PlayRisky)), - ("__ccall_GC", ITccall (False, False, PlaySafe False)), - ("__dyn_ccall", ITccall (True, False, PlayRisky)), - ("__dyn_ccall_GC", ITccall (True, False, PlaySafe False)), - ("__casm", ITccall (False, True, PlayRisky)), - ("__dyn_casm", ITccall (True, True, PlayRisky)), - ("__casm_GC", ITccall (False, True, PlaySafe False)), - ("__dyn_casm_GC", ITccall (True, True, PlaySafe False)), - - ("/\\", ITbiglam) + ("_casm_GC_", ITccall (False, True, PlaySafe False)) ] @@ -453,7 +372,6 @@ lexer cont buf s@(PState{ -- processing if necessary). '{'# | lookAhead# buf 1# `eqChar#` '-'# -> if lookAhead# buf 2# `eqChar#` '#'# then - if lookAhead# buf 3# `eqChar#` '#'# then is_a_token else case expandWhile# is_space (setCurrentPos# buf 3#) of { buf1-> case expandWhile# is_ident (stepOverLexeme buf1) of { buf2-> let lexeme = mkFastString -- ToDo: too slow @@ -633,19 +551,12 @@ lexToken cont exts buf = | otherwise -> cont ITbackquote (incLexeme buf) - '{'# -> -- look for "{-##" special iface pragma -- for Emacs: -} + '{'# -> -- for Emacs: -} case lookAhead# buf 1# of '|'# | glaExtsEnabled exts -> cont ITocurlybar (setCurrentPos# buf 2#) '-'# -> case lookAhead# buf 2# of - '#'# -> case lookAhead# buf 3# of - '#'# -> - lexPragma - cont - (\ cont lexeme buf' -> cont (ITpragma lexeme) buf') - 0# - (stepOnBy# (stepOverLexeme buf) 4#) - _ -> lex_prag cont (setCurrentPos# buf 3#) + '#'# -> lex_prag cont (setCurrentPos# buf 3#) _ -> cont ITocurly (incLexeme buf) _ -> (layoutOff `thenP_` cont ITocurly) (incLexeme buf) @@ -653,23 +564,6 @@ lexToken cont exts buf = '\"'#{-"-} -> lex_string cont exts [] (incLexeme buf) '\''# -> lex_char (char_end cont) exts (incLexeme buf) - -- strictness and cpr pragmas and __scc treated specially. - '_'# | glaExtsEnabled exts -> - case lookAhead# buf 1# of - '_'# -> case lookAhead# buf 2# of - 'S'# -> - lex_demand cont (stepOnUntil (not . isSpace) - (stepOnBy# buf 3#)) -- past __S - 'M'# -> - cont ITcprinfo (stepOnBy# buf 3#) -- past __M - - 's'# -> - case prefixMatch (stepOnBy# buf 3#) "cc" of - Just buf' -> lex_scc cont (stepOverLexeme buf') - Nothing -> lex_id cont exts buf - _ -> lex_id cont exts buf - _ -> lex_id cont exts buf - -- Hexadecimal and octal constants '0'# | (ch `eqChar#` 'x'# || ch `eqChar#` 'X'#) && is_hexdigit ch2 -> readNum (after_lexnum cont exts) buf' is_hexdigit 16 hex @@ -862,56 +756,6 @@ silly_escape_chars = [ ("DEL", '\DEL') ] -------------------------------------------------------------------------------- - -lex_demand cont buf = - case read_em [] buf of { (ls,buf') -> - case currentChar# buf' of - 'b'# -> cont (ITstrict (StrictSig (mkTopDmdType ls BotRes))) (incLexeme buf') - 'm'# -> cont (ITstrict (StrictSig (mkTopDmdType ls RetCPR))) (incLexeme buf') - _ -> cont (ITstrict (StrictSig (mkTopDmdType ls TopRes))) buf' - } - where - read_em acc buf = - case currentChar# buf of - 'T'# -> read_em (Top : acc) (stepOn buf) - 'L'# -> read_em (lazyDmd : acc) (stepOn buf) - 'A'# -> read_em (Abs : acc) (stepOn buf) - 'V'# -> read_em (evalDmd : acc) (stepOn buf) -- Temporary, until - -- we've recompiled prelude etc - 'C'# -> do_unary Call acc (stepOnBy# buf 2#) -- Skip 'C(' - - 'U'# -> do_seq1 Eval acc (stepOnBy# buf 1#) - 'D'# -> do_seq1 Defer acc (stepOnBy# buf 1#) - 'S'# -> do_seq1 (Box . Eval) acc (stepOnBy# buf 1#) - - _ -> (reverse acc, buf) - - do_seq1 fn acc buf - = case currentChar# buf of - '('# -> do_seq2 fn acc (stepOnBy# buf 1#) - _ -> read_em (fn (Poly Abs) : acc) buf - - do_seq2 fn acc buf - = case read_em [] buf of { (dmds, buf) -> - case currentChar# buf of - ')'# -> read_em (fn (Prod dmds) : acc) - (stepOn buf) - '*'# -> ASSERT( length dmds == 1 ) - read_em (fn (Poly (head dmds)) : acc) - (stepOnBy# buf 2#) -- Skip '*)' - } - - do_unary fn acc buf - = case read_em [] buf of - ([dmd], rest) -> read_em (fn dmd : acc) (stepOn rest) -- Skip ')' - ------------------- -lex_scc cont buf = - case currentChar# buf of - 'C'# -> cont ITsccAllCafs (incLexeme buf) - other -> cont ITscc buf - ----------------------------------------------------------------------------- -- Numbers @@ -986,10 +830,11 @@ lex_id cont exts buf = case (if glaExtsEnabled exts then expandWhile# (eqChar# '#'#) buf1 -- slurp trailing hashes else buf1) of { buf' -> + seq buf' $ let lexeme = lexemeToFastString buf' in - case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM lexeme of { + case _scc_ "haskellKeyword" lookupUFM haskellKeywordsFM lexeme of { Just kwd_token -> --trace ("hkeywd: "++_UNPK_(lexeme)) $ cont kwd_token buf'; Nothing -> @@ -1108,7 +953,7 @@ lex_id3 cont exts mod buf just_a_conid new_buf = mergeLexemes buf buf' is_a_qvarid = cont (mk_qvar_token mod lexeme) new_buf in - case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM lexeme of { + case _scc_ "haskellKeyword" lookupUFM haskellKeywordsFM lexeme of { Nothing -> is_a_qvarid ; Just kwd_token | isSpecial kwd_token -- special ids (as, qualified, hiding) shouldn't be @@ -1168,57 +1013,6 @@ lex_ubx_tuple cont mod buf back_off = \end{code} ----------------------------------------------------------------------------- -'lexPragma' rips along really fast, looking for a '##-}', -indicating the end of the pragma we're skipping - -\begin{code} -lexPragma cont contf inStr buf = - case currentChar# buf of - '#'# | inStr ==# 0# -> - case lookAhead# buf 1# of { '#'# -> - case lookAhead# buf 2# of { '-'# -> - case lookAhead# buf 3# of { '}'# -> - contf cont (lexemeToBuffer buf) - (stepOverLexeme (setCurrentPos# buf 4#)); - _ -> lexPragma cont contf inStr (incLexeme buf) }; - _ -> lexPragma cont contf inStr (incLexeme buf) }; - _ -> lexPragma cont contf inStr (incLexeme buf) } - - '"'# -> - let - odd_slashes buf flg i# = - case lookAhead# buf i# of - '\\'# -> odd_slashes buf (not flg) (i# -# 1#) - _ -> flg - - not_inStr = if inStr ==# 0# then 1# else 0# - in - case lookAhead# buf (negateInt# 1#) of --backwards, actually - '\\'# -> -- escaping something.. - if odd_slashes buf True (negateInt# 2#) - then -- odd number of slashes, " is escaped. - lexPragma cont contf inStr (incLexeme buf) - else -- even number of slashes, \ is escaped. - lexPragma cont contf not_inStr (incLexeme buf) - _ -> lexPragma cont contf not_inStr (incLexeme buf) - - '\''# | inStr ==# 0# -> - case lookAhead# buf 1# of { '"'# -> - case lookAhead# buf 2# of { '\''# -> - lexPragma cont contf inStr (setCurrentPos# buf 3#); - _ -> lexPragma cont contf inStr (incLexeme buf) }; - _ -> lexPragma cont contf inStr (incLexeme buf) } - - -- a sign that the input is ill-formed, since pragmas are - -- assumed to always be properly closed (in .hi files). - '\NUL'# -> trace "lexPragma: unexpected end-of-file" $ - cont (ITunknown "\NUL") buf - - _ -> lexPragma cont contf inStr (incLexeme buf) - -\end{code} - ------------------------------------------------------------------------------ \begin{code} data LayoutContext @@ -1359,30 +1153,6 @@ popContext = \ buf s@(PState{ context = ctx, loc = loc }) -> (_:tl) -> POk s{ context = tl } () [] -> PFailed (srcParseErr buf loc) -{- - Note that if the name of the file we're processing ends - with `hi-boot', we accept it on faith as having the right - version. This is done so that .hi-boot files that comes - with hsc don't have to be updated before every release, - *and* it allows us to share .hi-boot files with versions - of hsc that don't have .hi version checking (e.g., ghc-2.10's) - - If the version number is 0, the checking is also turned off. - (needed to deal with GHC.hi only!) - - Once we can assume we're compiling with a version of ghc that - supports interface file checking, we can drop the special - pleading --} -checkVersion :: Maybe Integer -> P () -checkVersion mb@(Just v) buf s@(PState{loc = loc}) - | (v==0) || (v == fromIntegral opt_HiVersion) || opt_NoHiCheck = POk s () - | otherwise = PFailed (ifaceVersionErr mb loc ([]::[Token]){-Todo-}) -checkVersion mb@Nothing buf s@(PState{loc = loc}) - | "hi-boot" `isSuffixOf` (_UNPK_ (srcLocFile loc)) = POk s () - | otherwise = PFailed (ifaceVersionErr mb loc ([]::[Token]){-Todo-}) - - -- for reasons of efficiency, flags indicating language extensions (eg, -- -fglasgow-exts or -fparr) are represented by a bitmap stored in an unboxed -- integer @@ -1427,24 +1197,6 @@ mkPState loc exts = PState { b `setBitIf` cond | cond = bit b | otherwise = 0 - ------------------------------------------------------------------ - -ifaceParseErr :: StringBuffer -> SrcLoc -> Message -ifaceParseErr s l - = hsep [ppr l, ptext SLIT("Interface file parse error; on input `"), - text (lexemeToString s), char '\''] - -ifaceVersionErr hi_vers l toks - = hsep [ppr l, ptext SLIT("Interface file version error;"), - ptext SLIT("Expected"), int opt_HiVersion, - ptext SLIT("found "), pp_version] - where - pp_version = - case hi_vers of - Nothing -> ptext SLIT("pre ghc-3.02 version") - Just v -> ptext SLIT("version") <+> integer v - ----------------------------------------------------------------------------- srcParseErr :: StringBuffer -> SrcLoc -> Message diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs index f65fdd2..9b8b6c9 100644 --- a/ghc/compiler/parser/ParseUtil.lhs +++ b/ghc/compiler/parser/ParseUtil.lhs @@ -11,6 +11,8 @@ module ParseUtil ( , mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp , groupBindings + , mkIfaceExports -- :: [RdrNameTyClDecl] -> [RdrExportItem] + , CallConv(..) , mkImport -- CallConv -> Safety -- -> (FAST_STRING, RdrName, RdrNameHsType) @@ -39,17 +41,12 @@ module ParseUtil ( import List ( isSuffixOf ) import Lex +import HscTypes ( RdrAvailInfo, GenAvailInfo(..) ) import HsSyn -- Lots of it import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..), DNCallSpec(..)) import SrcLoc -import RdrHsSyn ( RdrBinding(..), - RdrNameHsType, RdrNameBangType, RdrNameContext, - RdrNameHsTyVar, RdrNamePat, RdrNameHsExpr, - RdrNameGRHSs, RdrNameHsRecordBinds, - RdrNameMonoBinds, RdrNameConDetails, RdrNameHsDecl, - mkNPlusKPat - ) +import RdrHsSyn import RdrName import PrelNames ( unitTyCon_RDR ) import OccName ( dataName, varName, tcClsName, @@ -439,4 +436,18 @@ groupBindings binds = group Nothing binds = case bind of RdrValBinding b@(FunMonoBind _ _ _ _) -> group (Just b) binds other -> bind `RdrAndBindings` group Nothing binds + +-- --------------------------------------------------------------------------- +-- Make the export list for an interface + +mkIfaceExports :: [RdrNameTyClDecl] -> [RdrAvailInfo] +mkIfaceExports decls = map getExport decls + where getExport d = case d of + TyData{} -> tc_export + ClassDecl{} -> tc_export + _other -> var_export + where + tc_export = AvailTC (rdrNameOcc (tcdName d)) + (map (rdrNameOcc.fst) (tyClDeclNames d)) + var_export = Avail (rdrNameOcc (tcdName d)) \end{code} diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 38a2dae..88c0ad9 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- -*-haskell-*- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.92 2002/03/04 17:01:31 simonmar Exp $ +$Id: Parser.y,v 1.93 2002/03/14 15:47:54 simonmar Exp $ Haskell grammar. @@ -9,12 +9,13 @@ Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999 -} { -module Parser ( parseModule, parseStmt, parseIdentifier ) where +module Parser ( parseModule, parseStmt, parseIdentifier, parseIface ) where import HsSyn import HsTypes ( mkHsTupCon ) import RdrHsSyn +import RnMonad ( ParsedIface(..) ) import Lex import ParseUtil import RdrName @@ -28,7 +29,7 @@ import OccName ( UserFS, varName, tcName, dataName, tcClsName, tvName ) import TyCon ( DataConDetails(..) ) import SrcLoc ( SrcLoc ) import Module -import CmdLineOpts ( opt_SccProfilingOn ) +import CmdLineOpts ( opt_SccProfilingOn, opt_InPackage ) import Type ( Kind, mkArrowKind, liftedTypeKind ) import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..), NewOrData(..), StrictnessMark(..), Activation(..) ) @@ -222,6 +223,7 @@ Conflicts: 21 shift/reduce, -=chak[4Feb2] %name parseModule module %name parseStmt maybe_stmt %name parseIdentifier identifier +%name parseIface iface %tokentype { Token } %% @@ -258,6 +260,56 @@ cvtopdecls :: { [RdrNameHsDecl] } : topdecls { cvTopDecls (groupBindings $1)} ----------------------------------------------------------------------------- +-- Interfaces (.hi-boot files) + +iface :: { ParsedIface } + : 'module' modid 'where' ifacebody + { ParsedIface { + pi_mod = $2, + pi_pkg = opt_InPackage, + pi_vers = 1, -- Module version + pi_orphan = False, + pi_exports = (1,[($2,mkIfaceExports $4)]), + pi_usages = [], + pi_fixity = [], + pi_insts = [], + pi_decls = map (\x -> (1,x)) $4, + pi_rules = (1,[]), + pi_deprecs = Nothing + } + } + +ifacebody :: { [RdrNameTyClDecl] } + : '{' ifacedecls '}' { $2 } + | layout_on ifacedecls close { $2 } + +ifacedecls :: { [RdrNameTyClDecl] } + : ifacedecl ';' ifacedecls { $1 : $3 } + | ';' ifacedecls { $2 } + | ifacedecl { [$1] } + | {- empty -} { [] } + +ifacedecl :: { RdrNameTyClDecl } + : srcloc 'data' tycl_hdr constrs + { mkTyData DataType $3 (DataCons (reverse $4)) Nothing $1 } + + | srcloc 'newtype' tycl_hdr '=' newconstr + { mkTyData NewType $3 (DataCons [$5]) Nothing $1 } + + | srcloc 'class' tycl_hdr fds where + { let + (binds,sigs) = cvMonoBindsAndSigs cvClassOpSig + (groupBindings $5) + in + mkClassDecl $3 $4 sigs (Just binds) $1 } + + | srcloc 'type' tycon tv_bndrs '=' ctype + { TySynonym $3 $4 $6 $1 } + + | srcloc var '::' sigtype + { IfaceSig $2 $4 [] $1 } + +----------------------------------------------------------------------------- -- The Export List maybeexports :: { Maybe [RdrNameIE] } diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y deleted file mode 100644 index 0cc4a48..0000000 --- a/ghc/compiler/rename/ParseIface.y +++ /dev/null @@ -1,892 +0,0 @@ -{- Notes about the syntax of interface files -*-haskell-*- - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The header -~~~~~~~~~~ - interface "edison" M 4 6 2 ! 406 Module M, version 4, from package 'edison', - Fixities version 6, rules version 2 - Interface syntax version 406 - ! means M contains orphans - -Import declarations -~~~~~~~~~~~~~~~~~~~ - import Foo ; To compile M I used nothing from Foo, but it's - below me in the hierarchy - - import Foo ! @ ; Ditto, but the ! means that Foo contains orphans - and the @ means that Foo is a boot interface - - import Foo :: 3 ; To compile M I used everything from Foo, which has - module version 3 - - import Foo :: 3 2 6 a 1 b 3 c 7 ; To compile M I used Foo. It had - module version 3 - fixity version 2 - rules version 6 - and some specific things besides. - --} - - -{ -module ParseIface ( parseIface, parseType, parseRules, parseIdInfo ) where - -#include "HsVersions.h" - -import HsSyn -- quite a bit of stuff -import RdrHsSyn -- oodles of synonyms -import HsTypes ( mkHsForAllTy, mkHsTupCon ) -import HsCore -import Literal ( Literal(..), mkMachInt, mkMachInt64, mkMachWord, mkMachWord64 ) -import BasicTypes ( Fixity(..), FixityDirection(..), StrictnessMark(..), - NewOrData(..), Version, initialVersion, Boxity(..), - Activation(..), IPName(..) - ) -import CostCentre ( CostCentre(..), IsCafCC(..), IsDupdCC(..) ) -import Type ( Kind, mkArrowKind, liftedTypeKind, openTypeKind, usageTypeKind ) -import ForeignCall ( ForeignCall(..), CCallConv(..), CCallSpec(..), CCallTarget(..) ) -import Lex - -import RnMonad ( ParsedIface(..), IfaceDeprecs ) -import HscTypes ( WhetherHasOrphans, IsBootInterface, GenAvailInfo(..), - ImportVersion, WhatsImported(..), - RdrAvailInfo, RdrExportItem ) - -import RdrName ( RdrName, mkRdrUnqual, mkIfaceOrig ) -import TyCon ( DataConDetails(..) ) -import Name ( OccName ) -import OccName ( mkSysOccFS, - tcName, varName, dataName, clsName, tvName, - EncodedFS - ) -import Module ( ModuleName, PackageName, mkSysModuleNameFS ) -import SrcLoc ( SrcLoc ) -import CmdLineOpts ( opt_InPackage, opt_IgnoreIfacePragmas ) -import Outputable -import Class ( DefMeth (..) ) - -import GlaExts -import FastString ( tailFS ) -} - -%name parseIface iface -%name parseType type -%name parseIdInfo id_info -%name parseRules rules_and_deprecs - -%tokentype { Token } -%monad { P }{ thenP }{ returnP } -%lexer { lexer } { ITeof } - -%token - 'as' { ITas } - 'case' { ITcase } -- Haskell keywords - 'class' { ITclass } - 'data' { ITdata } - 'hiding' { IThiding } - 'import' { ITimport } - 'in' { ITin } - 'infix' { ITinfix } - 'infixl' { ITinfixl } - 'infixr' { ITinfixr } - 'instance' { ITinstance } - 'let' { ITlet } - 'newtype' { ITnewtype } - 'of' { ITof } - 'qualified' { ITqualified } - 'type' { ITtype } - 'where' { ITwhere } - - 'forall' { ITforall } -- GHC extension keywords - 'foreign' { ITforeign } - 'export' { ITexport } - 'label' { ITlabel } - 'dynamic' { ITdynamic } - 'unsafe' { ITunsafe } - 'with' { ITwith } - 'stdcall' { ITstdcallconv } - 'ccall' { ITccallconv } - - '__interface' { ITinterface } -- interface keywords - '__export' { IT__export } - '__forall' { IT__forall } - '__letrec' { ITletrec } - '__coerce' { ITcoerce } - '__inline_me' { ITinlineMe } - '__inline_call'{ ITinlineCall } - '__DEFAULT' { ITdefaultbranch } - '__float' { ITfloat_lit } - '__word' { ITword_lit } - '__int64' { ITint64_lit } - '__word64' { ITword64_lit } - '__addr' { ITaddr_lit } - '__label' { ITlabel_lit } - '__litlit' { ITlit_lit } - '__ccall' { ITccall $$ } - '__scc' { ITscc } - '__sccC' { ITsccAllCafs } - - '__u' { ITusage } - - '__A' { ITarity } - '__P' { ITspecialise } - '__C' { ITnocaf } - '__U' { ITunfold } - '__S' { ITstrict $$ } - '__R' { ITrules } - '__D' { ITdeprecated } - - '::' { ITdcolon } - '=' { ITequal } - '\\' { ITlam } - '|' { ITvbar } - '->' { ITrarrow } - '@' { ITat } - '~' { ITtilde } - '=>' { ITdarrow } - '-' { ITminus } - '!' { ITbang } - '*' { ITstar } - - '{' { ITocurly } -- special symbols - '}' { ITccurly } - '[' { ITobrack } - ']' { ITcbrack } - '[:' { ITopabrack } - ':]' { ITcpabrack } - '(' { IToparen } - ')' { ITcparen } - '(#' { IToubxparen } - '#)' { ITcubxparen } - ';' { ITsemi } - ',' { ITcomma } - '.' { ITdot } - - VARID { ITvarid $$ } -- identifiers - CONID { ITconid $$ } - VARSYM { ITvarsym $$ } - QVARID { ITqvarid $$ } - QCONID { ITqconid $$ } - - IPDUPVARID { ITdupipvarid $$ } -- GHC extension - IPSPLITVARID { ITsplitipvarid $$ } -- GHC extension - - PRAGMA { ITpragma $$ } - - CHAR { ITchar $$ } - STRING { ITstring $$ } - INTEGER { ITinteger $$ } - RATIONAL { ITrational $$ } - CLITLIT { ITlitlit $$ } -%% - -iface :: { ParsedIface } -iface : '__interface' package mod_name - version sub_versions - orphans checkVersion 'where' - exports_part - import_part - fix_decl_part - instance_decl_part - decls_part - rules_and_deprecs_part - { let (rules,deprecs) = $14 () in - ParsedIface { - pi_mod = $3, -- Module name - pi_pkg = $2, -- Package name - pi_vers = $4, -- Module version - pi_orphan = $6, - pi_exports = (fst $5, $9), -- Exports - pi_usages = $10, -- Usages - pi_fixity = $11, -- Fixies - pi_insts = $12, -- Local instances - pi_decls = $13, -- Decls - pi_rules = (snd $5,rules), -- Rules - pi_deprecs = deprecs -- Deprecations - } } - --- Versions for exports and rules (optional) -sub_versions :: { (Version,Version) } - : '[' version version ']' { ($2,$3) } - | {- empty -} { (initialVersion, initialVersion) } - --------------------------------------------------------------------------- - -import_part :: { [ImportVersion OccName] } -import_part : { [] } - | import_decl import_part { $1 : $2 } - -import_decl :: { ImportVersion OccName } -import_decl : 'import' mod_name orphans is_boot whats_imported ';' - { ({-mkSysModuleNameFS-} $2, $3, $4, $5) } - -orphans :: { WhetherHasOrphans } -orphans : { False } - | '!' { True } - -is_boot :: { IsBootInterface } -is_boot : { False } - | '@' { True } - -whats_imported :: { WhatsImported OccName } -whats_imported : { NothingAtAll } - | '::' version { Everything $2 } - | '::' version version version name_version_pairs { Specifically $2 (Just $3) $5 $4 } - | '::' version version name_version_pairs { Specifically $2 Nothing $4 $3 } - -name_version_pairs :: { [(OccName, Version)] } -name_version_pairs : { [] } - | name_version_pair name_version_pairs { $1 : $2 } - -name_version_pair :: { (OccName, Version) } -name_version_pair : var_occ version { ($1, $2) } - | tc_occ version { ($1, $2) } - - --------------------------------------------------------------------------- - -exports_part :: { [RdrExportItem] } -exports_part : { [] } - | '__export' mod_name entities ';' - exports_part { ({-mkSysModuleNameFS-} $2, $3) : $5 } - -entities :: { [RdrAvailInfo] } -entities : { [] } - | entity entities { $1 : $2 } - -entity :: { RdrAvailInfo } -entity : var_occ { Avail $1 } - | tc_occ { AvailTC $1 [$1] } - | tc_occ '|' stuff_inside { AvailTC $1 $3 } - | tc_occ stuff_inside { AvailTC $1 ($1:$2) } - -- Note that the "main name" comes at the beginning - -stuff_inside :: { [OccName] } -stuff_inside : '{' val_occs '}' { $2 } - -val_occ :: { OccName } - : var_occ { $1 } - | data_occ { $1 } - -val_occs :: { [OccName] } - : val_occ { [$1] } - | val_occ val_occs { $1 : $2 } - - --------------------------------------------------------------------------- - -fix_decl_part :: { [(RdrName,Fixity)] } -fix_decl_part : {- empty -} { [] } - | fix_decls ';' { $1 } - -fix_decls :: { [(RdrName,Fixity)] } -fix_decls : { [] } - | fix_decl fix_decls { $1 : $2 } - -fix_decl :: { (RdrName,Fixity) } -fix_decl : fixity prec var_or_data_name { ($3, Fixity $2 $1) } - -fixity :: { FixityDirection } -fixity : 'infixl' { InfixL } - | 'infixr' { InfixR } - | 'infix' { InfixN } - -prec :: { Int } -prec : INTEGER { fromInteger $1 } - ------------------------------------------------------------------------------ - -csigs :: { [RdrNameSig] } -csigs : { [] } - | 'where' '{' csigs1 '}' { $3 } - -csigs1 :: { [RdrNameSig] } -csigs1 : { [] } - | csig ';' csigs1 { $1 : $3 } - -csig :: { RdrNameSig } -csig : src_loc qvar_name '::' type { ClassOpSig $2 NoDefMeth $4 $1 } - | src_loc qvar_name ';' '::' type { ClassOpSig $2 GenDefMeth $5 $1 } - | src_loc qvar_name '=' '::' type { mkClassOpSigDM $2 $5 $1 } - --------------------------------------------------------------------------- - -instance_decl_part :: { [RdrNameInstDecl] } -instance_decl_part : {- empty -} { [] } - | instance_decl_part inst_decl { $2 : $1 } - -inst_decl :: { RdrNameInstDecl } -inst_decl : src_loc 'instance' type '=' qvar_name ';' - { InstDecl $3 - EmptyMonoBinds {- No bindings -} - [] {- No user pragmas -} - (Just $5) {- Dfun id -} - $1 - } - --------------------------------------------------------------------------- - -decls_part :: { [(Version, RdrNameTyClDecl)] } -decls_part - : {- empty -} { [] } - | opt_version decl ';' decls_part { ($1,$2):$4 } - -decl :: { RdrNameTyClDecl } -decl : src_loc qvar_name '::' type maybe_idinfo - { IfaceSig $2 $4 ($5 $2) $1 } - | src_loc 'type' qtc_name tv_bndrs '=' type - { TySynonym $3 $4 $6 $1 } - | src_loc 'foreign' 'type' qtc_name - { ForeignType $4 Nothing DNType $1 } - | src_loc 'data' tycl_hdr constrs - { mkTyData DataType $3 $4 Nothing $1 } - | src_loc 'newtype' tycl_hdr newtype_constr - { mkTyData NewType $3 (DataCons [$4]) Nothing $1 } - | src_loc 'class' tycl_hdr fds csigs - { mkClassDecl $3 $4 $5 Nothing $1 } - -tycl_hdr :: { (RdrNameContext, RdrName, [RdrNameHsTyVar]) } - : context '=>' qtc_name tv_bndrs { ($1, $3, $4) } - | qtc_name tv_bndrs { ([], $1, $2) } - -maybe_idinfo :: { RdrName -> [HsIdInfo RdrName] } -maybe_idinfo : {- empty -} { \_ -> [] } - | pragma { \x -> if opt_IgnoreIfacePragmas then [] - else case $1 of - Just (POk _ id_info) -> id_info - Just (PFailed err) -> pprPanic "IdInfo parse failed" - (vcat [ppr x, err]) - } - {- - If a signature decl is being loaded, and opt_IgnoreIfacePragmas is on, - we toss away unfolding information. - - Also, if the signature is loaded from a module we're importing from source, - we do the same. This is to avoid situations when compiling a pair of mutually - recursive modules, peering at unfolding info in the interface file of the other, - e.g., you compile A, it looks at B's interface file and may as a result change - its interface file. Hence, B is recompiled, maybe changing its interface file, - which will the unfolding info used in A to become invalid. Simple way out is to - just ignore unfolding info. - - [Jan 99: I junked the second test above. If we're importing from an hi-boot - file there isn't going to *be* any pragma info. The above comment - dates from a time where we picked up a .hi file first if it existed.] - -} - -pragma :: { Maybe (ParseResult [HsIdInfo RdrName]) } -pragma : src_loc PRAGMA { let exts = ExtFlags {glasgowExtsEF = True, - parrEF = True} - in - Just (parseIdInfo $2 (mkPState $1 exts)) - } - ------------------------------------------------------------------------------ - --- This production is lifted so that it doesn't get eagerly parsed when we --- use happy --strict. -rules_and_deprecs_part :: { () -> ([RdrNameRuleDecl], IfaceDeprecs) } -rules_and_deprecs_part - : {- empty -} { \_ -> ([], Nothing) } - | src_loc PRAGMA { \_ -> let exts = ExtFlags {glasgowExtsEF = True, - parrEF = True} - in case parseRules $2 (mkPState $1 exts) of - POk _ rds -> rds - PFailed err -> pprPanic "Rules/Deprecations parse failed" err - } - -rules_and_deprecs :: { ([RdrNameRuleDecl], IfaceDeprecs) } -rules_and_deprecs : rule_prag deprec_prag { ($1, $2) } - - ------------------------------------------------------------------------------ - -rule_prag :: { [RdrNameRuleDecl] } -rule_prag : {- empty -} { [] } - | '__R' rules { $2 } - -rules :: { [RdrNameRuleDecl] } - : {- empty -} { [] } - | rule ';' rules { $1:$3 } - -rule :: { RdrNameRuleDecl } -rule : src_loc STRING activation rule_forall qvar_name - core_args '=' core_expr { IfaceRule $2 $3 $4 $5 $6 $8 $1 } - -activation :: { Activation } -activation : {- empty -} { AlwaysActive } - | '[' INTEGER ']' { ActiveAfter (fromInteger $2) } - | '[' '~' INTEGER ']' { ActiveBefore (fromInteger $3) } - -rule_forall :: { [UfBinder RdrName] } -rule_forall : '__forall' '{' core_bndrs '}' { $3 } - ------------------------------------------------------------------------------ - -deprec_prag :: { IfaceDeprecs } -deprec_prag : {- empty -} { Nothing } - | '__D' deprecs { Just $2 } - -deprecs :: { Either DeprecTxt [(RdrName,DeprecTxt)] } -deprecs : STRING { Left $1 } - | deprec_list { Right $1 } - -deprec_list :: { [(RdrName,DeprecTxt)] } -deprec_list : deprec { [$1] } - | deprec ';' deprec_list { $1 : $3 } - -deprec :: { (RdrName,DeprecTxt) } -deprec : deprec_name STRING { ($1, $2) } - -deprec_name :: { RdrName } - : qvar_name { $1 } - | qtc_name { $1 } - ------------------------------------------------------------------------------ - -version :: { Version } -version : INTEGER { fromInteger $1 } - -opt_version :: { Version } -opt_version : version { $1 } - | {- empty -} { initialVersion } - - ----------------------------------------------------------------------------- - -constrs :: { DataConDetails RdrNameConDecl } - : { Unknown } - | '=' { DataCons [] } - | '=' constrs1 { DataCons $2 } - -constrs1 :: { [RdrNameConDecl] } -constrs1 : constr { [$1] } - | constr '|' constrs1 { $1 : $3 } - -constr :: { RdrNameConDecl } -constr : src_loc ex_stuff qdata_name batypes { mk_con_decl $3 $2 (VanillaCon $4) $1 } - | src_loc ex_stuff qdata_name '{' fields1 '}' { mk_con_decl $3 $2 (RecCon $5) $1 } - -- We use "data_fs" so as to include () - -newtype_constr :: { RdrNameConDecl } -newtype_constr : src_loc '=' ex_stuff qdata_name atype { mk_con_decl $4 $3 (VanillaCon [unbangedType $5]) $1 } - | src_loc '=' ex_stuff qdata_name '{' qvar_name '::' atype '}' - { mk_con_decl $4 $3 (RecCon [([$6], unbangedType $8)]) $1 } - -ex_stuff :: { ([HsTyVarBndr RdrName], RdrNameContext) } -ex_stuff : { ([],[]) } - | '__forall' tv_bndrs opt_context '=>' { ($2,$3) } - -batypes :: { [RdrNameBangType] } -batypes : { [] } - | batype batypes { $1 : $2 } - -batype :: { RdrNameBangType } -batype : tatype { unbangedType $1 } - | '!' tatype { BangType MarkedStrict $2 } - | '!' '!' tatype { BangType MarkedUnboxed $3 } - -fields1 :: { [([RdrName], RdrNameBangType)] } -fields1 : field { [$1] } - | field ',' fields1 { $1 : $3 } - -field :: { ([RdrName], RdrNameBangType) } -field : qvar_names1 '::' ttype { ($1, unbangedType $3) } - | qvar_names1 '::' '!' ttype { ($1, BangType MarkedStrict $4) } - | qvar_names1 '::' '!' '!' ttype { ($1, BangType MarkedUnboxed $5) } - --------------------------------------------------------------------------- - -type :: { RdrNameHsType } -type : '__forall' tv_bndrs - opt_context '=>' type { mkHsForAllTy (Just $2) $3 $5 } - | btype '->' type { HsFunTy $1 $3 } - | btype { $1 } - -opt_context :: { RdrNameContext } -opt_context : { [] } - | context { $1 } - -context :: { RdrNameContext } -context : '(' context_list1 ')' { $2 } - | '{' context_list1 '}' { $2 } -- Backward compatibility - -context_list1 :: { RdrNameContext } -context_list1 : class { [$1] } - | class ',' context_list1 { $1 : $3 } - -class :: { HsPred RdrName } -class : qcls_name atypes { (HsClassP $1 $2) } - | ipvar_name '::' type { (HsIParam $1 $3) } - -types0 :: { [RdrNameHsType] {- Zero or more -} } -types0 : {- empty -} { [ ] } - | type { [ $1 ] } - | types2 { $1 } - -types2 :: { [RdrNameHsType] {- Two or more -} } -types2 : type ',' type { [$1,$3] } - | type ',' types2 { $1 : $3 } - -btype :: { RdrNameHsType } -btype : atype { $1 } - | btype atype { HsAppTy $1 $2 } - -atype :: { RdrNameHsType } -atype : qtc_name { HsTyVar $1 } - | tv_name { HsTyVar $1 } - | '.' { hsUsOnce } - | '!' { hsUsMany } - | '(' ')' { HsTupleTy (mkHsTupCon tcName Boxed []) [] } - | '(' types2 ')' { HsTupleTy (mkHsTupCon tcName Boxed $2) $2 } - | '(#' types0 '#)' { HsTupleTy (mkHsTupCon tcName Unboxed $2) $2 } - | '[' type ']' { HsListTy $2 } - | '[:' type ':]' { HsPArrTy $2 } - | '{' qcls_name atypes '}' { mkHsDictTy $2 $3 } - | '{' ipvar_name '::' type '}' { mkHsIParamTy $2 $4 } - | '(' type ')' { $2 } - -atypes :: { [RdrNameHsType] {- Zero or more -} } -atypes : { [] } - | atype atypes { $1 : $2 } --------------------------------------------------------------------------- - --- versions of type/btype/atype that cant begin with '!' (or '.') --- for use where the kind is definitely known NOT to be '$' - -ttype :: { RdrNameHsType } -ttype : '__forall' tv_bndrs - opt_context '=>' type { mkHsForAllTy (Just $2) $3 $5 } - | tbtype '->' type { HsFunTy $1 $3 } - | tbtype { $1 } - -tbtype :: { RdrNameHsType } -tbtype : tatype { $1 } - | tbtype atype { HsAppTy $1 $2 } - -tatype :: { RdrNameHsType } -tatype : qtc_name { HsTyVar $1 } - | tv_name { HsTyVar $1 } - | '(' ')' { HsTupleTy (mkHsTupCon tcName Boxed []) [] } - | '(' types2 ')' { HsTupleTy (mkHsTupCon tcName Boxed $2) $2 } - | '(#' types0 '#)' { HsTupleTy (mkHsTupCon tcName Unboxed $2) $2 } - | '[' type ']' { HsListTy $2 } - | '[:' type ':]' { HsPArrTy $2 } - | '{' qcls_name atypes '}' { mkHsDictTy $2 $3 } - | '{' ipvar_name '::' type '}' { mkHsIParamTy $2 $4 } - | '(' type ')' { $2 } ---------------------------------------------------------------------- - -package :: { PackageName } - : STRING { $1 } - | {- empty -} { opt_InPackage } - -- Useful for .hi-boot files, - -- which can omit the package Id - -- Module loops are always within a package - -mod_name :: { ModuleName } - : CONID { mkSysModuleNameFS $1 } - - ---------------------------------------------------- -var_fs :: { EncodedFS } - : VARID { $1 } - | 'as' { FSLIT("as") } - | 'qualified' { FSLIT("qualified") } - | 'hiding' { FSLIT("hiding") } - | 'forall' { FSLIT("forall") } - | 'foreign' { FSLIT("foreign") } - | 'export' { FSLIT("export") } - | 'label' { FSLIT("label") } - | 'dynamic' { FSLIT("dynamic") } - | 'unsafe' { FSLIT("unsafe") } - | 'with' { FSLIT("with") } - | 'ccall' { FSLIT("ccall") } - | 'stdcall' { FSLIT("stdcall") } - -var_occ :: { OccName } - : var_fs { mkSysOccFS varName $1 } - -var_name :: { RdrName } -var_name : var_occ { mkRdrUnqual $1 } - -qvar_name :: { RdrName } -qvar_name : var_name { $1 } - | QVARID { mkIfaceOrig varName $1 } - -ipvar_name :: { IPName RdrName } - : IPDUPVARID { Dupable (mkRdrUnqual (mkSysOccFS varName $1)) } - | IPSPLITVARID { Linear (mkRdrUnqual (mkSysOccFS varName $1)) } - -qvar_names1 :: { [RdrName] } -qvar_names1 : qvar_name { [$1] } - | qvar_name qvar_names1 { $1 : $2 } - ---------------------------------------------------- - -data_occ :: { OccName } - : CONID { mkSysOccFS dataName $1 } - -qdata_name :: { RdrName } - : data_occ { mkRdrUnqual $1 } - | QCONID { mkIfaceOrig dataName $1 } - -var_or_data_name :: { RdrName } - : qvar_name { $1 } - | qdata_name { $1 } - ---------------------------------------------------- -tc_occ :: { OccName } - : CONID { mkSysOccFS tcName $1 } - -qtc_name :: { RdrName } - : tc_occ { mkRdrUnqual $1 } - | QCONID { mkIfaceOrig tcName $1 } - ---------------------------------------------------- -qcls_name :: { RdrName } - : CONID { mkRdrUnqual (mkSysOccFS clsName $1) } - | QCONID { mkIfaceOrig clsName $1 } - ---------------------------------------------------- -tv_name :: { RdrName } - : var_fs { mkRdrUnqual (mkSysOccFS tvName $1) } - -tv_bndr :: { HsTyVarBndr RdrName } - : tv_name '::' akind { IfaceTyVar $1 $3 } - | tv_name { IfaceTyVar $1 liftedTypeKind } - -tv_bndrs :: { [HsTyVarBndr RdrName] } - : tv_bndrs1 { $1 } - | '[' tv_bndrs1 ']' { $2 } -- Backward compatibility - -tv_bndrs1 :: { [HsTyVarBndr RdrName] } - : { [] } - | tv_bndr tv_bndrs1 { $1 : $2 } - ---------------------------------------------------- -fds :: { [([RdrName], [RdrName])] } - : {- empty -} { [] } - | '|' fds1 { reverse $2 } - -fds1 :: { [([RdrName], [RdrName])] } - : fds1 ',' fd { $3 : $1 } - | fd { [$1] } - -fd :: { ([RdrName], [RdrName]) } - : varids0 '->' varids0 { (reverse $1, reverse $3) } - -varids0 :: { [RdrName] } - : {- empty -} { [] } - | varids0 tv_name { $2 : $1 } - ---------------------------------------------------- -kind :: { Kind } - : akind { $1 } - | akind '->' kind { mkArrowKind $1 $3 } - -akind :: { Kind } - : '*' { liftedTypeKind } - | VARSYM { if $1 == FSLIT("?") then - openTypeKind - else if $1 == FSLIT("\36") then - usageTypeKind -- dollar - else panic "ParseInterface: akind" - } - | '(' kind ')' { $2 } - --------------------------------------------------------------------------- - -id_info :: { [HsIdInfo RdrName] } - : id_info_item { [$1] } - | id_info_item id_info { $1 : $2 } - -id_info_item :: { HsIdInfo RdrName } - : '__A' INTEGER { HsArity (fromInteger $2) } - | '__U' activation core_expr { HsUnfold $2 $3 } - | '__S' { HsStrictness $1 } - | '__C' { HsNoCafRefs } - | '__P' qvar_name INTEGER { HsWorker $2 (fromInteger $3) } - -------------------------------------------------------- -core_expr :: { UfExpr RdrName } -core_expr : '\\' core_bndrs '->' core_expr { foldr UfLam $4 $2 } - | 'case' core_expr 'of' var_name - '{' core_alts '}' { UfCase $2 $4 $6 } - - | 'let' '{' core_val_bndr '=' core_expr - '}' 'in' core_expr { UfLet (UfNonRec $3 $5) $8 } - | '__letrec' '{' rec_binds '}' - 'in' core_expr { UfLet (UfRec $3) $6 } - - | '__litlit' STRING atype { UfLitLit $2 $3 } - - | fexpr { $1 } - -fexpr :: { UfExpr RdrName } -fexpr : fexpr core_arg { UfApp $1 $2 } - | scc core_aexpr { UfNote (UfSCC $1) $2 } - | '__inline_me' core_aexpr { UfNote UfInlineMe $2 } - | '__inline_call' core_aexpr { UfNote UfInlineCall $2 } - | '__coerce' atype core_aexpr { UfNote (UfCoerce $2) $3 } - | core_aexpr { $1 } - -core_arg :: { UfExpr RdrName } - : '@' atype { UfType $2 } - | core_aexpr { $1 } - -core_args :: { [UfExpr RdrName] } - : { [] } - | core_arg core_args { $1 : $2 } - -core_aexpr :: { UfExpr RdrName } -- Atomic expressions -core_aexpr : qvar_name { UfVar $1 } - | qdata_name { UfVar $1 } - - | core_lit { UfLit $1 } - | '(' core_expr ')' { $2 } - - | '(' ')' { UfTuple (mkHsTupCon dataName Boxed []) [] } - | '(' comma_exprs2 ')' { UfTuple (mkHsTupCon dataName Boxed $2) $2 } - | '(#' comma_exprs0 '#)' { UfTuple (mkHsTupCon dataName Unboxed $2) $2 } - - | '{' '__ccall' ccall_string type '}' - { let - (is_dyn, is_casm, may_gc) = $2 - - target | is_dyn = DynamicTarget - | is_casm = CasmTarget $3 - | otherwise = StaticTarget $3 - - ccall = CCallSpec target CCallConv may_gc - in - UfFCall (CCall ccall) $4 - } - - -comma_exprs0 :: { [UfExpr RdrName] } -- Zero or more -comma_exprs0 : {- empty -} { [ ] } - | core_expr { [ $1 ] } - | comma_exprs2 { $1 } - -comma_exprs2 :: { [UfExpr RdrName] } -- Two or more -comma_exprs2 : core_expr ',' core_expr { [$1,$3] } - | core_expr ',' comma_exprs2 { $1 : $3 } - -rec_binds :: { [(UfBinder RdrName, UfExpr RdrName)] } - : { [] } - | core_val_bndr '=' core_expr ';' rec_binds { ($1,$3) : $5 } - -core_alts :: { [UfAlt RdrName] } - : { [] } - | core_alt ';' core_alts { $1 : $3 } - -core_alt :: { UfAlt RdrName } -core_alt : core_pat '->' core_expr { (fst $1, snd $1, $3) } - -core_pat :: { (UfConAlt RdrName, [RdrName]) } -core_pat : core_lit { (UfLitAlt $1, []) } - | '__litlit' STRING atype { (UfLitLitAlt $2 $3, []) } - | qdata_name core_pat_names { (UfDataAlt $1, $2) } - | '(' ')' { (UfTupleAlt (mkHsTupCon dataName Boxed []), []) } - | '(' comma_var_names1 ')' { (UfTupleAlt (mkHsTupCon dataName Boxed $2), $2) } - | '(#' comma_var_names1 '#)' { (UfTupleAlt (mkHsTupCon dataName Unboxed $2), $2) } - | '__DEFAULT' { (UfDefault, []) } - | '(' core_pat ')' { $2 } - -core_pat_names :: { [RdrName] } -core_pat_names : { [] } - | core_pat_name core_pat_names { $1 : $2 } - --- Tyvar names and variable names live in different name spaces --- so they need to be signalled separately. But we don't record --- types or kinds in a pattern; we work that out from the type --- of the case scrutinee -core_pat_name :: { RdrName } -core_pat_name : var_name { $1 } - | '@' tv_name { $2 } - -comma_var_names1 :: { [RdrName] } -- One or more -comma_var_names1 : var_name { [$1] } - | var_name ',' comma_var_names1 { $1 : $3 } - -core_lit :: { Literal } -core_lit : integer { mkMachInt $1 } - | CHAR { MachChar $1 } - | STRING { MachStr $1 } - | rational { MachDouble $1 } - | '__word' integer { mkMachWord $2 } - | '__word64' integer { mkMachWord64 $2 } - | '__int64' integer { mkMachInt64 $2 } - | '__float' rational { MachFloat $2 } - | '__addr' integer { MachAddr $2 } - | '__label' STRING { MachLabel $2 } - -integer :: { Integer } - : INTEGER { $1 } - | '-' INTEGER { (-$2) } - -rational :: { Rational } - : RATIONAL { $1 } - | '-' RATIONAL { (-$2) } - -core_bndr :: { UfBinder RdrName } -core_bndr : core_val_bndr { $1 } - | core_tv_bndr { $1 } - -core_bndrs :: { [UfBinder RdrName] } -core_bndrs : { [] } - | core_bndr core_bndrs { $1 : $2 } - -core_val_bndr :: { UfBinder RdrName } -core_val_bndr : var_name '::' atype { UfValBinder $1 $3 } - -core_tv_bndr :: { UfBinder RdrName } -core_tv_bndr : '@' tv_name '::' akind { UfTyBinder $2 $4 } - | '@' tv_name { UfTyBinder $2 liftedTypeKind } - -ccall_string :: { FAST_STRING } - : STRING { $1 } - | CLITLIT { $1 } - | VARID { $1 } - | CONID { $1 } - ------------------------------------------------------------------------- -scc :: { CostCentre } - : '__sccC' '{' mod_name '}' { AllCafsCC $3 } - | '__scc' '{' cc_name mod_name cc_dup cc_caf '}' - { NormalCC { cc_name = $3, cc_mod = $4, - cc_is_dupd = $5, cc_is_caf = $6 } } - -cc_name :: { EncodedFS } - : CONID { $1 } - | var_fs { $1 } - -cc_dup :: { IsDupdCC } -cc_dup : { OriginalCC } - | '!' { DupdCC } - -cc_caf :: { IsCafCC } - : { NotCafCC } - | '__C' { CafCC } - -------------------------------------------------------------------- - -src_loc :: { SrcLoc } -src_loc : {% getSrcLocP } - --- Check the project version: this makes sure --- that the project version (e.g. 407) in the interface --- file is the same as that for the compiler that's reading it -checkVersion :: { () } - : {-empty-} {% checkVersion Nothing } - | INTEGER {% checkVersion (Just (fromInteger $1)) } - -------------------------------------------------------------------- - --- Haskell code -{ -happyError :: P a -happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc) - -mk_con_decl name (ex_tvs, ex_ctxt) details loc = mkConDecl name ex_tvs ex_ctxt details loc -} diff --git a/ghc/compiler/rename/RnBinds.hi-boot-6 b/ghc/compiler/rename/RnBinds.hi-boot-6 index b2fcc90..6f2f354 100644 --- a/ghc/compiler/rename/RnBinds.hi-boot-6 +++ b/ghc/compiler/rename/RnBinds.hi-boot-6 @@ -1,3 +1,6 @@ -__interface RnBinds 1 0 where -__export RnBinds rnBinds; -1 rnBinds :: __forall [b] => RdrHsSyn.RdrNameHsBinds -> (RnHsSyn.RenamedHsBinds -> RnMonad.RnMS (b, NameSet.FreeVars)) -> RnMonad.RnMS (b, NameSet.FreeVars) ; +module RnBinds where + +rnBinds :: forall b . RdrHsSyn.RdrNameHsBinds + -> (RnHsSyn.RenamedHsBinds + -> RnMonad.RnMS (b, NameSet.FreeVars)) + -> RnMonad.RnMS (b, NameSet.FreeVars) diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 4c742f3..4ff1427 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -347,7 +347,9 @@ lookupSrcName global_env rdr_name lookupOrigName :: RdrName -> RnM d Name lookupOrigName rdr_name - = ASSERT( isOrig rdr_name ) + = -- NO: ASSERT( isOrig rdr_name ) + -- Now that .hi-boot files are read by the main parser, they contain + -- ordinary qualified names (which we treat as Orig names here). newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name) lookupIfaceUnqual :: RdrName -> RnM d Name diff --git a/ghc/compiler/rename/RnHiFiles.hi-boot-6 b/ghc/compiler/rename/RnHiFiles.hi-boot-6 index da5dcc3..2fe3df5 100644 --- a/ghc/compiler/rename/RnHiFiles.hi-boot-6 +++ b/ghc/compiler/rename/RnHiFiles.hi-boot-6 @@ -1,3 +1,7 @@ -__interface RnHiFiles 1 0 where -__export RnHiFiles loadInterface; -1 loadInterface :: __forall [d] => Outputable.SDoc -> Module.ModuleName -> Module.WhereFrom -> RnMonad.RnM d HscTypes.ModIface; +module RnHiFiles where + +loadInterface + :: Outputable.SDoc + -> Module.ModuleName + -> Module.WhereFrom + -> RnMonad.RnM d HscTypes.ModIface diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index 8d674a5..a373788 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -19,6 +19,7 @@ module RnHiFiles ( import DriverState ( v_GhcMode, isCompManagerMode ) import DriverUtil ( splitFilename ) import CmdLineOpts ( opt_IgnoreIfacePragmas ) +import Parser ( parseIface ) import HscTypes ( ModuleLocation(..), ModIface(..), emptyModIface, VersionInfo(..), ImportedModuleInfo, @@ -37,7 +38,6 @@ import BasicTypes ( Version, defaultFixity ) import RnTypes ( rnHsType ) import RnEnv import RnMonad -import ParseIface ( parseIface ) import PrelNames ( gHC_PRIM_Name, gHC_PRIM ) import Name ( Name {-instance NamedThing-}, diff --git a/ghc/compiler/typecheck/TcEnv.hi-boot-6 b/ghc/compiler/typecheck/TcEnv.hi-boot-6 index 4c3e1fd..c32fbc7 100644 --- a/ghc/compiler/typecheck/TcEnv.hi-boot-6 +++ b/ghc/compiler/typecheck/TcEnv.hi-boot-6 @@ -1,3 +1,3 @@ -__interface TcEnv 1 0 where -__export TcEnv TcEnv; -1 data TcEnv ; +module TcEnv where + +data TcEnv diff --git a/ghc/compiler/typecheck/TcExpr.hi-boot-6 b/ghc/compiler/typecheck/TcExpr.hi-boot-6 index 6cafd02..aaff33a 100644 --- a/ghc/compiler/typecheck/TcExpr.hi-boot-6 +++ b/ghc/compiler/typecheck/TcExpr.hi-boot-6 @@ -1,10 +1,11 @@ -__interface TcExpr 1 0 where -__export TcExpr tcExpr tcMonoExpr ; -1 tcExpr :: +module TcExpr where + +tcExpr :: RnHsSyn.RenamedHsExpr -> TcType.TcType - -> TcMonad.TcM (TcHsSyn.TcExpr, Inst.LIE) ; -1 tcMonoExpr :: + -> TcMonad.TcM (TcHsSyn.TcExpr, Inst.LIE) + +tcMonoExpr :: RnHsSyn.RenamedHsExpr -> TcType.TcType - -> TcMonad.TcM (TcHsSyn.TcExpr, Inst.LIE) ; + -> TcMonad.TcM (TcHsSyn.TcExpr, Inst.LIE) diff --git a/ghc/compiler/typecheck/TcMatches.hi-boot-6 b/ghc/compiler/typecheck/TcMatches.hi-boot-6 index a8190d9..f4bd3d7 100644 --- a/ghc/compiler/typecheck/TcMatches.hi-boot-6 +++ b/ghc/compiler/typecheck/TcMatches.hi-boot-6 @@ -1,13 +1,14 @@ -__interface TcMatches 1 0 where -__export TcMatches tcGRHSs tcMatchesFun; -1 tcGRHSs :: HsExpr.HsMatchContext Name.Name +module TcMatches where + +tcGRHSs :: HsExpr.HsMatchContext Name.Name -> RnHsSyn.RenamedGRHSs -> TcType.TcType - -> TcMonad.TcM (TcHsSyn.TcGRHSs, Inst.LIE) ; -1 tcMatchesFun :: + -> TcMonad.TcM (TcHsSyn.TcGRHSs, Inst.LIE) + +tcMatchesFun :: [(Name.Name,Var.Id)] -> Name.Name -> TcType.TcType -> [RnHsSyn.RenamedMatch] - -> TcMonad.TcM ([TcHsSyn.TcMatch], Inst.LIE) ; + -> TcMonad.TcM ([TcHsSyn.TcMatch], Inst.LIE) diff --git a/ghc/compiler/typecheck/TcType.hi-boot-6 b/ghc/compiler/typecheck/TcType.hi-boot-6 index 23b3a9c..da1140e 100644 --- a/ghc/compiler/typecheck/TcType.hi-boot-6 +++ b/ghc/compiler/typecheck/TcType.hi-boot-6 @@ -1,3 +1,3 @@ -__interface TcType 1 0 where -__export TcType TyVarDetails; -1 data TyVarDetails ; +module TcType where + +data TyVarDetails diff --git a/ghc/compiler/typecheck/TcUnify.hi-boot-6 b/ghc/compiler/typecheck/TcUnify.hi-boot-6 index 8023e28..a4caf69 100644 --- a/ghc/compiler/typecheck/TcUnify.hi-boot-6 +++ b/ghc/compiler/typecheck/TcUnify.hi-boot-6 @@ -1,8 +1,8 @@ +module TcUnify where + -- This boot file exists only to tie the knot between -- TcUnify and TcSimplify -__interface TcUnify 1 0 where -__export TcUnify unifyTauTy ; -1 unifyTauTy :: TcType.TcTauType -> TcType.TcTauType -> TcMonad.TcM GHCziBase.Z0T ; +unifyTauTy :: TcType.TcTauType -> TcType.TcTauType -> TcMonad.TcM GHC.Base.() diff --git a/ghc/compiler/types/Generics.hi-boot-6 b/ghc/compiler/types/Generics.hi-boot-6 index 536dccb..e0c5c6b 100644 --- a/ghc/compiler/types/Generics.hi-boot-6 +++ b/ghc/compiler/types/Generics.hi-boot-6 @@ -1,4 +1,4 @@ -__interface Generics 1 0 where -__export Generics mkTyConGenInfo ; +module Generics where -2 mkTyConGenInfo :: TyCon.TyCon -> [Name.Name] -> DataziMaybe.Maybe (BasicTypes.EP Var.Id) ; +mkTyConGenInfo :: TyCon.TyCon -> [Name.Name] + -> Data.Maybe.Maybe (BasicTypes.EP Var.Id) diff --git a/ghc/compiler/types/PprType.hi-boot-6 b/ghc/compiler/types/PprType.hi-boot-6 index 75ea5c9..554b6dd 100644 --- a/ghc/compiler/types/PprType.hi-boot-6 +++ b/ghc/compiler/types/PprType.hi-boot-6 @@ -1,5 +1,5 @@ -__interface PprType 1 0 where -__export PprType pprType pprPred ; -1 pprType :: TypeRep.Type -> Outputable.SDoc ; -1 pprPred :: Type.PredType -> Outputable.SDoc ; +module PprType where + +pprType :: TypeRep.Type -> Outputable.SDoc +pprPred :: Type.PredType -> Outputable.SDoc diff --git a/ghc/compiler/types/TyCon.hi-boot-6 b/ghc/compiler/types/TyCon.hi-boot-6 index 75cadcc..19753da 100644 --- a/ghc/compiler/types/TyCon.hi-boot-6 +++ b/ghc/compiler/types/TyCon.hi-boot-6 @@ -1,7 +1,8 @@ -__interface TyCon 1 0 where -__export TyCon TyCon isTupleTyCon isUnboxedTupleTyCon isFunTyCon setTyConName ; -1 data TyCon ; -1 isTupleTyCon :: TyCon -> GHCziBase.Bool ; -1 isUnboxedTupleTyCon :: TyCon -> GHCziBase.Bool ; -1 isFunTyCon :: TyCon -> GHCziBase.Bool ; -1 setTyConName :: TyCon -> Name.Name -> TyCon ; +module TyCon where + +data TyCon + +isTupleTyCon :: TyCon -> GHC.Base.Bool +isUnboxedTupleTyCon :: TyCon -> GHC.Base.Bool +isFunTyCon :: TyCon -> GHC.Base.Bool +setTyConName :: TyCon -> Name.Name -> TyCon diff --git a/ghc/compiler/types/TypeRep.hi-boot-6 b/ghc/compiler/types/TypeRep.hi-boot-6 index 5679aa8..c3c89b0 100644 --- a/ghc/compiler/types/TypeRep.hi-boot-6 +++ b/ghc/compiler/types/TypeRep.hi-boot-6 @@ -1,7 +1,6 @@ -__interface TypeRep 1 0 where -__export TypeRep Type PredType Kind SuperKind ; -1 data Type ; -1 data PredType ; -1 type Kind = Type ; -1 type SuperKind = Type ; +module TypeRep where +data Type +data PredType +type Kind = Type +type SuperKind = Type -- 1.7.10.4