{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans -fallow-overlapping-instances -fallow-undecidable-instances -fparr #-}




{- 
-- WARNING WARNING WARNING --

This is an autogenerated file from src/Pugs/AST/Internals.hs.

Do not edit this file.

All changes made here will be lost!

-- WARNING WARNING WARNING --
-}

#ifndef HADDOCK









module Pugs.AST.Internals.Instances ()
where
import Pugs.AST.Internals
import Data.Yaml.Syck
import DrIFT.YAML
import DrIFT.JSON
import DrIFT.Perl5
import DrIFT.Perl6Class
import Control.Monad
import qualified Data.IntSet as IntSet
import qualified Data.ByteString as Buf

import Pugs.AST.Scope
import Pugs.AST.Pos
import Pugs.AST.Prag
import Pugs.AST.SIO
import Pugs.Types
import Pugs.Internals hiding (get, put)
import Pugs.Embed.Perl5
import qualified Data.Set       as Set
import qualified Data.Map       as Map
import qualified Pugs.Val       as Val

import qualified Data.HashTable    as H

import Data.Binary
import GHC.Exts (unsafeCoerce#)

{-# NOINLINE _FakeEnv #-}
_FakeEnv :: Env
_FakeEnv = unsafePerformIO $ stm $ do
    glob <- newTVar $ MkPad Map.empty
    ref  <- newTVar Map.empty
    init <- newTVar $ MkInitDat { initPragmas=[] }
    maxi <- newTVar $ MkObjectId 1
    return $ MkEnv
        { envContext = CxtVoid
        , envLexical = emptyPad
        , envLexPads = []
        , envCaller  = Nothing
        , envCompPad = Nothing
        , envLValue  = False
        , envGlobal  = MkMPad (addressOf glob) glob
        , envPackage = cast "Main"
        , envEval    = const (return VUndef)
        , envFrames  = Set.empty
        , envBody    = Val undef
        , envDebug   = Just ref -- Set to "Nothing" to disable debugging
        , envPos     = MkPos (__"<null>") 1 1 1 1
        , envPragmas = []
        , envInitDat = init
        , envMaxId   = maxi
        , envAtomic  = False
        }

fakeEval :: MonadIO m => Eval Val -> m Val
fakeEval = io . runEvalIO _FakeEnv

instance YAML Val.Val

instance YAML LexPads where
    asYAML _ = return nilNode
    fromYAML _ = return []

instance YAML ([Val] -> Eval Val) where
    asYAML _ = return nilNode
    fromYAML _ = return (const $ return VUndef)
instance YAML (Maybe Env) where
    asYAML _ = return nilNode
    fromYAML _ = return Nothing
instance YAML (Eval Val) where
    asYAML x = asYAML =<< fakeEval x
    fromYAML x = return =<< fromYAML x
instance (Ord a, YAML a) => YAML (Set a) where
    asYAML x = do
        x' <- mapM asYAML (Set.toAscList x)
        (return . mkTagNode "Set" . ESeq) x'
    fromYAML node = do
        fmap Set.fromDistinctAscList (fromYAMLseq node)

instance YAML a => YAML (Map String a) where
    asYAML x = asYAMLmap "Map" $ Map.toAscList (Map.map asYAML x)
    fromYAML node = fmap Map.fromList (fromYAMLmap node)
instance YAML a => YAML (Map Var a) where
    asYAML x = asYAMLmap "Map" . sortBy (\x y -> fst x `compare` fst y) $
        [ (cast k, asYAML v) | (k, v) <- Map.toList x ]
    fromYAML node = do
        list <- fromYAMLmapBuf node
        return (Map.fromList [ (cast k, v) | (k, v) <- list ])
instance Typeable a => YAML (IVar a) where
    asYAML x = asYAML (MkRef x)
instance YAML VRef where
    asYAML (MkRef (ICode cv))
        | Just (mc :: VMultiCode) <- fromTypeable cv = do
            mcC <- asYAML (mc :: VMultiCode)
            return $ mkTagNode (tagHs "VMultiCode") $ ESeq [mcC]
        | otherwise = do
            VCode vsub  <- fakeEval $ fmap VCode (code_fetch cv)
            vsubC       <- asYAML vsub
            return $ mkTagNode (tagHs "VCode") $ ESeq [vsubC]
    asYAML (MkRef (IScalar sv)) = do
        val <- fakeEval $ scalar_fetch sv
        svC <- asYAML val
        let tag = if scalar_iType sv == mkType "Scalar::Const"
                    then "VScalar" else "IScalar"
        return $ mkTagNode (tagHs tag) $ ESeq [svC]
    asYAML (MkRef (IArray av)) = do
        VList vals <- fakeEval $ fmap VList (array_fetch av)
        avC <- asYAML vals
        return $ mkTagNode (tagHs "Array") $ ESeq [avC]
    asYAML (MkRef (IHash hv)) = do
        VMatch MkMatch{ matchSubNamed = hv } <- fakeEval $ fmap (VMatch . MkMatch False 0 0 "" []) (hash_fetch hv)
        hvC <- asYAML hv
        return $ mkTagNode (tagHs "Hash") $ ESeq [hvC]
    asYAML (MkRef (IPair pv)) = do
        VList [k, v] <- fakeEval $ fmap (\(k, v) -> VList [k, v]) (pair_fetch pv)
        avC <- asYAML (k, v)
        return $ mkTagNode (tagHs "Pair") $ ESeq [avC]
    asYAML ref = do
        val <- fakeEval $ readRef ref
        svC <- asYAML val
        io $ print "====>"
        io $ print svC
        fail ("Not implemented: asYAML \"" ++ showType (refType ref) ++ "\"")
    fromYAML MkNode{n_tag=Just s, n_elem=ESeq [node]}
        | s == packBuf "tag:hs:VMultiCode"   =
            fmap (MkRef . ICode) (fromYAML node :: IO VMultiCode)
        | s == packBuf "tag:hs:VCode"   =
            fmap (MkRef . ICode) (fromYAML node :: IO VCode)
        | s == packBuf "tag:hs:VScalar" =
            fmap (MkRef . IScalar) (fromYAML node :: IO VScalar)
        | s == packBuf "tag:hs:Pair"    =
            fmap pairRef (fromYAML node :: IO VPair)
        | s == packBuf "tag:hs:IScalar" = newV newScalar
        | s == packBuf "tag:hs:Array"   = newV newArray
        | s == packBuf "tag:hs:Hash"    = newV newHash
        where newV f = fmap MkRef (f =<< fromYAML node)
    fromYAML node = fail $ "Unhandled YAML node: " ++ show node
instance YAML IHash where
     asYAML x = do
         l      <- io $ H.toList x
         asYAMLmap "IHash" (map (\(k, v) -> (k, asYAML v)) l)
     fromYAML node = do
         l  <- fromYAMLmap node
         l' <- H.fromList H.hashString l
         return l'

instance YAML ID where
    asYAML x = asYAML (idBuf x)
    fromYAML x = do
        buf <- fromYAML x
        return $ bufToID buf
 
instance Perl5 ID where
    showPerl5 x = showPerl5 (cast x :: ByteString)
instance JSON ID where
    showJSON x = showJSON (cast x :: ByteString)

instance YAML Pkg where
    asYAML x = asYAML (cast x :: ByteString)
    fromYAML = fmap (cast :: ByteString -> Pkg) . fromYAML

instance YAML Var where
    asYAML x = asYAML (cast x :: ByteString)
    fromYAML = fmap (cast :: ByteString -> Var) . fromYAML

instance YAML EntryFlags where
    asYAML (MkEntryFlags x) = asYAML x
    fromYAML = fmap MkEntryFlags . fromYAML
 
instance Perl5 Var where
    showPerl5 x = showPerl5 (cast x :: String)
instance JSON Var where
    showJSON x = showJSON (cast x :: String)

instance YAML (Set Val) where
    asYAML = asYAML . Set.toAscList
    fromYAML = fmap Set.fromAscList . fromYAML 

instance YAML VControl
instance YAML VThread
instance YAML ClassTree
instance YAML Dynamic
instance YAML ProcessHandle
instance YAML Regex
instance YAML Unique
instance YAML VComplex
instance YAML VHandle
instance YAML VOpaque
instance YAML VSocket
instance YAML PerlSV

instance Perl5 Exp where
    showPerl5 _ = "(undef)"
instance JSON Exp where
    showJSON _ = "null"

-- Non-canonical serialization... needs work
instance (Show (TVar a)) => Perl5 (TVar a) where
    showPerl5 _ = "(warn '<ref>')"
instance (Show (TVar a)) => JSON (TVar a) where
    showJSON _ = "null"

instance Perl5 Val where
    showPerl5 (VUndef) = showP5Class "VUndef"
    showPerl5 (VBool aa) = showP5ArrayObj "VBool" [showPerl5 aa]
    showPerl5 (VInt aa) = showP5ArrayObj "VInt" [showPerl5 aa]
    showPerl5 (VRat aa) = showP5ArrayObj "VRat" [showPerl5 aa]
    showPerl5 (VNum aa) = showP5ArrayObj "VNum" [showPerl5 aa]
    showPerl5 (VStr aa) = showP5ArrayObj "VStr" [showPerl5 aa]
    showPerl5 (VList aa) = showP5ArrayObj "VList" [showPerl5 aa]
    showPerl5 (VType aa) = showP5ArrayObj "VType" [showPerl5 aa]
    showPerl5 (VCode{}) = showP5Class "VUndef"

{-* Generated by DrIFT : Look, but Don't Touch. *-}
instance YAML VSubst where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkSubst" -> do
	    let ESeq [aa, ab] = e
	    liftM2 MkSubst (fromYAML aa) (fromYAML ab)
	"MkTrans" -> do
	    let ESeq [aa, ab] = e
	    liftM2 MkTrans (fromYAML aa) (fromYAML ab)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkSubst","MkTrans"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkSubst","MkTrans"] ++ " in node " ++ show e
    asYAML (MkSubst aa ab) = asYAMLseq "MkSubst" [asYAML aa, asYAML ab]
    asYAML (MkTrans aa ab) = asYAMLseq "MkTrans" [asYAML aa, asYAML ab]

instance YAML VThunk where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkThunk" -> do
	    let ESeq [aa, ab] = e
	    liftM2 MkThunk (fromYAML aa) (fromYAML ab)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkThunk"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkThunk"] ++ " in node " ++ show e
    asYAML (MkThunk aa ab) = asYAMLseq "MkThunk" [asYAML aa, asYAML ab]

instance YAML VProcess where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkProcess" -> do
	    let ESeq [aa] = e
	    liftM MkProcess (fromYAML aa)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkProcess"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkProcess"] ++ " in node " ++ show e
    asYAML (MkProcess aa) = asYAMLseq "MkProcess" [asYAML aa]

instance YAML VRule where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkRulePCRE" -> do
	    let liftM6 f m1 m2 m3 m4 m5 m6 = do
		{x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; return (f x1 x2 x3 x4 x5 x6)}
	    let ESeq [aa, ab, ac, ad, ae, af] = e
	    liftM6 MkRulePCRE (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae) (fromYAML af)
	"MkRulePGE" -> do
	    let ESeq [aa, ab, ac, ad] = e
	    liftM4 MkRulePGE (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkRulePCRE","MkRulePGE"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkRulePCRE","MkRulePGE"] ++ " in node " ++ show e
    asYAML (MkRulePCRE aa ab ac ad ae af) = asYAMLseq "MkRulePCRE"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad, asYAML ae, asYAML af]
    asYAML (MkRulePGE aa ab ac ad) = asYAMLseq "MkRulePGE"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad]

