content: {-# LANGUAGE FlexibleInstances #-}
  {-# OPTIONS_GHC -Werror -fwarn-incomplete-patterns #-}
  module GenBin(genBinFile, readBinFile) where
  
  import Control.Monad(when)
  import Data.Word
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as TE
  import qualified Data.ByteString as B
  import Position
  import Pragma
  import Error(internalError, ErrMsg(..), ErrorHandle, bsError)
  import ISyntax
  import ISyntaxUtil(icUndet)
  import CSyntax
  import Undefined(UndefKind(UNoMatch))
  import BinData
  import FileIOUtil(writeBinaryFileCatch)
  import PFPrint
  
  import Debug.Trace
  import IOUtil(progArgs)
  
  doTrace :: Bool
  doTrace = elem "-trace-genbin" progArgs
  
  -- .bo file tag -- change this whenever the .bo format changes
  -- See also GenABin.header
  header :: [Byte]
  header = B.unpack $ TE.encodeUtf8 $ T.pack "bsc-bo-20230831-1"
  
  genBinFile :: ErrorHandle ->
                String -> CSignature -> CSignature -> IPackage a -> IO ()
  genBinFile errh fn bi_sig bo_sig ipkg =
      writeBinaryFileCatch errh fn (header ++ encode (bi_sig, bo_sig, ipkg))
  
  readBinFile :: ErrorHandle -> String -> [Word8] ->
                 IO (CSignature, CSignature, IPackage a, String)
  readBinFile errh nm s =
      if take (length header) s == header
      then let ((bi_sig, bo_sig, ipkg), hash) =
                   decodeWithHash $ drop (length header) s
           in return (bi_sig, bo_sig, ipkg, hash)
      else bsError errh [(noPosition, EBinFileVerMismatch nm)]
  
  -- ----------
  -- Bin CSignature
  
  instance Bin CSignature where
      writeBytes (CSignature n is fs ds) =
          section "CSignature" $
          do toBin n; toBin is; toBin fs; toBin ds
      readBytes = do when doTrace $ traceM("read CSignature")
                     n  <- fromBin
                     is <- fromBin
                     fs <- fromBin
                     ds <- fromBin
                     return $ CSignature n is fs ds
  
  -- ----------
  -- Bin CFixity
  
  instance Bin CFixity where
      writeBytes (CInfix  f i) = do putI 0; toBin f; toBin i
      writeBytes (CInfixl f i) = do putI 1; toBin f; toBin i
      writeBytes (CInfixr f i) = do putI 2; toBin f; toBin i
      readBytes = do when doTrace $ traceM("read CFixity")
                     tag <- getI; f <- fromBin; i <- fromBin
                     case tag of
                       0 -> return $ CInfix  f i
                       1 -> return $ CInfixl f i
                       2 -> return $ CInfixr f i
                       n -> internalError $ "GenBin.Bin(CFixity).readBytes: " ++ show n
  
  -- ----------
  -- Bin CDefn
  
  instance Bin CDefn where
      writeBytes (Ctype ik is t) = do putI 0; toBin ik; toBin is; toBin t
      -- drop derivings because we don't derive after reading .bo
      writeBytes (Cdata vis ik vs ocs cs _) =
          do putI 1; toBin vis; toBin ik; toBin vs; toBin ocs; toBin cs
      writeBytes (Cstruct vis st ik is fs _) =
          do putI 2; toBin vis; toBin st; toBin ik; toBin is; toBin fs
      writeBytes (Cclass incoh ps ik is deps fs) =
          do putI 3; toBin incoh; toBin ps; toBin ik; toBin is; toBin deps; toBin fs
      writeBytes (Cforeign n cqt fn ports) =
          do putI 4; toBin n; toBin cqt; toBin fn; toBin ports
      writeBytes (Cprimitive i cqt) = do putI 5; toBin i; toBin cqt
      writeBytes (CprimType ik) = do putI 6; toBin ik
      writeBytes (CIinstance i cqt) = do putI 7; toBin i; toBin cqt
      writeBytes (CIclass incoh ps ik is deps poss) =
          do putI 8; toBin incoh; toBin ps; toBin ik; toBin is; toBin deps; toBin poss
      writeBytes (CIValueSign i cqt) = do putI 9; toBin i; toBin cqt
      writeBytes (CItype ik is poss) = do putI 10; toBin ik; toBin is; toBin poss
      writeBytes (CPragma p) = do putI 11; toBin p
      writeBytes def = internalError $ "GenBin.Bin(CDefn) not supported " ++ ppReadable def
      readBytes = do when doTrace $ traceM ("read CDefn")
                     tag <- getI
                     case tag of
                       0  -> do when doTrace $ traceM ("Ctype")
                                ik <- fromBin; is <- fromBin; t <- fromBin
                                return (Ctype ik is t)
                       1  -> do when doTrace $ traceM ("Cdata")
                                vis <- fromBin
                                ik <- fromBin
                                vs <- fromBin
                                ocs <- fromBin
                                cs <- fromBin
                                return (Cdata vis ik vs ocs cs [])
                       2  -> do when doTrace $ traceM ("Cstruct")
                                vis <- fromBin
                                st <- fromBin
                                ik <- fromBin
                                is <- fromBin
                                fs <- fromBin
                                return (Cstruct vis st ik is fs [])
                       3  -> do when doTrace $ traceM ("Cclass")
                                incoh <- fromBin
                                ps <- fromBin
                                ik <- fromBin
                                is <- fromBin
                                deps <- fromBin
                                fs <- fromBin
                                return (Cclass incoh ps ik is deps fs)
                       4  -> do when doTrace $ traceM ("Cforeign")
                                n <- fromBin
                                cqt <- fromBin
                                fn <- fromBin
                                ports <- fromBin
                                return (Cforeign n cqt fn ports)
                       5  -> do when doTrace $ traceM ("Cprimitive")
                                i <- fromBin; cqt <- fromBin
                                return (Cprimitive i cqt)
                       6  -> do when doTrace $ traceM ("CprimType")
                                ik <- fromBin
                                return (CprimType ik)
                       7  -> do when doTrace $ traceM ("CIinstance")
                                i <- fromBin; cqt <- fromBin
                                return (CIinstance i cqt)
                       8  -> do when doTrace $ traceM ("CIclass")
                                incoh <- fromBin
                                ps <- fromBin
                                ik <- fromBin
                                is <- fromBin
                                deps <- fromBin
                                poss <- fromBin
                                return (CIclass incoh ps ik is deps poss)
                       9  -> do when doTrace $ traceM ("CIValueSign")
                                i <- fromBin; cqt <- fromBin
                                return (CIValueSign i cqt)
                       10 -> do when doTrace $ traceM ("CItype")
                                ik <- fromBin; is <- fromBin; poss <- fromBin
                                return (CItype ik is poss)
                       11 -> do p <- fromBin; return (CPragma p)
                       n  -> internalError $ "GenBin.Bin(CDefn).readBytes: " ++ show n
  
  -- ----------
  -- Bin IdK
  
  instance Bin IdK where
      writeBytes (IdK i)       = do putI 0; toBin i
      writeBytes (IdKind i k)  = do putI 1; toBin i; toBin k
      writeBytes (IdPKind i k) =
          internalError $ "GenBin.Bin(IdK).writeBytes: IdPKind"
      readBytes = do when doTrace $ traceM ("read IdK")
                     tag <- getI;
                     case tag of
                       0 -> do i <- fromBin; return (IdK i)
                       1 -> do i <- fromBin; k <- fromBin; return (IdKind i k)
                       n -> internalError $ "GenBin.Bin(IdK).readBytes: " ++ show n
  
  -- ----------
  -- Bin CInternalSummand
  
  instance Bin CInternalSummand where
      writeBytes (CInternalSummand is t mn) =
          section "CInternalSummand" $
          do toBin is; toBin t; toBin mn
      readBytes = do when doTrace $ traceM("read CInternalSummand")
                     is <- fromBin; t <- fromBin; mn <- fromBin
                     return (CInternalSummand is t mn)
  
  -- ----------
  -- Bin COriginalSummand
  
  instance Bin COriginalSummand where
      writeBytes (COriginalSummand is ts fns mn) =
          section "COriginalSummand" $
          do toBin is; toBin ts; toBin fns; toBin mn
      readBytes = do when doTrace $ traceM("read COriginalSummand")
                     is <- fromBin; ts <- fromBin; fns <- fromBin; mn <- fromBin
                     return (COriginalSummand is ts fns mn)
  
  -- ----------
  -- Bin CField
  
  instance Bin CField where
      writeBytes (CField n ps cqt def_cs mot) =
          section "CField" $
          do toBin n; toBin ps; toBin cqt; toBin def_cs; toBin mot
      readBytes = do when doTrace $ traceM ("read CField")
                     n <- fromBin; ps <- fromBin; cqt <- fromBin;
                     def_cs <- fromBin; mot <- fromBin;
                     return (CField n ps cqt def_cs mot)
  
  -- needed by CField defaulting
  
  instance Bin CClause where
      writeBytes (CClause ps qs e) =
          section "CClause" $ do toBin ps; toBin qs; toBin e
      readBytes = do when doTrace $ traceM ("read CClause")
                     ps <- fromBin; qs <- fromBin; e <- fromBin;
                     return (CClause ps qs e)
  
  instance Bin CPat where
      writeBytes (CPCon i ps) = do putI 0; toBin i; toBin ps
      writeBytes (CPstruct mb i ips) = do putI 1; toBin mb; toBin i; toBin ips
      writeBytes (CPVar i) = do putI 2; toBin i
      writeBytes (CPAs i p) = do putI 3; toBin i; toBin p
      writeBytes (CPAny p) = do putI 4; toBin p
      writeBytes (CPLit l) = do putI 5; toBin l
      writeBytes (CPMixedLit pos n ns) = do putI 6; toBin pos; toBin n; toBin ns
      writeBytes (CPOper ops) = do putI 7; toBin ops
      writeBytes (CPCon1 i1 i2 p) = do putI 8; toBin i1; toBin i2; toBin p
      writeBytes (CPConTs i1 i2 ts ps) =
          do putI 9; toBin i1; toBin i2; toBin ts; toBin ps
      readBytes = do tag <- getI
                     case tag of
                       0 -> do i <- fromBin; ps <- fromBin
                               return (CPCon i ps)
                       1 -> do mb <- fromBin; i <- fromBin; ips <- fromBin;
                               return (CPstruct mb i ips)
                       2 -> do i <- fromBin; return (CPVar i)
                       3 -> do i <- fromBin; p <- fromBin; return (CPAs i p)
                       4 -> do p <- fromBin; return (CPAny p)
                       5 -> do l <- fromBin; return (CPLit l)
                       6 -> do pos <- fromBin; n <- fromBin; ns <- fromBin;
                               return (CPMixedLit pos n ns)
                       7 -> do ops <- fromBin; return (CPOper ops)
                       8 -> do i1 <- fromBin; i2 <- fromBin; p <- fromBin;
                               return (CPCon1 i1 i2 p)
                       9 -> do i1 <- fromBin; i2 <- fromBin;
                               ts <- fromBin; ps <- fromBin;
                               return (CPConTs i1 i2 ts ps)
                       n -> internalError $ "GenBin.Bin(CPat).readBytes: " ++ show n
  
  instance Bin CPOp where
      writeBytes (CPRand p) = do putI 0; toBin p
      writeBytes (CPRator n i) = do putI 1; toBin n; toBin i
      readBytes =
          do tag <- getI
             case tag of
               0 -> do p <- fromBin; return (CPRand p)
               1 -> do n <- fromBin; i <- fromBin; return (CPRator n i)
               n -> internalError $ "GenBin.Bin(CPOp).readBytes: " ++ show n
  
  instance Bin COp where
      writeBytes (CRand e) = do putI 0; toBin e
      writeBytes (CRator n i) = do putI 1; toBin n; toBin i
      readBytes =
          do tag <- getI
             case tag of
               0 -> do e <- fromBin; return (CRand e)
               1 -> do n <- fromBin; i <- fromBin; return (CRator n i)
               n -> internalError $ "GenBin.Bin(COp).readBytes: " ++ show n
  
  instance Bin CLiteral where
      writeBytes (CLiteral pos l) = do toBin pos; toBin l
      readBytes = do pos <- fromBin; l <- fromBin; return (CLiteral pos l)
  
  instance Bin Char where
      writeBytes c = writeBytes [c]
      readBytes = do s <- readBytes
                     case s of
                         [c] -> return c
                         _ -> internalError $ "GenBin.Bin(Char).readBytes: bad char: " ++ s
  
  instance Bin Literal where
      writeBytes (LString s) = do putI 0; toBin s
      writeBytes (LChar c)   = do putI 1; toBin c
      writeBytes (LInt il)   = do putI 2; toBin il
      writeBytes (LReal d)   = do putI 3; toBin d
      writeBytes (LPosition) = do putI 4
      readBytes = do tag <- getI
                     case tag of
                       0 -> do s <- fromBin; return (LString s)
                       1 -> do c <- fromBin; return (LChar c)
                       2 -> do il <- fromBin; return (LInt il)
                       3 -> do d <- fromBin; return (LReal d)
                       4 -> return LPosition
                       n -> internalError $ "GenBin.Bin(Literal).readBytes: " ++ show n
  
  instance Bin CQual where
      writeBytes (CQGen t p e) = do putI 0; toBin t; toBin p; toBin e
      writeBytes (CQFilter e)  = do putI 1; toBin e
      readBytes = do tag <- getI
                     case tag of
                       0 -> do t <- fromBin; p <- fromBin; e <- fromBin
                               return (CQGen t p e)
                       1 -> do e <- fromBin; return (CQFilter e)
                       n -> internalError $ "GenBin.Bin(CQual).readBytes: " ++ show n
  
  instance Bin CExpr where
      writeBytes (CLam i e) = do putI 0; toBin i; toBin e
      writeBytes (CLamT i qt e) = do putI 1; toBin i; toBin qt; toBin e
      writeBytes (Cletseq ds e) = do putI 2; toBin ds; toBin e
      writeBytes (Cletrec ds e) = do putI 3; toBin ds; toBin e
      writeBytes (CSelect e i) = do putI 4; toBin e; toBin i
      writeBytes (CCon i es) = do putI 5; toBin i; toBin es
      writeBytes (Ccase pos e arms) = do putI 6; toBin pos; toBin e; toBin arms
      writeBytes (CStruct mb i ies) = do putI 7; toBin mb; toBin i; toBin ies
      writeBytes (CStructUpd e ies) = do putI 8; toBin e; toBin ies
      writeBytes (Cwrite pos e1 e2) = do putI 9; toBin pos; toBin e1; toBin e2
      writeBytes (CAny pos uk) = do putI 10; toBin pos; toBin uk
      writeBytes (CVar i) = do putI 11; toBin i
      writeBytes (CApply e es) = do putI 12; toBin e; toBin es
      writeBytes (CTaskApply e es) = do putI 13; toBin e; toBin es
      writeBytes (CTaskApplyT e t es) = do putI 14; toBin e; toBin t; toBin es
      writeBytes (CLit l) = do putI 15; toBin l
      writeBytes (CBinOp e1 i e2) = do putI 16; toBin e1; toBin i; toBin e2
      writeBytes (CHasType e qt) = do putI 17; toBin e; toBin qt
      writeBytes (Cif pos e1 e2 e3) = do putI 18;
                                         toBin pos; toBin e1; toBin e2; toBin e3
      writeBytes (CSub pos e1 e2) = do putI 19; toBin pos; toBin e1; toBin e2
      writeBytes (CSub2 e1 e2 e3) = do putI 20; toBin e1; toBin e2; toBin e3
      writeBytes (Cmodule pos ss) = do putI 21; toBin pos; toBin ss
      writeBytes (Cinterface pos mi ds) = do putI 22;
                                             toBin pos; toBin mi; toBin ds
      writeBytes (CmoduleVerilog e b vc vr va vf vs vp) =
          do putI 23; toBin e; toBin b; toBin vc; toBin vr; toBin va;
             toBin vf; toBin vs; toBin vp
      writeBytes (CForeignFuncC i qt) = do putI 24; toBin i; toBin qt
      writeBytes (Cdo b ss) = do putI 25; toBin b; toBin ss
      writeBytes (Caction pos ss) = do putI 26; toBin pos; toBin ss
      writeBytes (Crules ps rs) = do putI 27; toBin ps; toBin rs
      writeBytes (COper ops) = do putI 29; toBin ops
      -- these are from deriving and typecheck
      writeBytes (CCon1 i1 i2 e) = do putI 30; toBin i1; toBin i2; toBin e
      writeBytes (CSelectTT i1 e i2) = do putI 31; toBin i1; toBin e; toBin i2
      writeBytes (CCon0 mi i) = do putI 32; toBin mi; toBin i
      writeBytes (CConT i1 i2 es) = do putI 33; toBin i1; toBin i2; toBin es
      writeBytes (CStructT t ies) = do putI 34; toBin t; toBin ies
      writeBytes (CSelectT i1 i2) = do putI 35; toBin i1; toBin i2
      writeBytes (CLitT t l) = do putI 36; toBin t; toBin l
      writeBytes (CAnyT pos uk t) = do putI 37; toBin pos; toBin uk
      writeBytes (CmoduleVerilogT t e b vc vr va vf vs vp) =
          do putI 38; toBin t; toBin e; toBin b; toBin vc; toBin vr; toBin va;
             toBin vf; toBin vs; toBin vp
      writeBytes (CForeignFuncCT i t) = do putI 39; toBin i; toBin t
      writeBytes (CTApply e ts) = do putI 40; toBin e; toBin ts
      writeBytes (Cattributes ps) = do putI 41; toBin ps
      writeBytes (CSubUpdate pos e_vec (e_h, e_l) e_rhs) = do
        putI 42; toBin pos; toBin e_vec; toBin e_h;
        toBin e_l; toBin e_rhs
      readBytes =
          do tag <- getI
             case tag of
               0 -> do i <- fromBin; e <- fromBin; return (CLam i e)
               1 -> do i <- fromBin; qt <- fromBin; e <- fromBin;
                       return (CLamT i qt e)
               2 -> do ds <- fromBin; e <- fromBin; return (Cletseq ds e)
               3 -> do ds <- fromBin; e <- fromBin; return (Cletrec ds e)
               4 -> do e <- fromBin; i <- fromBin; return (CSelect e i)
               5 -> do i <- fromBin; es <- fromBin; return (CCon i es)
               6 -> do pos <- fromBin; e <- fromBin; arms <- fromBin;
                       return (Ccase pos e arms)
               7 -> do mb <- fromBin; i <- fromBin; ies <- fromBin;
                       return (CStruct mb i ies)
               8 -> do i <- fromBin; ies <- fromBin; return (CStructUpd i ies)
               9 -> do pos <- fromBin; e1 <- fromBin; e2 <- fromBin;
                       return (Cwrite pos e1 e2)
               10 -> do pos <- fromBin; uk <- fromBin; return (CAny pos uk)
               11 -> do i <- fromBin; return (CVar i)
               12 -> do e <- fromBin; es <- fromBin; return (CApply e es)
               13 -> do e <- fromBin; es <- fromBin; return (CTaskApply e es)
               14 -> do e <- fromBin; t <- fromBin; es <- fromBin;
                        return (CTaskApplyT e t es)
               15 -> do l <- fromBin; return (CLit l)
               16 -> do e1 <- fromBin; i <- fromBin; e2 <- fromBin;
                        return (CBinOp e1 i e2)
               17 -> do e <- fromBin; qt <- fromBin; return (CHasType e qt)
               18 -> do pos <- fromBin; e1 <- fromBin; e2 <- fromBin;
                        e3 <- fromBin; return (Cif pos e1 e2 e3)
               19 -> do pos <- fromBin; e1 <- fromBin; e2 <- fromBin;
                        return (CSub pos e1 e2)
               20 -> do e1 <- fromBin; e2 <- fromBin; e3 <- fromBin;
                        return (CSub2 e1 e2 e3)
               21 -> do pos <- fromBin; ss <- fromBin; return (Cmodule pos ss)
               22 -> do pos <- fromBin; mi <- fromBin; ds <- fromBin;
                        return (Cinterface pos mi ds)
               23 -> do e <- fromBin; b <- fromBin; vc <- fromBin;
                        vr <- fromBin; va <- fromBin; vf <- fromBin;
                        vs <- fromBin; vp <- fromBin;
                        return (CmoduleVerilog e b vc vr va vf vs vp)
               24 -> do i <- fromBin; qt <- fromBin; return (CForeignFuncC i qt)
               25 -> do b <- fromBin; ss <- fromBin; return (Cdo b ss)
               26 -> do pos <- fromBin; ss <- fromBin; return (Caction pos ss)
               27 -> do ps <- fromBin; rs <- fromBin; return (Crules ps rs)
               29 -> do ops <- fromBin; return (COper ops)
               30 -> do i1 <- fromBin; i2 <- fromBin; e <- fromBin;
                        return (CCon1 i1 i2 e)
               31 -> do i1 <- fromBin; e <- fromBin; i2 <- fromBin;
                        return (CSelectTT i1 e i2)
               32 -> do mi <- fromBin; i <- fromBin; return (CCon0 mi i)
               33 -> do i1 <- fromBin; i2 <- fromBin; es <- fromBin;
                        return (CConT i1 i2 es)
               34 -> do t <- fromBin; ies <- fromBin; return (CStructT t ies)
               35 -> do i1 <- fromBin; i2 <- fromBin; return (CSelectT i1 i2)
               36 -> do t <- fromBin; l <- fromBin; return (CLitT t l)
               37 -> do pos <- fromBin; uk <- fromBin; t <- fromBin;
                        return (CAnyT pos uk t)
               38 -> do t <- fromBin; e <- fromBin; b <- fromBin; vc <- fromBin;
                        vr <- fromBin; va <- fromBin; vf <- fromBin;
                        vs <- fromBin; vp <- fromBin;
                        return (CmoduleVerilogT t e b vc vr va vf vs vp)
               39 -> do i <- fromBin; t <- fromBin; return (CForeignFuncCT i t)
               40 -> do e <- fromBin; ts <- fromBin; return (CTApply e ts)
               41 -> do ps <- fromBin; return (Cattributes ps)
               42 -> do pos <- fromBin; e_vec <- fromBin; e_h <- fromBin;
                        e_l <- fromBin; e_rhs <- fromBin
                        return (CSubUpdate pos e_vec (e_h, e_l) e_rhs)
               n -> internalError $ "GenBin.Bin(CExpr).readBytes: " ++ show n
  
  instance Bin CDefl where
      writeBytes (CLValueSign d qs) = do putI 0; toBin d; toBin qs
      writeBytes (CLValue i cs qs)  = do putI 1; toBin i; toBin cs; toBin qs
      writeBytes (CLMatch p e)  = do putI 2; toBin p; toBin e
      readBytes =
          do tag <- getI
             case tag of
              0 -> do d <- fromBin; qs <- fromBin; return (CLValueSign d qs)
              1 -> do i <- fromBin; cs <- fromBin; qs <- fromBin;
                      return (CLValue i cs qs)
              2 -> do p <- fromBin; e <- fromBin; return (CLMatch p e)
              n -> internalError $ "GenBin.Bin(CDefl).readBytes: " ++ show n
  
  instance Bin CDef where
      writeBytes (CDef i qt cs) = do putI 0; toBin i; toBin qt; toBin cs
      writeBytes (CDefT i tvs qt cs) =
          do putI 1; toBin i; toBin tvs; toBin qt; toBin cs
      readBytes =
          do tag <- getI
             case tag of
              0 -> do i <- fromBin; qt <- fromBin; cs <- fromBin;
                      return (CDef i qt cs)
              1 -> do i <- fromBin; tvs <- fromBin; qt <- fromBin;
                      cs <- fromBin; return (CDefT i tvs qt cs)
              n -> internalError $ "GenBin.Bin(CDef).readBytes: " ++ show n
  
  instance Bin CStmt where
      writeBytes (CSBindT p me ps qt e) =
          do putI 0; toBin p; toBin me; toBin ps; toBin qt; toBin e
      writeBytes (CSBind p me ps e) =
          do putI 1; toBin p; toBin me; toBin ps; toBin e
      writeBytes (CSletseq ds)  = do putI 2; toBin ds
      writeBytes (CSletrec ds)  = do putI 3; toBin ds
      writeBytes (CSExpr me e)  = do putI 4; toBin me; toBin e
      readBytes =
          do tag <- getI
             case tag of
              0 -> do p <- fromBin; me <- fromBin; ps <- fromBin; qt <- fromBin;
                      e <- fromBin; return (CSBindT p me ps qt e)
              1 -> do p <- fromBin; me <- fromBin; ps <- fromBin; e <- fromBin;
                      return (CSBind p me ps e)
              2 -> do ds <- fromBin; return (CSletseq ds)
              3 -> do ds <- fromBin; return (CSletseq ds)
              4 -> do me <- fromBin; e <- fromBin; return (CSExpr me e)
              n -> internalError $ "GenBin.Bin(CStmt).readBytes: " ++ show n
  
  instance Bin CMStmt where
      writeBytes (CMStmt s) = do putI 0; toBin s
      writeBytes (CMrules e) = do putI 1; toBin e
      writeBytes (CMinterface e)  = do putI 2; toBin e
      writeBytes (CMTupleInterface pos es)  = do putI 3; toBin pos; toBin es
      readBytes =
          do tag <- getI
             case tag of
              0 -> do s <- fromBin; return (CMStmt s)
              1 -> do e <- fromBin; return (CMrules e)
              2 -> do e <- fromBin; return (CMinterface e)
              3 -> do pos <- fromBin; es <- fromBin;
                      return (CMTupleInterface pos es)
              n -> internalError $ "GenBin.Bin(CMStmt).readBytes: " ++ show n
  
  instance Bin CCaseArm where
      writeBytes (CCaseArm p qs e) = do toBin p; toBin qs; toBin e
      readBytes = do p <- fromBin; qs <- fromBin; e <- fromBin;
                          return (CCaseArm p qs e)
  
  instance Bin CRule where
      writeBytes (CRule ps me qs e) =
          do putI 0; toBin ps; toBin me; toBin qs; toBin e
      writeBytes (CRuleNest ps me qs rs) =
          do putI 1; toBin ps; toBin me; toBin qs; toBin rs
      readBytes =
          do tag <- getI
             case tag of
              0 -> do ps <- fromBin; me <- fromBin; qs <- fromBin; e <- fromBin;
                      return (CRule ps me qs e)
              1 -> do ps <- fromBin; me <- fromBin; qs <- fromBin; rs <- fromBin;
                      return (CRuleNest ps me qs rs)
              n -> internalError $ "GenBin.Bin(CRule).readBytes: " ++ show n
  
  
  -- ----------
  -- Bin Pragma
  
  instance Bin Pragma where
      writeBytes (Pproperties i ps) = do putI 0; toBin i; toBin ps
      writeBytes (Pnoinline is)     = do putI 1; toBin is
      readBytes = do tag <- getI
                     case tag of
                       0 -> do i <- fromBin
                               ps <- fromBin
                               return (Pproperties i ps)
                       1 -> do is <- fromBin; return (Pnoinline is)
                       n -> internalError $ "GenBin.Bin(Pragma).readBytes: " ++ show n
  
  -- ----------
  -- Bin IPackage
  
  instance Bin (IPackage a) where
      writeBytes pkg =
          section "IPackage" $
          do toBin (ipkg_name pkg)
             toBin (ipkg_depends pkg)
             toBin (ipkg_pragmas pkg)
             toBin (ipkg_defs pkg)
      readBytes = do when doTrace $ traceM("read IPackage")
                     name    <- fromBin
                     depends <- fromBin
                     pragmas <- fromBin
                     defs    <- fromBin
                     return $ IPackage { ipkg_name    = name
                                       , ipkg_depends = depends
                                       , ipkg_pragmas = pragmas
                                       , ipkg_defs    = defs
                                       }
  
  -- ----------
  -- Bin IDef
  
  instance Bin (IDef a) where
      writeBytes (IDef i ty e p) =
          section "IDef" $
          do toBin i; toBin ty; toBin e ; toBin p
      readBytes = do when doTrace $ traceM("read IDef")
                     i <- fromBin
                     ty <- fromBin
                     e <- fromBin
                     p <- fromBin
                     return $ IDef i ty e p
  
  -- ----------
  -- Bin IExpr
  
  instance Bin (IExpr a) where
      writeBytes (ILam i t e)   = do putI 0; toBin i; toBin t; toBin e
      writeBytes (IAps e ts es) = do putI 1; toBin e; toBin ts; toBin es
      writeBytes (IVar i)       = do putI 2; toBin i
      writeBytes (ILAM i k e)   = do putI 3; toBin i; toBin k; toBin e
      writeBytes (ICon i ic)    = do putI 4; toBin i; toBin ic
      writeBytes (IRefT _ _ _)  = internalError "GenBin.Bin(IExpr).writeBytes: IRefT"
      readBytes = do tag <- getI
                     case tag of
                       0 -> do i <- fromBin
                               t <- fromBin
                               e <- fromBin
                               return (ILam i t e)
                       1 -> do e <- fromBin
                               ts <- fromBin
                               es <- fromBin
                               return (IAps e ts es)
                       2 -> do i <- fromBin; return (IVar i)
                       3 -> do i <- fromBin
                               k <- fromBin
                               e <- fromBin
                               return (ILAM i k e)
                       4 -> do i <- fromBin; ic <- fromBin; return (ICon i ic)
                       n -> internalError $ "GenBin.Bin(IExpr).readBytes: " ++ show n
  
  -- ----------
  -- Bin ConTagInfo
  
  instance Bin ConTagInfo where
    writeBytes (ConTagInfo conNo numCon conTag tagSize) =
      do toBin conNo; toBin numCon; toBin conTag; toBin tagSize
    readBytes = do
      conNo <- fromBin; numCon <- fromBin; conTag <- fromBin; tagSize <- fromBin
      return $ ConTagInfo conNo numCon conTag tagSize
  
  -- ----------
  -- Bin IConInfo
  
  instance Bin (IConInfo a) where
      writeBytes (ICDef t _)      = do putI 0; toBin t
      writeBytes (ICPrim t p)     = do putI 1; toBin t; toBin (fromEnum p)
      writeBytes (ICForeign t n isC ps Nothing) =
          do putI 2; toBin t; toBin n; toBin isC; toBin ps
      writeBytes (ICForeign { fcallNo = (Just _) }) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICForeign with cookie"
      writeBytes (ICCon t cti)    = do putI 3; toBin t; toBin cti
      writeBytes (ICIs t cti)     = do putI 4; toBin t; toBin cti
      writeBytes (ICOut t cti)    = do putI 5; toBin t; toBin cti
      writeBytes (ICTuple t is)   = do putI 6; toBin t; toBin is
      writeBytes (ICSel t i j)    = do putI 7; toBin t; toBin i; toBin j
      writeBytes (ICVerilog t ui v tss) =
          do putI 8; toBin t; toBin ui; toBin v; toBin tss
      writeBytes (ICUndet t u mv) = do putI 9; toBin t; toBin u; toBin mv
      writeBytes (ICInt t v)      = do putI 10; toBin t; toBin v
      writeBytes (ICReal t v)     = do putI 11; toBin t; toBin v
      writeBytes (ICString t s)   = do putI 12; toBin t; toBin s
      writeBytes (ICChar t c)     = do putI 13; toBin t; toBin c
      writeBytes (ICRuleAssert t as) = do putI 14; toBin t; toBin as
      writeBytes (ICSchedPragmas t sps) = do putI 15; toBin t; toBin sps
      writeBytes (ICName t n)     = do putI 16; toBin t; toBin n
      writeBytes (ICAttrib t pps) = do putI 17; toBin t; toBin pps;
      writeBytes (ICPosition t pos) = do putI 18; toBin t; toBin pos
      writeBytes (ICType t it)    = do putI 19; toBin t; toBin it
      writeBytes (ICIFace _ _ _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICIFace"
      writeBytes (ICValue _ _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICValue"
      writeBytes (ICMethArg _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICMethArg"
      writeBytes (ICModPort _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICModPort"
      writeBytes (ICModParam _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICModParam"
      writeBytes (ICStateVar _ _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICStateVar"
      writeBytes (ICClock _ _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICClock"
      writeBytes (ICReset _ _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICReset"
      writeBytes (ICInout _ _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICInout"
      writeBytes (ICLazyArray _ _ _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICLazyArray"
      writeBytes (ICPred _ _) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICPred"
      writeBytes (ICHandle { }) =
          internalError "GenBin.Bin(IConInfo).writeBytes: ICHandle"
      readBytes = do tag <- getI
                     t <- fromBin
                     case tag of
                       0  -> -- ICDef contains the expression for the def
                             -- Here we use a don't-care value for the expression
                             -- XXX Should we use an error there, so it's not silently used?
                             return (ICDef t (icUndet t UNoMatch))
                       1  -> do p <- fromBin; return (ICPrim t (toEnum p))
                       2  -> do n <- fromBin
                                isC <- fromBin
                                ps <- fromBin
                                return (ICForeign t n isC ps Nothing)
                       3  -> do cti <- fromBin; return (ICCon t cti)
                       4  -> do cti <- fromBin; return (ICIs t cti)
                       5  -> do cti <- fromBin; return (ICOut t cti)
                       6  -> do is <- fromBin; return (ICTuple t is)
                       7  -> do i <- fromBin; j <- fromBin; return (ICSel t i j)
                       8  -> do ui <- fromBin
                                v <- fromBin
                                tss <- fromBin
                                return (ICVerilog t ui v tss)
                       9  -> do u <- fromBin
                                mv <- fromBin
                                return (ICUndet t u mv)
                       10 -> do v <- fromBin; return (ICInt t v)
                       11 -> do v <- fromBin; return (ICReal t v)
                       12 -> do s <- fromBin; return (ICString t s)
                       13 -> do c <- fromBin; return (ICChar t c)
                       14 -> do as <- fromBin; return (ICRuleAssert t as)
                       15 -> do sps <- fromBin; return (ICSchedPragmas t sps)
                       16 -> do n <- fromBin; return (ICName t n)
                       17 -> do pps <- fromBin; return (ICAttrib t pps)
                       18 -> do pos <- fromBin; return (ICPosition t pos)
                       19 -> do it <- fromBin; return (ICType t it)
                       n  -> internalError $ "GenBin.Bin(IConInfo).readBytes: " ++ show n
  