-__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
-__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
-__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
-__interface Module 1 0 where
-__export Module Module ;
-1 data Module ;
+module Module where
+
+data Module
-__interface Name 1 0 where
-__export Name Name;
-1 data Name ;
+module Name where
+
+data Name
-__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
-__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
-__interface CgExpr 1 0 where
-__export CgExpr cgExpr;
-1 cgExpr :: StgSyn.StgExpr -> CgMonad.Code ;
+module CgExpr where
+
+cgExpr :: StgSyn.StgExpr -> CgMonad.Code
-__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
-__interface ClosureInfo 1 0 where
-__export ClosureInfo ClosureInfo LambdaFormInfo;
-1 data LambdaFormInfo;
-1 data ClosureInfo;
+module ClosureInfo where
+
+data LambdaFormInfo
+data ClosureInfo
-__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
+
-__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
-__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
-__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
-__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
-__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
-__interface StixPrim 1 0 where
-__export StixPrim amodeToStix;
-1 amodeToStix :: AbsCSyn.CAddrMode -> Stix.StixExpr ;
+module StixPrim where
+
+amodeToStix :: AbsCSyn.CAddrMode -> Stix.StixExpr
Character classification
\begin{code}
+{-# OPTIONS -#include "hs_ctype.h" #-}
+
module Ctype
( is_ident -- Char# -> Bool
, is_symbol -- Char# -> Bool
, 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 <hs_ctype.h>
\end{code}
The predicates below look costly, but aren't, GHC+GCC do a great job
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
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}
--------------------------------------------------------
\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,
#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,
| 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
("_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))
]
-- 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
| 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)
'\"'#{-"-} -> 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
("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
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 ->
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
\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
(_: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
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
, mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp
, groupBindings
+ , mkIfaceExports -- :: [RdrNameTyClDecl] -> [RdrExportItem]
+
, CallConv(..)
, mkImport -- CallConv -> Safety
-- -> (FAST_STRING, RdrName, RdrNameHsType)
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,
= 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}
{- -*-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.
-}
{
-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
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(..) )
%name parseModule module
%name parseStmt maybe_stmt
%name parseIdentifier identifier
+%name parseIface iface
%tokentype { Token }
%%
: 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] }
+++ /dev/null
-{- 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
-}
-__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)
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
-__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
import DriverState ( v_GhcMode, isCompManagerMode )
import DriverUtil ( splitFilename )
import CmdLineOpts ( opt_IgnoreIfacePragmas )
+import Parser ( parseIface )
import HscTypes ( ModuleLocation(..),
ModIface(..), emptyModIface,
VersionInfo(..), ImportedModuleInfo,
import RnTypes ( rnHsType )
import RnEnv
import RnMonad
-import ParseIface ( parseIface )
import PrelNames ( gHC_PRIM_Name, gHC_PRIM )
import Name ( Name {-instance NamedThing-},
-__interface TcEnv 1 0 where
-__export TcEnv TcEnv;
-1 data TcEnv ;
+module TcEnv where
+
+data TcEnv
-__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)
-__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)
-__interface TcType 1 0 where
-__export TcType TyVarDetails;
-1 data TyVarDetails ;
+module TcType where
+
+data TyVarDetails
+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.()
-__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)
-__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
-__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
-__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
projects / ghc-hetmet.git / commitdiff