instance YAML Val where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"VUndef" -> do
	    return VUndef
	"VBool" -> do
	    let ESeq [aa] = e
	    liftM VBool (fromYAML aa)
	"VInt" -> do
	    let ESeq [aa] = e
	    liftM VInt (fromYAML aa)
	"VRat" -> do
	    let ESeq [aa] = e
	    liftM VRat (fromYAML aa)
	"VNum" -> do
	    let ESeq [aa] = e
	    liftM VNum (fromYAML aa)
	"VComplex" -> do
	    let ESeq [aa] = e
	    liftM VComplex (fromYAML aa)
	"VStr" -> do
	    let ESeq [aa] = e
	    liftM VStr (fromYAML aa)
	"VList" -> do
	    let ESeq [aa] = e
	    liftM VList (fromYAML aa)
	"VType" -> do
	    let ESeq [aa] = e
	    liftM VType (fromYAML aa)
	"VJunc" -> do
	    let ESeq [aa] = e
	    liftM VJunc (fromYAML aa)
	"VError" -> do
	    let ESeq [aa, ab] = e
	    liftM2 VError (fromYAML aa) (fromYAML ab)
	"VControl" -> do
	    let ESeq [aa] = e
	    liftM VControl (fromYAML aa)
	"VRef" -> do
	    let ESeq [aa] = e
	    liftM VRef (fromYAML aa)
	"VCode" -> do
	    let ESeq [aa] = e
	    liftM VCode (fromYAML aa)
	"VBlock" -> do
	    let ESeq [aa] = e
	    liftM VBlock (fromYAML aa)
	"VHandle" -> do
	    let ESeq [aa] = e
	    liftM VHandle (fromYAML aa)
	"VSocket" -> do
	    let ESeq [aa] = e
	    liftM VSocket (fromYAML aa)
	"VThread" -> do
	    let ESeq [aa] = e
	    liftM VThread (fromYAML aa)
	"VProcess" -> do
	    let ESeq [aa] = e
	    liftM VProcess (fromYAML aa)
	"VRule" -> do
	    let ESeq [aa] = e
	    liftM VRule (fromYAML aa)
	"VSubst" -> do
	    let ESeq [aa] = e
	    liftM VSubst (fromYAML aa)
	"VMatch" -> do
	    let ESeq [aa] = e
	    liftM VMatch (fromYAML aa)
	"VObject" -> do
	    let ESeq [aa] = e
	    liftM VObject (fromYAML aa)
	"VOpaque" -> do
	    let ESeq [aa] = e
	    liftM VOpaque (fromYAML aa)
	"PerlSV" -> do
	    let ESeq [aa] = e
	    liftM PerlSV (fromYAML aa)
	"VV" -> do
	    let ESeq [aa] = e
	    liftM VV (fromYAML aa)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["VUndef","VBool","VInt","VRat","VNum","VComplex","VStr","VList","VType","VJunc","VError","VControl","VRef","VCode","VBlock","VHandle","VSocket","VThread","VProcess","VRule","VSubst","VMatch","VObject","VOpaque","PerlSV","VV"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["VUndef","VBool","VInt","VRat","VNum","VComplex","VStr","VList","VType","VJunc","VError","VControl","VRef","VCode","VBlock","VHandle","VSocket","VThread","VProcess","VRule","VSubst","VMatch","VObject","VOpaque","PerlSV","VV"] ++ " in node " ++ show e
    asYAML (VUndef) = asYAMLcls "VUndef"
    asYAML (VBool aa) = asYAMLseq "VBool" [asYAML aa]
    asYAML (VInt aa) = asYAMLseq "VInt" [asYAML aa]
    asYAML (VRat aa) = asYAMLseq "VRat" [asYAML aa]
    asYAML (VNum aa) = asYAMLseq "VNum" [asYAML aa]
    asYAML (VComplex aa) = asYAMLseq "VComplex" [asYAML aa]
    asYAML (VStr aa) = asYAMLseq "VStr" [asYAML aa]
    asYAML (VList aa) = asYAMLseq "VList" [asYAML aa]
    asYAML (VType aa) = asYAMLseq "VType" [asYAML aa]
    asYAML (VJunc aa) = asYAMLseq "VJunc" [asYAML aa]
    asYAML (VError aa ab) = asYAMLseq "VError" [asYAML aa, asYAML ab]
    asYAML (VControl aa) = asYAMLseq "VControl" [asYAML aa]
    asYAML (VRef aa) = asYAMLseq "VRef" [asYAML aa]
    asYAML (VCode aa) = asYAMLseq "VCode" [asYAML aa]
    asYAML (VBlock aa) = asYAMLseq "VBlock" [asYAML aa]
    asYAML (VHandle aa) = asYAMLseq "VHandle" [asYAML aa]
    asYAML (VSocket aa) = asYAMLseq "VSocket" [asYAML aa]
    asYAML (VThread aa) = asYAMLseq "VThread" [asYAML aa]
    asYAML (VProcess aa) = asYAMLseq "VProcess" [asYAML aa]
    asYAML (VRule aa) = asYAMLseq "VRule" [asYAML aa]
    asYAML (VSubst aa) = asYAMLseq "VSubst" [asYAML aa]
    asYAML (VMatch aa) = asYAMLseq "VMatch" [asYAML aa]
    asYAML (VObject aa) = asYAMLseq "VObject" [asYAML aa]
    asYAML (VOpaque aa) = asYAMLseq "VOpaque" [asYAML aa]
    asYAML (PerlSV aa) = asYAMLseq "PerlSV" [asYAML aa]
    asYAML (VV aa) = asYAMLseq "VV" [asYAML aa]

instance YAML SubType where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"SubMethod" -> do
	    return SubMethod
	"SubCoroutine" -> do
	    return SubCoroutine
	"SubMacro" -> do
	    return SubMacro
	"SubRoutine" -> do
	    return SubRoutine
	"SubBlock" -> do
	    return SubBlock
	"SubPointy" -> do
	    return SubPointy
	"SubPrim" -> do
	    return SubPrim
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["SubMethod","SubCoroutine","SubMacro","SubRoutine","SubBlock","SubPointy","SubPrim"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["SubMethod","SubCoroutine","SubMacro","SubRoutine","SubBlock","SubPointy","SubPrim"] ++ " in node " ++ show e
    asYAML (SubMethod) = asYAMLcls "SubMethod"
    asYAML (SubCoroutine) = asYAMLcls "SubCoroutine"
    asYAML (SubMacro) = asYAMLcls "SubMacro"
    asYAML (SubRoutine) = asYAMLcls "SubRoutine"
    asYAML (SubBlock) = asYAMLcls "SubBlock"
    asYAML (SubPointy) = asYAMLcls "SubPointy"
    asYAML (SubPrim) = asYAMLcls "SubPrim"

instance JSON SubType where
    showJSON (SubMethod) = showJSScalar "SubMethod"
    showJSON (SubCoroutine) = showJSScalar "SubCoroutine"
    showJSON (SubMacro) = showJSScalar "SubMacro"
    showJSON (SubRoutine) = showJSScalar "SubRoutine"
    showJSON (SubBlock) = showJSScalar "SubBlock"
    showJSON (SubPointy) = showJSScalar "SubPointy"
    showJSON (SubPrim) = showJSScalar "SubPrim"

instance Perl5 SubType where
    showPerl5 (SubMethod) = showP5Class "SubMethod"
    showPerl5 (SubCoroutine) = showP5Class "SubCoroutine"
    showPerl5 (SubMacro) = showP5Class "SubMacro"
    showPerl5 (SubRoutine) = showP5Class "SubRoutine"
    showPerl5 (SubBlock) = showP5Class "SubBlock"
    showPerl5 (SubPointy) = showP5Class "SubPointy"
    showPerl5 (SubPrim) = showP5Class "SubPrim"

instance YAML Param where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkOldParam" -> do
	    let liftM9 f m1 m2 m3 m4 m5 m6 m7 m8 m9 = do
		{x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; x7 <- m7; x8 <- m8; x9 <- m9; return (f x1 x2 x3 x4 x5 x6 x7 x8 x9)}
	    let ESeq [aa, ab, ac, ad, ae, af, ag, ah, ai] = e
	    liftM9 MkOldParam (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae) (fromYAML af) (fromYAML ag) (fromYAML ah) (fromYAML ai)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkOldParam"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkOldParam"] ++ " in node " ++ show e
    asYAML (MkOldParam aa ab ac ad ae af ag ah ai) =
	   asYAMLseq "MkOldParam"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad, asYAML ae, asYAML af,
	    asYAML ag, asYAML ah, asYAML ai]

