HEADS UP: First go at cabalising hs-plugins build system. Bugs have been introduced though
This commit is contained in:
Don Stewart
720
plugins/Language/Hi/Parser.hs
Normal file
720
plugins/Language/Hi/Parser.hs
Normal file
@ -0,0 +1,720 @@
|
||||
{-# OPTIONS -cpp -fglasgow-exts #-}
|
||||
{-# OPTIONS -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-name-shadowing #-}
|
||||
--
|
||||
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||
--
|
||||
-- This library is free software; you can redistribute it and/or
|
||||
-- modify it under the terms of the GNU Lesser General Public
|
||||
-- License as published by the Free Software Foundation; either
|
||||
-- version 2.1 of the License, or (at your option) any later version.
|
||||
--
|
||||
-- This library is distributed in the hope that it will be useful,
|
||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
-- Lesser General Public License for more details.
|
||||
--
|
||||
-- You should have received a copy of the GNU Lesser General Public
|
||||
-- License along with this library; if not, write to the Free Software
|
||||
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
||||
-- USA
|
||||
--
|
||||
|
||||
--
|
||||
-- Based on $fptools/ghc/compiler/iface/BinIface.hs
|
||||
--
|
||||
-- (c) The University of Glasgow 2002
|
||||
--
|
||||
-- Binary interface file support.
|
||||
--
|
||||
|
||||
--
|
||||
-- This provides the "Binary" instances for the Iface type such that we
|
||||
-- can parse binary representations of that type. i.e. from .hi files
|
||||
--
|
||||
-- The main problem we have is that all the stuff we don't care about,
|
||||
-- we just want to read in to a string. So this has to be hand-hacked
|
||||
-- somewhat.
|
||||
--
|
||||
-- The "Binary" class for hs-plugins only includes a get method. We
|
||||
-- don't do any writing. Saves us having to properly reconstruct the
|
||||
-- abstract syntax, which would pull in *way* too much of GHC.
|
||||
--
|
||||
|
||||
|
||||
|
||||
module Language.Hi.Parser ( readIface, module Language.Hi.Syntax ) where
|
||||
|
||||
import Language.Hi.Syntax
|
||||
import Language.Hi.Binary
|
||||
import Language.Hi.FastString
|
||||
|
||||
#include "../../../config.h"
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- how to get there from here
|
||||
|
||||
readIface :: FilePath -> IO Iface
|
||||
readIface hi_path = getBinFileWithDict hi_path
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- All the Binary instances
|
||||
--
|
||||
-- Reading a binary interface into ParsedIface
|
||||
--
|
||||
-- We pull the trick of only reading up to the point we need
|
||||
--
|
||||
|
||||
instance Binary Iface where
|
||||
get bh = do
|
||||
version <- get bh :: IO String
|
||||
build_tag <- get bh :: IO String -- 'way' flag
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 604
|
||||
mod_name <- get bh :: IO FastString
|
||||
_is_boot <- get bh :: IO Bool
|
||||
let pkg_name = mkFastString "unknown" -- >=604 has no package field
|
||||
#elif CABAL == 1 && __GLASGOW_HASKELL__ == 603
|
||||
mod_name <- get bh :: IO FastString
|
||||
let pkg_name = mkFastString "unknown"
|
||||
#else /* <= 622 */
|
||||
mod_name <- get bh :: IO FastString
|
||||
pkg_name <- get bh :: IO FastString
|
||||
#endif
|
||||
mod_vers <- get bh :: IO Version
|
||||
orphan <- get bh :: IO Bool
|
||||
deps <- get bh :: IO Dependencies
|
||||
|
||||
get bh :: IO (Bin Int) -- fake a lazyGet for [Usage]
|
||||
usages <- get bh :: IO [Usage]
|
||||
|
||||
exports <- get bh :: IO [IfaceExport]
|
||||
|
||||
-- (exp_vers :: Version) <- get bh
|
||||
-- (fixities :: [(OccName,Fixity)]) <- get bh
|
||||
-- (deprecs :: [IfaceDeprec]) <- get bh
|
||||
|
||||
-- (decls :: [(Version,IfaceDecl)])<- get bh
|
||||
|
||||
-- (insts :: [IfaceInst]) <- get bh
|
||||
-- (rules :: [IfaceRule]) <- get bh
|
||||
-- (rule_vers :: Version) <- get bh
|
||||
|
||||
return $ Iface {
|
||||
mi_package = unpackFS pkg_name,
|
||||
mi_module = unpackFS mod_name,
|
||||
mi_deps = deps ,
|
||||
mi_usages = usages,
|
||||
mi_exports = exports {-,-}
|
||||
|
||||
-- mi_mod_vers = mod_vers,
|
||||
-- mi_boot = False, -- .hi files are never .hi-boot files!
|
||||
-- mi_orphan = orphan,
|
||||
-- mi_usages = usages,
|
||||
-- mi_exports = exports,
|
||||
-- mi_exp_vers = exp_vers,
|
||||
-- mi_fixities = fixities,
|
||||
-- mi_deprecs = deprecs,
|
||||
-- mi_decls = decls,
|
||||
-- mi_insts = insts,
|
||||
-- mi_rules = rules,
|
||||
-- mi_rule_vers = rule_vers
|
||||
}
|
||||
|
||||
------------------------------------------------------------------------
|
||||
--
|
||||
-- Types from: Iface.hs, HscTypes
|
||||
--
|
||||
|
||||
-- fake a lazyGet
|
||||
instance Binary Dependencies where
|
||||
get bh = do get bh :: IO (Bin Int) -- really a BinPtr Int
|
||||
ms <- get bh :: IO [(FastString,Bool)]
|
||||
ps <- get bh :: IO [FastString]
|
||||
_ <- get bh :: IO [FastString] -- !!orphans
|
||||
return Deps { dep_mods = map unpackFS $! map fst ms,
|
||||
dep_pkgs = map unpackFS ps {-,-}
|
||||
}
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Usages
|
||||
------------------------------------------------------------------------
|
||||
|
||||
instance Binary OccName where
|
||||
get bh = do aa <- get bh :: IO NameSpace
|
||||
ab <- get bh :: IO FastString
|
||||
return $ OccName aa (unpackFS ab)
|
||||
|
||||
instance Binary NameSpace where
|
||||
get bh = do h <- getByte bh
|
||||
case h of
|
||||
0 -> return VarName
|
||||
1 -> return DataName
|
||||
2 -> return TvName
|
||||
_ -> return TcClsName
|
||||
|
||||
instance Binary Usage where
|
||||
get bh = do (nm :: FastString) <- get bh
|
||||
(mod :: Version) <- get bh
|
||||
(exps :: Maybe Version) <- get bh
|
||||
(ents :: [(OccName,Version)]) <- get bh
|
||||
(rules :: Version) <- get bh
|
||||
return $ Usage {usg_name = (unpackFS nm),
|
||||
usg_mod = mod,
|
||||
usg_exports = exps,
|
||||
usg_entities = ents,
|
||||
usg_rules = rules }
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Exports
|
||||
|
||||
instance (Binary name) => Binary (GenAvailInfo name) where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: name) <- get bh
|
||||
return $ Avail aa
|
||||
_ -> do (ab :: name) <- get bh
|
||||
(ac :: [name]) <- get bh
|
||||
return $ AvailTC ab ac
|
||||
|
||||
{-
|
||||
instance Binary a => Binary (Deprecs a) where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return Deprecs
|
||||
1 -> do (aa :: FastString) <- get bh
|
||||
return Deprecs
|
||||
_ -> do (ab :: a) <- get bh
|
||||
return Deprecs
|
||||
-}
|
||||
|
||||
-------------------------------------------------------------------------
|
||||
-- Types from: BasicTypes
|
||||
-------------------------------------------------------------------------
|
||||
|
||||
{-
|
||||
instance Binary Activation where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return Activation
|
||||
1 -> return Activation
|
||||
2 -> do (aa :: Int) <- get bh ; return Activation
|
||||
_ -> do (ab :: Int) <- get bh ; return Activation
|
||||
|
||||
instance Binary StrictnessMark where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return StrictnessMark
|
||||
1 -> return StrictnessMark
|
||||
_ -> return StrictnessMark
|
||||
|
||||
instance Binary Boxity where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return Boxity
|
||||
_ -> return Boxity
|
||||
|
||||
instance Binary TupCon where
|
||||
get bh = do
|
||||
(ab :: Boxity) <- get bh
|
||||
(ac :: Arity) <- get bh
|
||||
return TupCon
|
||||
|
||||
instance Binary RecFlag where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return RecFlag
|
||||
_ -> return RecFlag
|
||||
|
||||
instance Binary DefMeth where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return DefMeth
|
||||
1 -> return DefMeth
|
||||
_ -> return DefMeth
|
||||
|
||||
instance Binary FixityDirection where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return FixityDirection
|
||||
1 -> return FixityDirection
|
||||
_ -> return FixityDirection
|
||||
|
||||
instance Binary Fixity where
|
||||
get bh = do
|
||||
(aa :: Int) <- get bh
|
||||
(ab :: FixityDirection) <- get bh
|
||||
return Fixity
|
||||
|
||||
instance (Binary name) => Binary (IPName name) where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: name) <- get bh ; return IPName
|
||||
_ -> do (ab :: name) <- get bh ; return IPName
|
||||
|
||||
-------------------------------------------------------------------------
|
||||
-- Types from: basicTypes/NewDemand
|
||||
-------------------------------------------------------------------------
|
||||
|
||||
instance Binary DmdType where
|
||||
-- Ignore DmdEnv when spitting out the DmdType
|
||||
get bh = do (ds :: [Demand]) <- get bh
|
||||
(dr :: DmdResult) <- get bh
|
||||
return DmdType
|
||||
|
||||
instance Binary Demand where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return Demand
|
||||
1 -> return Demand
|
||||
2 -> do (aa :: Demand) <- get bh ; return Demand
|
||||
3 -> do (ab :: Demands) <- get bh ; return Demand
|
||||
4 -> do (ac :: Demands) <- get bh ; return Demand
|
||||
5 -> do (ad :: Demand) <- get bh ; return Demand
|
||||
_ -> return Demand
|
||||
|
||||
instance Binary Demands where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: Demand) <- get bh
|
||||
return Demands
|
||||
_ -> do (ab :: [Demand]) <- get bh
|
||||
return Demands
|
||||
|
||||
instance Binary DmdResult where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return DmdResult
|
||||
1 -> return DmdResult
|
||||
_ -> return DmdResult
|
||||
|
||||
instance Binary StrictSig where
|
||||
get bh = do (aa :: DmdType) <- get bh ; return StrictSig
|
||||
-}
|
||||
|
||||
-------------------------------------------------------------------------
|
||||
-- Types from: CostCentre, from profiling/CostCentre.lhs
|
||||
-------------------------------------------------------------------------
|
||||
|
||||
{-
|
||||
instance Binary IsCafCC where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return IsCafCC
|
||||
_ -> return IsCafCC
|
||||
|
||||
instance Binary IsDupdCC where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return IsDupdCC
|
||||
_ -> return IsDupdCC
|
||||
|
||||
instance Binary CostCentre where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do return CostCentre
|
||||
1 -> do (aa :: CcName) <- get bh
|
||||
(ab :: ModuleName) <- get bh
|
||||
(ac :: IsDupdCC) <- get bh
|
||||
(ad :: IsCafCC) <- get bh
|
||||
return CostCentre
|
||||
_ -> do (ae :: ModuleName) <- get bh
|
||||
return CostCentre
|
||||
-}
|
||||
|
||||
-------------------------------------------------------------------------
|
||||
-- IfaceTypes and friends, from IfaceType.lhs
|
||||
-------------------------------------------------------------------------
|
||||
|
||||
{-
|
||||
instance Binary IfaceExtName where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (mod :: ModuleName) <- get bh
|
||||
(occ :: OccName) <- get bh
|
||||
return IfaceExtName
|
||||
1 -> do (mod :: ModuleName) <- get bh
|
||||
(occ :: OccName) <- get bh
|
||||
(vers :: Version) <- get bh
|
||||
return IfaceExtName
|
||||
_ -> do (occ :: OccName) <- get bh
|
||||
return IfaceExtName
|
||||
|
||||
instance Binary IfaceBndr where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: IfaceIdBndr) <- get bh ; return IfaceBndr
|
||||
_ -> do (ab :: IfaceTvBndr) <- get bh ; return IfaceBndr
|
||||
|
||||
instance Binary Kind where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return Kind
|
||||
1 -> return Kind
|
||||
2 -> return Kind
|
||||
3 -> return Kind
|
||||
4 -> return Kind
|
||||
_ -> do (k1 :: Kind) <- get bh
|
||||
(k2 :: Kind) <- get bh
|
||||
return Kind
|
||||
|
||||
instance Binary IfaceType where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: IfaceTvBndr) <- get bh
|
||||
(ab :: IfaceType) <- get bh
|
||||
return IfaceType
|
||||
1 -> do (ad :: OccName) <- get bh
|
||||
return IfaceType
|
||||
2 -> do (ae :: IfaceType) <- get bh
|
||||
(af :: IfaceType) <- get bh
|
||||
return IfaceType
|
||||
3 -> do (ag :: IfaceType) <- get bh
|
||||
(ah :: IfaceType) <- get bh
|
||||
return IfaceType
|
||||
5 -> do (ap :: IfacePredType) <- get bh
|
||||
return IfaceType
|
||||
|
||||
-- Now the special cases for TyConApp
|
||||
6 -> return IfaceType
|
||||
7 -> return IfaceType
|
||||
8 -> return IfaceType
|
||||
9 -> do (ty :: IfaceType) <- get bh
|
||||
return IfaceType
|
||||
10 -> return IfaceType
|
||||
11 -> do (t1 :: IfaceType) <- get bh
|
||||
(t2 :: IfaceType) <- get bh
|
||||
return IfaceType
|
||||
12 -> do (tc :: IfaceExtName) <- get bh
|
||||
(tys :: [IfaceType]) <- get bh
|
||||
return IfaceType
|
||||
_ -> do (tc :: IfaceTyCon) <- get bh
|
||||
(tys :: [IfaceType]) <- get bh
|
||||
return IfaceType
|
||||
|
||||
instance Binary IfaceTyCon where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
1 -> return IfaceTyCon
|
||||
2 -> return IfaceTyCon
|
||||
_ -> do (bx :: Boxity) <- get bh
|
||||
(ar :: Arity) <- get bh
|
||||
return IfaceTyCon
|
||||
|
||||
instance Binary IfacePredType where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: IfaceExtName) <- get bh
|
||||
(ab :: [IfaceType]) <- get bh
|
||||
return IfacePredType
|
||||
_ -> do (ac :: (IPName OccName)) <- get bh
|
||||
(ad :: IfaceType) <- get bh
|
||||
return IfacePredType
|
||||
|
||||
instance Binary IfaceExpr where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: OccName) <- get bh
|
||||
return IfaceExpr
|
||||
1 -> do (ab :: IfaceType) <- get bh
|
||||
return IfaceExpr
|
||||
2 -> do (ac :: Boxity) <- get bh
|
||||
(ad :: [IfaceExpr]) <- get bh
|
||||
return IfaceExpr
|
||||
3 -> do (ae :: IfaceBndr) <- get bh
|
||||
(af :: IfaceExpr) <- get bh
|
||||
return IfaceExpr
|
||||
4 -> do (ag :: IfaceExpr) <- get bh
|
||||
(ah :: IfaceExpr) <- get bh
|
||||
return IfaceExpr
|
||||
5 -> do (ai :: IfaceExpr) <- get bh
|
||||
(aj :: OccName) <- get bh
|
||||
(ak :: [IfaceAlt]) <- get bh
|
||||
return IfaceExpr
|
||||
6 -> do (al :: IfaceBinding) <- get bh
|
||||
(am :: IfaceExpr) <- get bh
|
||||
return IfaceExpr
|
||||
7 -> do (an :: IfaceNote) <- get bh
|
||||
(ao :: IfaceExpr) <- get bh
|
||||
return IfaceExpr
|
||||
8 -> do (ap :: Literal) <- get bh
|
||||
return IfaceExpr
|
||||
9 -> do (as :: ForeignCall) <- get bh
|
||||
(at :: IfaceType) <- get bh
|
||||
return IfaceExpr
|
||||
_ -> do (aa :: IfaceExtName) <- get bh
|
||||
return IfaceExpr
|
||||
|
||||
instance Binary IfaceConAlt where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return IfaceConAlt
|
||||
1 -> do (aa :: OccName) <- get bh
|
||||
return IfaceConAlt
|
||||
2 -> do (ab :: Boxity) <- get bh
|
||||
return IfaceConAlt
|
||||
_ -> do (ac :: Literal) <- get bh
|
||||
return IfaceConAlt
|
||||
|
||||
instance Binary IfaceBinding where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: IfaceIdBndr) <- get bh
|
||||
(ab :: IfaceExpr) <- get bh
|
||||
return IfaceBinding
|
||||
_ -> do (ac :: [(IfaceIdBndr,IfaceExpr)]) <- get bh
|
||||
return IfaceBinding
|
||||
|
||||
instance Binary IfaceIdInfo where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return IfaceIdInfo
|
||||
_ -> do (info :: [IfaceInfoItem]) <- lazyGet bh
|
||||
return IfaceIdInfo
|
||||
|
||||
instance Binary IfaceInfoItem where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: Arity) <- get bh
|
||||
return IfaceInfoItem
|
||||
1 -> do (ab :: StrictSig) <- get bh
|
||||
return IfaceInfoItem
|
||||
2 -> do (ac :: Activation) <- get bh
|
||||
(ad :: IfaceExpr) <- get bh
|
||||
return IfaceInfoItem
|
||||
3 -> return IfaceInfoItem
|
||||
_ -> do (ae :: IfaceExtName) <- get bh
|
||||
(af :: Arity) <- get bh
|
||||
return IfaceInfoItem
|
||||
|
||||
instance Binary IfaceNote where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: CostCentre) <- get bh
|
||||
return IfaceNote
|
||||
1 -> do (ab :: IfaceType ) <- get bh
|
||||
return IfaceNote
|
||||
2 -> return IfaceNote
|
||||
3 -> return IfaceNote
|
||||
_ -> do (ac :: String) <- get bh
|
||||
return IfaceNote
|
||||
|
||||
instance Binary IfaceDecl where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do
|
||||
(name :: OccName) <- get bh
|
||||
(ty :: IfaceType) <- get bh
|
||||
(idinfo :: IfaceIdInfo) <- get bh
|
||||
return IfaceDecl
|
||||
1 -> error "Binary.get(TyClDecl): ForeignType"
|
||||
2 -> do
|
||||
(a1 :: IfaceContext) <- get bh
|
||||
(a2 :: OccName) <- get bh
|
||||
(a3 :: [IfaceTvBndr]) <- get bh
|
||||
(a4 :: IfaceConDecls) <- get bh
|
||||
(a5 :: RecFlag) <- get bh
|
||||
(a6 :: ArgVrcs) <- get bh
|
||||
(a7 :: Bool) <- get bh
|
||||
return IfaceDecl
|
||||
3 -> do
|
||||
(aq :: OccName) <- get bh
|
||||
(ar :: [IfaceTvBndr]) <- get bh
|
||||
(as :: ArgVrcs) <- get bh
|
||||
(at :: IfaceType) <- get bh
|
||||
return IfaceDecl
|
||||
_ -> do
|
||||
(a1 :: IfaceContext) <- get bh
|
||||
(a2 :: OccName) <- get bh
|
||||
(a3 :: [IfaceTvBndr]) <- get bh
|
||||
(a4 :: [FunDep OccName])<- get bh
|
||||
(a5 :: [IfaceClassOp]) <- get bh
|
||||
(a6 :: RecFlag) <- get bh
|
||||
(a7 :: ArgVrcs) <- get bh
|
||||
return IfaceDecl
|
||||
|
||||
instance Binary IfaceInst where
|
||||
get bh = do
|
||||
(ty :: IfaceType) <- get bh
|
||||
(dfun :: OccName) <- get bh
|
||||
return IfaceInst
|
||||
|
||||
instance Binary IfaceConDecls where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return IfaceConDecls
|
||||
1 -> do (aa :: [IfaceConDecl]) <- get bh
|
||||
return IfaceConDecls
|
||||
_ -> do (aa :: IfaceConDecl) <- get bh
|
||||
return IfaceConDecls
|
||||
|
||||
instance Binary IfaceConDecl where
|
||||
get bh = do
|
||||
(a1 :: OccName) <- get bh
|
||||
(a2 :: [IfaceTvBndr]) <- get bh
|
||||
(a3 :: IfaceContext) <- get bh
|
||||
(a4 :: [IfaceType]) <- get bh
|
||||
(a5 :: [StrictnessMark])<- get bh
|
||||
(a6 :: [OccName]) <- get bh
|
||||
return IfaceConDecl
|
||||
|
||||
instance Binary IfaceClassOp where
|
||||
get bh = do
|
||||
(n :: OccName) <- get bh
|
||||
(def :: DefMeth) <- get bh
|
||||
(ty :: IfaceType) <- get bh
|
||||
return IfaceClassOp
|
||||
|
||||
instance Binary IfaceRule where
|
||||
get bh = do
|
||||
(a1 :: RuleName) <- get bh
|
||||
(a2 :: Activation) <- get bh
|
||||
(a3 :: [IfaceBndr]) <- get bh
|
||||
(a4 :: IfaceExtName) <- get bh
|
||||
(a5 :: [IfaceExpr]) <- get bh
|
||||
(a6 :: IfaceExpr) <- get bh
|
||||
return IfaceRule
|
||||
|
||||
-}
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- from Literal
|
||||
------------------------------------------------------------------------
|
||||
|
||||
{-
|
||||
instance Binary Literal where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do
|
||||
(aa :: Char) <- get bh
|
||||
return Literal
|
||||
1 -> do
|
||||
(ab :: FastString) <- get bh
|
||||
return Literal
|
||||
2 -> do return Literal
|
||||
3 -> do
|
||||
(ad :: Integer) <- get bh
|
||||
return Literal
|
||||
4 -> do
|
||||
(ae :: Integer) <- get bh
|
||||
return Literal
|
||||
5 -> do
|
||||
(af :: Integer) <- get bh
|
||||
return Literal
|
||||
6 -> do
|
||||
(ag :: Integer) <- get bh
|
||||
return Literal
|
||||
7 -> do
|
||||
(ah :: Rational) <- get bh
|
||||
return Literal
|
||||
8 -> do
|
||||
(ai :: Rational) <- get bh
|
||||
return Literal
|
||||
9 -> do
|
||||
(aj :: FastString) <- get bh
|
||||
(mb :: Maybe Int) <- get bh
|
||||
return Literal
|
||||
_ -> return Literal -- ?
|
||||
|
||||
-}
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- prelude/ForeignCall.lhs
|
||||
------------------------------------------------------------------------
|
||||
|
||||
{-
|
||||
instance Binary ForeignCall where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: CCallSpec) <- get bh
|
||||
return ForeignCall
|
||||
_ -> do (ab :: DNCallSpec) <- get bh
|
||||
return ForeignCall
|
||||
|
||||
instance Binary Safety where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: Bool) <- get bh
|
||||
return Safety
|
||||
_ -> return Safety
|
||||
|
||||
instance Binary CExportSpec where
|
||||
get bh = do
|
||||
(aa :: CLabelString) <- get bh
|
||||
(ab :: CCallConv) <- get bh
|
||||
return CExportSpec
|
||||
|
||||
instance Binary CCallSpec where
|
||||
get bh = do
|
||||
(aa :: CCallTarget) <- get bh
|
||||
(ab :: CCallConv) <- get bh
|
||||
(ac :: Safety) <- get bh
|
||||
return CCallSpec
|
||||
|
||||
instance Binary CCallTarget where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> do (aa :: CLabelString) <- get bh
|
||||
return CCallTarget
|
||||
_ -> return CCallTarget
|
||||
|
||||
instance Binary CCallConv where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
0 -> return CCallConv
|
||||
_ -> return CCallConv
|
||||
|
||||
instance Binary DNCallSpec where
|
||||
get bh = do
|
||||
(isStatic :: Bool) <- get bh
|
||||
(kind :: DNKind) <- get bh
|
||||
(ass :: String) <- get bh
|
||||
(nm :: String) <- get bh
|
||||
return DNCallSpec
|
||||
|
||||
instance Binary DNKind where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
_ -> return DNKind
|
||||
|
||||
instance Binary DNType where
|
||||
get bh = do
|
||||
h <- getByte bh
|
||||
case h of
|
||||
_ -> return DNType
|
||||
|
||||
-}
|
||||
Reference in New Issue
Block a user