instance Perl5 Param where
    showPerl5 (MkOldParam aa ab ac ad ae af ag ah ai) =
	      showP5HashObj "MkOldParam"
	      [("isInvocant", showPerl5 aa) , ("isOptional", showPerl5 ab) ,
	       ("isNamed", showPerl5 ac) , ("isLValue", showPerl5 ad) ,
	       ("isWritable", showPerl5 ae) , ("isLazy", showPerl5 af) ,
	       ("paramName", showPerl5 ag) , ("paramContext", showPerl5 ah) ,
	       ("paramDefault", showPerl5 ai)]

instance JSON Param where
    showJSON (MkOldParam aa ab ac ad ae af ag ah ai) =
	     showJSHashObj "MkOldParam"
	     [("isInvocant", showJSON aa), ("isOptional", showJSON ab),
	      ("isNamed", showJSON ac), ("isLValue", showJSON ad),
	      ("isWritable", showJSON ae), ("isLazy", showJSON af),
	      ("paramName", showJSON ag), ("paramContext", showJSON ah),
	      ("paramDefault", showJSON ai)]

instance YAML SubAssoc where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"ANil" -> do
	    return ANil
	"AIrrelevantToParsing" -> do
	    return AIrrelevantToParsing
	"A_left" -> do
	    return A_left
	"A_right" -> do
	    return A_right
	"A_non" -> do
	    return A_non
	"A_chain" -> do
	    return A_chain
	"A_list" -> do
	    return A_list
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["ANil","AIrrelevantToParsing","A_left","A_right","A_non","A_chain","A_list"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["ANil","AIrrelevantToParsing","A_left","A_right","A_non","A_chain","A_list"] ++ " in node " ++ show e
    asYAML (ANil) = asYAMLcls "ANil"
    asYAML (AIrrelevantToParsing) = asYAMLcls "AIrrelevantToParsing"
    asYAML (A_left) = asYAMLcls "A_left"
    asYAML (A_right) = asYAMLcls "A_right"
    asYAML (A_non) = asYAMLcls "A_non"
    asYAML (A_chain) = asYAMLcls "A_chain"
    asYAML (A_list) = asYAMLcls "A_list"

instance JSON SubAssoc where
    showJSON (ANil) = showJSScalar "ANil"
    showJSON (AIrrelevantToParsing) =
	     showJSScalar "AIrrelevantToParsing"
    showJSON (A_left) = showJSScalar "A_left"
    showJSON (A_right) = showJSScalar "A_right"
    showJSON (A_non) = showJSScalar "A_non"
    showJSON (A_chain) = showJSScalar "A_chain"
    showJSON (A_list) = showJSScalar "A_list"

instance Perl5 SubAssoc where
    showPerl5 (ANil) = showP5Class "ANil"
    showPerl5 (AIrrelevantToParsing) =
	      showP5Class "AIrrelevantToParsing"
    showPerl5 (A_left) = showP5Class "A::left"
    showPerl5 (A_right) = showP5Class "A::right"
    showPerl5 (A_non) = showP5Class "A::non"
    showPerl5 (A_chain) = showP5Class "A::chain"
    showPerl5 (A_list) = showP5Class "A::list"

instance YAML MPad where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkMPad" -> do
	    let ESeq [aa, ab] = e
	    liftM2 MkMPad (fromYAML aa) (fromYAML ab)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkMPad"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkMPad"] ++ " in node " ++ show e
    asYAML (MkMPad aa ab) = asYAMLseq "MkMPad" [asYAML aa, asYAML ab]

instance JSON MPad where
    showJSON (MkMPad aa ab) = showJSHashObj "MkMPad"
	     [("mp_id", showJSON aa), ("mp_pad", showJSON ab)]

instance Perl5 MPad where
    showPerl5 (MkMPad aa ab) = showP5HashObj "MkMPad"
	      [("mp_id", showPerl5 aa) , ("mp_pad", showPerl5 ab)]

instance YAML VCode where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkCode" -> do
	    let liftM16 f m1 m2 m3 m4 m5 m6 m7 m8 m9 m10 m11 m12 m13 m14 m15 m16 = do
		{x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; x7 <- m7; x8 <- m8; x9 <- m9; x10 <- m10; x11 <- m11; x12 <- m12; x13 <- m13; x14 <- m14; x15 <- m15; x16 <- m16; return (f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16)}
	    let ESeq [aa, ab, ac, ad, ae, af, ag, ah, ai, aj, ak, al, am, an, ao, ap] = e
	    liftM16 MkCode (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae) (fromYAML af) (fromYAML ag) (fromYAML ah) (fromYAML ai) (fromYAML aj) (fromYAML ak) (fromYAML al) (fromYAML am) (fromYAML an) (fromYAML ao) (fromYAML ap)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkCode"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkCode"] ++ " in node " ++ show e
    asYAML (MkCode aa ab ac ad ae af ag ah ai aj ak al am an ao ap) =
	   asYAMLseq "MkCode"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad, asYAML ae, asYAML af,
	    asYAML ag, asYAML ah, asYAML ai, asYAML aj, asYAML ak, asYAML al,
	    asYAML am, asYAML an, asYAML ao, asYAML ap]

instance YAML TraitBlocks where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkTraitBlocks" -> do
	    let liftM11 f m1 m2 m3 m4 m5 m6 m7 m8 m9 m10 m11 = do
		{x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; x7 <- m7; x8 <- m8; x9 <- m9; x10 <- m10; x11 <- m11; return (f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11)}
	    let ESeq [aa, ab, ac, ad, ae, af, ag, ah, ai, aj, ak] = e
	    liftM11 MkTraitBlocks (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae) (fromYAML af) (fromYAML ag) (fromYAML ah) (fromYAML ai) (fromYAML aj) (fromYAML ak)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkTraitBlocks"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkTraitBlocks"] ++ " in node " ++ show e
    asYAML (MkTraitBlocks aa ab ac ad ae af ag ah ai aj ak) =
	   asYAMLseq "MkTraitBlocks"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad, asYAML ae, asYAML af,
	    asYAML ag, asYAML ah, asYAML ai, asYAML aj, asYAML ak]

instance YAML Ann where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"Cxt" -> do
	    let ESeq [aa] = e
	    liftM Cxt (fromYAML aa)
	"Pos" -> do
	    let ESeq [aa] = e
	    liftM Pos (fromYAML aa)
	"Prag" -> do
	    let ESeq [aa] = e
	    liftM Prag (fromYAML aa)
	"Decl" -> do
	    let ESeq [aa] = e
	    liftM Decl (fromYAML aa)
	"Parens" -> do
	    return Parens
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["Cxt","Pos","Prag","Decl","Parens"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["Cxt","Pos","Prag","Decl","Parens"] ++ " in node " ++ show e
    asYAML (Cxt aa) = asYAMLseq "Cxt" [asYAML aa]
    asYAML (Pos aa) = asYAMLseq "Pos" [asYAML aa]
    asYAML (Prag aa) = asYAMLseq "Prag" [asYAML aa]
    asYAML (Decl aa) = asYAMLseq "Decl" [asYAML aa]
    asYAML (Parens) = asYAMLcls "Parens"

instance YAML Exp where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"Noop" -> do
	    return Noop
	"App" -> do
	    let ESeq [aa, ab, ac] = e
	    liftM3 App (fromYAML aa) (fromYAML ab) (fromYAML ac)
	"Syn" -> do
	    let ESeq [aa, ab] = e
	    liftM2 Syn (fromYAML aa) (fromYAML ab)
	"Ann" -> do
	    let ESeq [aa, ab] = e
	    liftM2 Ann (fromYAML aa) (fromYAML ab)
	"Sym" -> do
	    let ESeq [aa, ab, ac, ad, ae] = e
	    liftM5 Sym (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae)
	"Stmts" -> do
	    let ESeq [aa, ab] = e
	    liftM2 Stmts (fromYAML aa) (fromYAML ab)
	"Prim" -> do
	    let ESeq [aa] = e
	    liftM Prim (fromYAML aa)
	"Val" -> do
	    let ESeq [aa] = e
	    liftM Val (fromYAML aa)
	"Var" -> do
	    let ESeq [aa] = e
	    liftM Var (fromYAML aa)
	"NonTerm" -> do
	    let ESeq [aa] = e
	    liftM NonTerm (fromYAML aa)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["Noop","App","Syn","Ann","Sym","Stmts","Prim","Val","Var","NonTerm"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["Noop","App","Syn","Ann","Sym","Stmts","Prim","Val","Var","NonTerm"] ++ " in node " ++ show e
    asYAML (Noop) = asYAMLcls "Noop"
    asYAML (App aa ab ac) = asYAMLseq "App"
	   [asYAML aa, asYAML ab, asYAML ac]
    asYAML (Syn aa ab) = asYAMLseq "Syn" [asYAML aa, asYAML ab]
    asYAML (Ann aa ab) = asYAMLseq "Ann" [asYAML aa, asYAML ab]
    asYAML (Sym aa ab ac ad ae) = asYAMLseq "Sym"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad, asYAML ae]
    asYAML (Stmts aa ab) = asYAMLseq "Stmts" [asYAML aa, asYAML ab]
    asYAML (Prim aa) = asYAMLseq "Prim" [asYAML aa]
    asYAML (Val aa) = asYAMLseq "Val" [asYAML aa]
    asYAML (Var aa) = asYAMLseq "Var" [asYAML aa]
    asYAML (NonTerm aa) = asYAMLseq "NonTerm" [asYAML aa]

instance YAML InitDat where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkInitDat" -> do
	    let ESeq [aa] = e
	    liftM MkInitDat (fromYAML aa)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkInitDat"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkInitDat"] ++ " in node " ++ show e
    asYAML (MkInitDat aa) = asYAMLseq "MkInitDat" [asYAML aa]

instance YAML PadEntry where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"PELexical" -> do
	    let ESeq [aa, ab, ac, ad] = e
	    liftM4 PELexical (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad)
	"PEStatic" -> do
	    let ESeq [aa, ab, ac, ad] = e
	    liftM4 PEStatic (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad)
	"PEConstant" -> do
	    let ESeq [aa, ab, ac] = e
	    liftM3 PEConstant (fromYAML aa) (fromYAML ab) (fromYAML ac)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["PELexical","PEStatic","PEConstant"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["PELexical","PEStatic","PEConstant"] ++ " in node " ++ show e
    asYAML (PELexical aa ab ac ad) = asYAMLseq "PELexical"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad]
    asYAML (PEStatic aa ab ac ad) = asYAMLseq "PEStatic"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad]
    asYAML (PEConstant aa ab ac) = asYAMLseq "PEConstant"
	   [asYAML aa, asYAML ab, asYAML ac]

instance YAML IHashEnv where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkHashEnv" -> do
	    return MkHashEnv
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkHashEnv"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkHashEnv"] ++ " in node " ++ show e
    asYAML (MkHashEnv) = asYAMLcls "MkHashEnv"

instance YAML IScalarCwd where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkScalarCwd" -> do
	    return MkScalarCwd
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkScalarCwd"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkScalarCwd"] ++ " in node " ++ show e
    asYAML (MkScalarCwd) = asYAMLcls "MkScalarCwd"

instance YAML ObjectId where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkObjectId" -> do
	    let ESeq [aa] = e
	    liftM MkObjectId (fromYAML aa)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkObjectId"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkObjectId"] ++ " in node " ++ show e
    asYAML (MkObjectId aa) = asYAMLseq "MkObjectId" [asYAML aa]

instance YAML VObject where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkObject" -> do
	    let ESeq [aa, ab, ac, ad] = e
	    liftM4 MkObject (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkObject"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkObject"] ++ " in node " ++ show e
    asYAML (MkObject aa ab ac ad) = asYAMLseq "MkObject"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad]

instance YAML VMatch where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkMatch" -> do
	    let liftM6 f m1 m2 m3 m4 m5 m6 = do
		{x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; return (f x1 x2 x3 x4 x5 x6)}
	    let ESeq [aa, ab, ac, ad, ae, af] = e
	    liftM6 MkMatch (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae) (fromYAML af)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkMatch"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkMatch"] ++ " in node " ++ show e
    asYAML (MkMatch aa ab ac ad ae af) = asYAMLseq "MkMatch"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad, asYAML ae, asYAML af]

instance YAML CompUnit where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkCompUnit" -> do
	    let ESeq [aa, ab, ac, ad] = e
	    liftM4 MkCompUnit (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkCompUnit"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkCompUnit"] ++ " in node " ++ show e
    asYAML (MkCompUnit aa ab ac ad) = asYAMLseq "MkCompUnit"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad]

instance YAML VMultiCode where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkMultiCode" -> do
	    let ESeq [aa, ab, ac, ad, ae] = e
	    liftM5 MkMultiCode (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkMultiCode"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkMultiCode"] ++ " in node " ++ show e
    asYAML (MkMultiCode aa ab ac ad ae) = asYAMLseq "MkMultiCode"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad, asYAML ae]

instance YAML VJunc where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkJunc" -> do
	    let ESeq [aa, ab, ac] = e
	    liftM3 MkJunc (fromYAML aa) (fromYAML ab) (fromYAML ac)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkJunc"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkJunc"] ++ " in node " ++ show e
    asYAML (MkJunc aa ab ac) = asYAMLseq "MkJunc"
	   [asYAML aa, asYAML ab, asYAML ac]

instance YAML JuncType where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"JAny" -> do
	    return JAny
	"JAll" -> do
	    return JAll
	"JNone" -> do
	    return JNone
	"JOne" -> do
	    return JOne
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["JAny","JAll","JNone","JOne"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["JAny","JAll","JNone","JOne"] ++ " in node " ++ show e
    asYAML (JAny) = asYAMLcls "JAny"
    asYAML (JAll) = asYAMLcls "JAll"
    asYAML (JNone) = asYAMLcls "JNone"
    asYAML (JOne) = asYAMLcls "JOne"

instance YAML Scope where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"SState" -> do
	    return SState
	"SConstant" -> do
	    return SConstant
	"SHas" -> do
	    return SHas
	"SMy" -> do
	    return SMy
	"SOur" -> do
	    return SOur
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["SState","SConstant","SHas","SMy","SOur"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["SState","SConstant","SHas","SMy","SOur"] ++ " in node " ++ show e
    asYAML (SState) = asYAMLcls "SState"
    asYAML (SConstant) = asYAMLcls "SConstant"
    asYAML (SHas) = asYAMLcls "SHas"
    asYAML (SMy) = asYAMLcls "SMy"
    asYAML (SOur) = asYAMLcls "SOur"

instance JSON Scope where
    showJSON (SState) = showJSScalar "SState"
    showJSON (SConstant) = showJSScalar "SConstant"
    showJSON (SHas) = showJSScalar "SHas"
    showJSON (SMy) = showJSScalar "SMy"
    showJSON (SOur) = showJSScalar "SOur"

instance Perl5 Scope where
    showPerl5 (SState) = showP5Class "SState"
    showPerl5 (SConstant) = showP5Class "SConstant"
    showPerl5 (SHas) = showP5Class "SHas"
    showPerl5 (SMy) = showP5Class "SMy"
    showPerl5 (SOur) = showP5Class "SOur"

instance YAML Pad where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkPad" -> do
	    let ESeq [aa] = e
	    liftM MkPad (fromYAML aa)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkPad"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkPad"] ++ " in node " ++ show e
    asYAML (MkPad aa) = asYAMLseq "MkPad" [asYAML aa]

instance YAML Pos where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkPos" -> do
	    let ESeq [aa, ab, ac, ad, ae] = e
	    liftM5 MkPos (fromYAML aa) (fromYAML ab) (fromYAML ac) (fromYAML ad) (fromYAML ae)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkPos"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkPos"] ++ " in node " ++ show e
    asYAML (MkPos aa ab ac ad ae) = asYAMLseq "MkPos"
	   [asYAML aa, asYAML ab, asYAML ac, asYAML ad, asYAML ae]

instance JSON Pos where
    showJSON (MkPos aa ab ac ad ae) = showJSHashObj "MkPos"
	     [("posName", showJSON aa), ("posBeginLine", showJSON ab),
	      ("posBeginColumn", showJSON ac), ("posEndLine", showJSON ad),
	      ("posEndColumn", showJSON ae)]

instance Perl5 Pos where
    showPerl5 (MkPos aa ab ac ad ae) = showP5HashObj "MkPos"
	      [("posName", showPerl5 aa) , ("posBeginLine", showPerl5 ab) ,
	       ("posBeginColumn", showPerl5 ac) , ("posEndLine", showPerl5 ad) ,
	       ("posEndColumn", showPerl5 ae)]

instance YAML Type where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkType" -> do
	    let ESeq [aa] = e
	    liftM MkType (fromYAML aa)
	"TypeOr" -> do
	    let ESeq [aa, ab] = e
	    liftM2 TypeOr (fromYAML aa) (fromYAML ab)
	"TypeAnd" -> do
	    let ESeq [aa, ab] = e
	    liftM2 TypeAnd (fromYAML aa) (fromYAML ab)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkType","TypeOr","TypeAnd"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkType","TypeOr","TypeAnd"] ++ " in node " ++ show e
    asYAML (MkType aa) = asYAMLseq "MkType" [asYAML aa]
    asYAML (TypeOr aa ab) = asYAMLseq "TypeOr" [asYAML aa, asYAML ab]
    asYAML (TypeAnd aa ab) = asYAMLseq "TypeAnd" [asYAML aa, asYAML ab]

instance JSON Type where
    showJSON (MkType aa) = showJSArrayObj "MkType" [showJSON aa]
    showJSON (TypeOr aa ab) = showJSArrayObj "TypeOr"
	     [showJSON aa, showJSON ab]
    showJSON (TypeAnd aa ab) = showJSArrayObj "TypeAnd"
	     [showJSON aa, showJSON ab]

instance Perl5 Type where
    showPerl5 (MkType aa) = showP5ArrayObj "MkType" [showPerl5 aa]
    showPerl5 (TypeOr aa ab) = showP5ArrayObj "TypeOr"
	      [showPerl5 aa , showPerl5 ab]
    showPerl5 (TypeAnd aa ab) = showP5ArrayObj "TypeAnd"
	      [showPerl5 aa , showPerl5 ab]

instance YAML Cxt where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"CxtVoid" -> do
	    return CxtVoid
	"CxtItem" -> do
	    let ESeq [aa] = e
	    liftM CxtItem (fromYAML aa)
	"CxtSlurpy" -> do
	    let ESeq [aa] = e
	    liftM CxtSlurpy (fromYAML aa)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["CxtVoid","CxtItem","CxtSlurpy"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["CxtVoid","CxtItem","CxtSlurpy"] ++ " in node " ++ show e
    asYAML (CxtVoid) = asYAMLcls "CxtVoid"
    asYAML (CxtItem aa) = asYAMLseq "CxtItem" [asYAML aa]
    asYAML (CxtSlurpy aa) = asYAMLseq "CxtSlurpy" [asYAML aa]

instance JSON Cxt where
    showJSON (CxtVoid) = showJSScalar "CxtVoid"
    showJSON (CxtItem aa) = showJSArrayObj "CxtItem" [showJSON aa]
    showJSON (CxtSlurpy aa) = showJSArrayObj "CxtSlurpy" [showJSON aa]

instance Perl5 Cxt where
    showPerl5 (CxtVoid) = showP5Class "CxtVoid"
    showPerl5 (CxtItem aa) = showP5ArrayObj "CxtItem" [showPerl5 aa]
    showPerl5 (CxtSlurpy aa) = showP5ArrayObj "CxtSlurpy"
	      [showPerl5 aa]

instance JSON Val where
    showJSON (VUndef) = showJSScalar "VUndef"
    showJSON (VBool aa) = showJSArrayObj "VBool" [showJSON aa]
    showJSON (VInt aa) = showJSArrayObj "VInt" [showJSON aa]
    showJSON (VRat aa) = showJSArrayObj "VRat" [showJSON aa]
    showJSON (VNum aa) = showJSArrayObj "VNum" [showJSON aa]
    showJSON (VStr aa) = showJSArrayObj "VStr" [showJSON aa]
    showJSON (VList aa) = showJSArrayObj "VList" [showJSON aa]
    showJSON (VType aa) = showJSArrayObj "VType" [showJSON aa]

instance YAML Pragma where
    fromYAML MkNode{n_tag=Just t, n_elem=e} | 't':'a':'g':':':'h':'s':':':tag <- unpackBuf t = case tag of
	"MkPrag" -> do
	    let ESeq [aa, ab] = e
	    liftM2 MkPrag (fromYAML aa) (fromYAML ab)
	_ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["MkPrag"] ++ " in node " ++ show e
    fromYAML e = fail $ "no tag found: expecting " ++ show ["MkPrag"] ++ " in node " ++ show e
    asYAML (MkPrag aa ab) = asYAMLseq "MkPrag" [asYAML aa, asYAML ab]

instance JSON Pragma where
    showJSON (MkPrag aa ab) = showJSHashObj "MkPrag"
	     [("pragName", showJSON aa), ("pragDat", showJSON ab)]

instance Perl5 Pragma where
    showPerl5 (MkPrag aa ab) = showP5HashObj "MkPrag"
	      [("pragName", showPerl5 aa) , ("pragDat", showPerl5 ab)]

--  Imported from other files :-


#endif

instance Binary VThread
    where put (MkThread x1 x2) = return () >> (put x1 >> put x2)
          get = case 0 of
                    0 -> ap (ap (return MkThread) get) get

instance Binary VSubst
    where put (MkSubst x1 x2) = putWord8 0 >> (put x1 >> put x2)
          put (MkTrans x1 x2) = putWord8 1 >> (put x1 >> put x2)
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> ap (ap (return MkSubst) get) get
                                           1 -> ap (ap (return MkTrans) get) get)

instance Binary VThunk
    where put (MkThunk x1 x2) = return () >> (put x1 >> put x2)
          get = case 0 of
                    0 -> ap (ap (return MkThunk) get) get

instance Binary VProcess
    where put (MkProcess x1) = return () >> put x1
          get = case 0 of
                    0 -> ap (return MkProcess) get

instance Binary VRule
    where put (MkRulePCRE x1
                          x2
                          x3
                          x4
                          x5
                          x6) = putWord8 0 >> (put x1 >> (put x2 >> (put x3 >> (put x4 >> (put x5 >> put x6)))))
          put (MkRulePGE x1
                         x2
                         x3
                         x4) = putWord8 1 >> (put x1 >> (put x2 >> (put x3 >> put x4)))
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> ap (ap (ap (ap (ap (ap (return MkRulePCRE) get) get) get) get) get) get
                                           1 -> ap (ap (ap (ap (return MkRulePGE) get) get) get) get)

instance Binary Val
    where put (VUndef) = putWord8 0
          put (VBool x1) = putWord8 1 >> put x1
          put (VInt x1) = putWord8 2 >> put x1
          put (VRat x1) = putWord8 3 >> put x1
          put (VNum x1) = putWord8 4 >> put x1
          put (VComplex x1) = putWord8 5 >> put x1
          put (VStr x1) = putWord8 6 >> put x1
          put (VList x1) = putWord8 7 >> put x1
          put (VType x1) = putWord8 8 >> put x1
          put (VJunc x1) = putWord8 9 >> put x1
          put (VError x1 x2) = putWord8 10 >> (put x1 >> put x2)
          put (VControl x1) = putWord8 11 >> put x1
          put (VRef x1) = putWord8 12 >> put x1
          put (VCode x1) = putWord8 13 >> put x1
          put (VBlock x1) = putWord8 14 >> put x1
          put (VHandle x1) = putWord8 15 >> put x1
          put (VSocket x1) = putWord8 16 >> put x1
          put (VThread x1) = putWord8 17 >> put x1
          put (VProcess x1) = putWord8 18 >> put x1
          put (VRule x1) = putWord8 19 >> put x1
          put (VSubst x1) = putWord8 20 >> put x1
          put (VMatch x1) = putWord8 21 >> put x1
          put (VObject x1) = putWord8 22 >> put x1
          put (VOpaque x1) = putWord8 23 >> put x1
          put (PerlSV x1) = putWord8 24 >> put x1
          put (VV x1) = putWord8 25 >> put x1
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return VUndef
                                           1 -> ap (return VBool) get
                                           2 -> ap (return VInt) get
                                           3 -> ap (return VRat) get
                                           4 -> ap (return VNum) get
                                           5 -> ap (return VComplex) get
                                           6 -> ap (return VStr) get
                                           7 -> ap (return VList) get
                                           8 -> ap (return VType) get
                                           9 -> ap (return VJunc) get
                                           10 -> ap (ap (return VError) get) get
                                           11 -> ap (return VControl) get
                                           12 -> ap (return VRef) get
                                           13 -> ap (return VCode) get
                                           14 -> ap (return VBlock) get
                                           15 -> ap (return VHandle) get
                                           16 -> ap (return VSocket) get
                                           17 -> ap (return VThread) get
                                           18 -> ap (return VProcess) get
                                           19 -> ap (return VRule) get
                                           20 -> ap (return VSubst) get
                                           21 -> ap (return VMatch) get
                                           22 -> ap (return VObject) get
                                           23 -> ap (return VOpaque) get
                                           24 -> ap (return PerlSV) get
                                           25 -> ap (return VV) get)

instance Binary ControlLoop
    where put (LoopNext) = putWord8 0
          put (LoopRedo) = putWord8 1
          put (LoopLast) = putWord8 2
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return LoopNext
                                           1 -> return LoopRedo
                                           2 -> return LoopLast)

instance Binary ControlWhen
    where put (WhenContinue) = putWord8 0
          put (WhenBreak) = putWord8 1
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return WhenContinue
                                           1 -> return WhenBreak)

instance Binary SubType
    where put (SubMethod) = putWord8 0
          put (SubCoroutine) = putWord8 1
          put (SubMacro) = putWord8 2
          put (SubRoutine) = putWord8 3
          put (SubBlock) = putWord8 4
          put (SubPointy) = putWord8 5
          put (SubPrim) = putWord8 6
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return SubMethod
                                           1 -> return SubCoroutine
                                           2 -> return SubMacro
                                           3 -> return SubRoutine
                                           4 -> return SubBlock
                                           5 -> return SubPointy
                                           6 -> return SubPrim)

instance Binary Param
    where put (MkOldParam x1
                          x2
                          x3
                          x4
                          x5
                          x6
                          x7
                          x8
                          x9) = return () >> (put x1 >> (put x2 >> (put x3 >> (put x4 >> (put x5 >> (put x6 >> (put x7 >> (put x8 >> put x9))))))))
          get = case 0 of
                    0 -> ap (ap (ap (ap (ap (ap (ap (ap (ap (return MkOldParam) get) get) get) get) get) get) get) get) get

instance Binary SubAssoc
    where put (ANil) = putWord8 0
          put (AIrrelevantToParsing) = putWord8 1
          put (A_left) = putWord8 2
          put (A_right) = putWord8 3
          put (A_non) = putWord8 4
          put (A_chain) = putWord8 5
          put (A_list) = putWord8 6
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return ANil
                                           1 -> return AIrrelevantToParsing
                                           2 -> return A_left
                                           3 -> return A_right
                                           4 -> return A_non
                                           5 -> return A_chain
                                           6 -> return A_list)

instance Binary MPad
    where put (MkMPad x1 x2) = return () >> (put x1 >> put x2)
          get = case 0 of
                    0 -> ap (ap (return MkMPad) get) get

instance Binary VCode
    where put (MkCode x1
                      x2
                      x3
                      x4
                      x5
                      x6
                      x7
                      x8
                      x9
                      x10
                      x11
                      x12
                      x13
                      x14
                      x15
                      x16) = return () >> (put x1 >> (put x2 >> (put x3 >> (put x4 >> (put x5 >> (put x6 >> (put x7 >> (put x8 >> (put x9 >> (put x10 >> (put x11 >> (put x12 >> (put x13 >> (put x14 >> (put x15 >> put x16)))))))))))))))
          get = case 0 of
                    0 -> ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (return MkCode) get) get) get) get) get) get) get) get) get) get) get) get) get) get) get) get

instance Binary TraitBlocks
    where put (MkTraitBlocks x1
                             x2
                             x3
                             x4
                             x5
                             x6
                             x7
                             x8
                             x9
                             x10
                             x11) = return () >> (put x1 >> (put x2 >> (put x3 >> (put x4 >> (put x5 >> (put x6 >> (put x7 >> (put x8 >> (put x9 >> (put x10 >> put x11))))))))))
          get = case 0 of
                    0 -> ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (return MkTraitBlocks) get) get) get) get) get) get) get) get) get) get) get

instance Binary Ann
    where put (Cxt x1) = putWord8 0 >> put x1
          put (Pos x1) = putWord8 1 >> put x1
          put (Prag x1) = putWord8 2 >> put x1
          put (Decl x1) = putWord8 3 >> put x1
          put (Parens) = putWord8 4
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> ap (return Cxt) get
                                           1 -> ap (return Pos) get
                                           2 -> ap (return Prag) get
                                           3 -> ap (return Decl) get
                                           4 -> return Parens)

instance Binary Exp
    where put (Noop) = putWord8 0
          put (App x1 x2 x3) = putWord8 1 >> (put x1 >> (put x2 >> put x3))
          put (Syn x1 x2) = putWord8 2 >> (put x1 >> put x2)
          put (Ann x1 x2) = putWord8 3 >> (put x1 >> put x2)
          put (Sym x1
                   x2
                   x3
                   x4
                   x5) = putWord8 4 >> (put x1 >> (put x2 >> (put x3 >> (put x4 >> put x5))))
          put (Stmts x1 x2) = putWord8 5 >> (put x1 >> put x2)
          put (Prim x1) = putWord8 6 >> put x1
          put (Val x1) = putWord8 7 >> put x1
          put (Var x1) = putWord8 8 >> put x1
          put (NonTerm x1) = putWord8 9 >> put x1
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return Noop
                                           1 -> ap (ap (ap (return App) get) get) get
                                           2 -> ap (ap (return Syn) get) get
                                           3 -> ap (ap (return Ann) get) get
                                           4 -> ap (ap (ap (ap (ap (return Sym) get) get) get) get) get
                                           5 -> ap (ap (return Stmts) get) get
                                           6 -> ap (return Prim) get
                                           7 -> ap (return Val) get
                                           8 -> ap (return Var) get
                                           9 -> ap (return NonTerm) get)

{-
instance Binary LexPad
    where put (PRuntime x1) = putWord8 0 >> put x1
          put (PCompiling x1) = putWord8 1 >> put x1
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> ap (return PRuntime) get
                                           1 -> ap (return PCompiling) get)
-}

instance Binary LexPad where
    put _ = return ()
    get = return (PRuntime emptyPad)

instance Binary Env
    where put (MkEnv x1
                     x2
                     x3
                     x4
                     x5
                     x6
                     x7
                     x8
                     x9
                     x10
                     x11
                     x12
                     x13
                     x14
                     x15
                     x16
                     x17) = return () >> (put x1 >> (put x2 >> (put x3 >> (put x4 >> (put x5 >> (put x6 >> (put x7 >> (put x8 >> (put x9 >> (put x10 >> (put x11 >> (put x12 >> (put x13 >> (put x14 >> (put x15 >> (put x16 >> put x17))))))))))))))))
          get = case 0 of
                    0 -> ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (ap (return MkEnv) get) get) get) get) get) get) get) get) get) get) get) get) get) get) get) get) get

instance Binary Frame
    where put (FrameLoop) = putWord8 0
          put (FrameWhen) = putWord8 1
          put (FrameGather) = putWord8 2
          put (FrameRoutine) = putWord8 3
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return FrameLoop
                                           1 -> return FrameWhen
                                           2 -> return FrameGather
                                           3 -> return FrameRoutine)

instance Binary InitDat
    where put (MkInitDat x1) = return () >> put x1
          get = case 0 of
                    0 -> ap (return MkInitDat) get

instance Binary PadEntry
    where put (PELexical x1
                         x2
                         x3
                         x4) = putWord8 0 >> (put x1 >> (put x2 >> (put x3 >> put x4)))
          put (PEStatic x1
                        x2
                        x3
                        x4) = putWord8 1 >> (put x1 >> (put x2 >> (put x3 >> put x4)))
          put (PEConstant x1
                          x2
                          x3) = putWord8 2 >> (put x1 >> (put x2 >> put x3))
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> ap (ap (ap (ap (return PELexical) get) get) get) get
                                           1 -> ap (ap (ap (ap (return PEStatic) get) get) get) get
                                           2 -> ap (ap (ap (return PEConstant) get) get) get)

instance Binary Type
    where put (MkType x1) = putWord8 0 >> put x1
          put (TypeOr x1 x2) = putWord8 1 >> (put x1 >> put x2)
          put (TypeAnd x1 x2) = putWord8 2 >> (put x1 >> put x2)
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> ap (return MkType) get
                                           1 -> ap (ap (return TypeOr) get) get
                                           2 -> ap (ap (return TypeAnd) get) get)

instance Binary IHashEnv
    where put (MkHashEnv) = return ()
          get = case 0 of
                    0 -> return MkHashEnv

instance Binary IScalarCwd
    where put (MkScalarCwd) = return ()
          get = case 0 of
                    0 -> return MkScalarCwd

instance Binary ObjectId
    where put (MkObjectId x1) = return () >> put x1
          get = case 0 of
                    0 -> ap (return MkObjectId) get

instance Binary VObject
    where put (MkObject x1
                        x2
                        x3
                        x4) = return () >> (put x1 >> (put x2 >> (put x3 >> put x4)))
          get = case 0 of
                    0 -> ap (ap (ap (ap (return MkObject) get) get) get) get

instance Binary VMatch
    where put (MkMatch x1
                       x2
                       x3
                       x4
                       x5
                       x6) = return () >> (put x1 >> (put x2 >> (put x3 >> (put x4 >> (put x5 >> put x6)))))
          get = case 0 of
                    0 -> ap (ap (ap (ap (ap (ap (return MkMatch) get) get) get) get) get) get

instance Binary CompUnit
    where put (MkCompUnit x1
                          x2
                          x3
                          x4) = return () >> (put x1 >> (put x2 >> (put x3 >> put x4)))
          get = case 0 of
                    0 -> ap (ap (ap (ap (return MkCompUnit) get) get) get) get

instance Binary IArray
    where put (MkIArray x1) = return () >> put x1
          get = case 0 of
                    0 -> ap (return MkIArray) get

instance Binary VMultiCode
    where put (MkMultiCode x1
                           x2
                           x3
                           x4
                           x5) = return () >> (put x1 >> (put x2 >> (put x3 >> (put x4 >> put x5))))
          get = case 0 of
                    0 -> ap (ap (ap (ap (ap (return MkMultiCode) get) get) get) get) get

instance Binary VJunc
    where put (MkJunc x1
                      x2
                      x3) = return () >> (put x1 >> (put x2 >> put x3))
          get = case 0 of
                    0 -> ap (ap (ap (return MkJunc) get) get) get

instance Binary a => Binary (IORef a) where
    put x = put (unsafePerformIO . readIORef $ x)
    get = fmap (unsafePerformIO . newIORef) get

instance Binary a => Binary (TVar a) where
    put x = put (unsafePerformIO . atomically . readTVar $ x)
    get = fmap (unsafePerformIO . newTVarIO) get

instance Binary a => Binary (TMVar a) where
    put x = put (unsafePerformIO . atomically . readTMVar $ x)
    get = fmap (unsafePerformIO . newTMVarIO) get

instance Binary (Eval Val) where
    put = put . unsafePerformIO . fakeEval
    get = do
        val <- get
        return (return val)

instance Binary ThreadId
instance Binary ClassTree
instance Binary Dynamic
instance Binary ProcessHandle
instance Binary Regex
instance Binary Unique
instance Binary VComplex
instance Binary VHandle
instance Binary VControl
instance Binary VOpaque
instance Binary VSocket
instance Binary PerlSV

instance Binary Pos
    where put (MkPos x1
                     x2
                     x3
                     x4
                     x5) = return () >> (put x1 >> (put x2 >> (put x3 >> (put x4 >> put x5))))
          get = case 0 of
                    0 -> ap (ap (ap (ap (ap (return MkPos) get) get) get) get) get

instance Binary Scope
    where put (SState) = putWord8 0
          put (SConstant) = putWord8 1
          put (SHas) = putWord8 2
          put (SMy) = putWord8 3
          put (SOur) = putWord8 4
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return SState
                                           1 -> return SConstant
                                           2 -> return SHas
                                           3 -> return SMy
                                           4 -> return SOur)

instance Binary Cxt
    where put (CxtVoid) = putWord8 0
          put (CxtItem x1) = putWord8 1 >> put x1
          put (CxtSlurpy x1) = putWord8 2 >> put x1
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return CxtVoid
                                           1 -> ap (return CxtItem) get
                                           2 -> ap (return CxtSlurpy) get)

instance Binary Pkg where
    put = put . (cast :: Pkg -> ByteString)
    get = fmap (cast :: ByteString -> Pkg) get

instance Binary Var where
    put = put . (cast :: Var -> ByteString)
    get = fmap (cast :: ByteString -> Var) get


instance Binary Pragma
    where put (MkPrag x1
                     x2) = return () >> (put x1 >> put x2)
          get = case 0 of
                    0 -> ap (ap (return MkPrag) get) get

instance Binary IHash where
     put x = do
        let kvs = unsafePerformIO (H.toList x)
        length kvs `seq` put (kvs :: [(VStr, IVar VScalar)])
     get = do
        (ins :: [(VStr, IVar VScalar)]) <- get
        length ins `seq` return (unsafePerformIO $ H.fromList H.hashString ins)

instance Binary JuncType
    where put (JAny) = putWord8 0
          put (JAll) = putWord8 1
          put (JNone) = putWord8 2
          put (JOne) = putWord8 3
          get = getWord8 >>= (\tag_ -> case tag_ of
                                           0 -> return JAny
                                           1 -> return JAll
                                           2 -> return JNone
                                           3 -> return JOne)

instance Binary Val.Val

instance Typeable a => Binary (IVar a) where
    put = put . MkRef
    get = do
        MkRef iv <- get
        return (unsafeCoerce# iv)

instance Binary ([Val] -> Eval Val) where
    put _ = put ()
    get = return (const $ return VUndef)

instance Binary (Exp -> Eval Val) where
    put _ = put ()
    get = return (const $ return VUndef)

instance Binary [a] => Binary [:a:] where
    put = put . fromP
    get = fmap toP get

instance Binary VRef where
    put (MkRef (ICode cv))
        | Just (mc :: VMultiCode) <- fromTypeable cv = do
            putWord8 0x30
            put (mc :: VMultiCode)
        | otherwise = do
            putWord8 0x31
            let VCode vsub = unsafePerformIO (fakeEval $ fmap VCode (code_fetch cv))
            put vsub
    put (MkRef (IScalar sv)) = do
        putWord8 $ if scalar_iType sv == mkType "Scalar::Const"
            then 0x32 else 0x33
        put $ unsafePerformIO (fakeEval $ scalar_fetch sv)
    put (MkRef (IArray av)) = do
        putWord8 0x34
        let VList vals = unsafePerformIO (fakeEval $ fmap VList (array_fetch av))
        put vals
    put (MkRef (IPair pv)) = do
        putWord8 0x35
        let VList [k, v] = unsafePerformIO (fakeEval $ fmap (\(k, v) -> VList [k, v]) (pair_fetch pv))
        put (k, v)
    put (MkRef (IHash hv))
        | hash_iType hv == mkType "Hash" = do
            putWord8 0x36
            let hv' = ((unsafeCoerce# hv) :: IHash)
            put hv'
        | hash_iType hv == mkType "Hash::Env" = do
            putWord8 0x37
        | hash_iType hv == mkType "Hash::Const" = do
            putWord8 0xFF
            let hv' = ((unsafeCoerce# hv) :: VHash)
            put hv'
        | otherwise = do
            putWord8 0xFF
            -- put (show (typeOf hv)) 
            -- let VMatch MkMatch{ matchSubNamed = hv } = unsafePerformIO
            --         ( fakeEval $ fmap (VMatch . MkMatch False 0 0 "" []) (hash_fetch hv) )
            put (Map.empty :: VHash)
    put ref = fail ("Not implemented: asYAML \"" ++ showType (refType ref) ++ "\"")
    get = do
        tag_ <- getWord8
        case tag_ of
            0x30 -> fmap codeRef (get :: Get VMultiCode)
            0x31 -> fmap codeRef (get :: Get VCode)
            0x32 -> fmap scalarRef (get :: Get VScalar)
            0x33 -> fmap (MkRef . unsafePerformIO . newScalar') get
            0x34 -> fmap (MkRef . unsafePerformIO . newArray') get
            0x35 -> fmap pairRef (get :: Get VPair)
            0x36 -> do
                iHash <- get
                return $ hashRef (iHash :: IHash)
            0x37 -> return $ hashRef MkHashEnv
            _    -> fmap hashRef (get :: Get VHash)

newScalar' :: VScalar -> IO (IVar VScalar)
newScalar' = (fmap IScalar) . newTVarIO

newArray' :: VArray -> IO (IVar VArray)
newArray' vals = do
    tvs <- mapM newScalar' vals
    iv  <- newTVarIO (toP tvs)
    return $ IArray (MkIArray iv)

instance Binary Pad where
    put = put . Map.toList . padEntries
    get = liftM (MkPad . Map.fromList) get

instance Binary EntryFlags where
    put (MkEntryFlags x) = put x
    get = fmap MkEntryFlags get