ClGam.hs

module UHC.Light.Compiler.Gam.ClGam
( ClGamInfo (..), ClGam, emptyCLGI
, initClGam )
where
import UHC.Util.Pretty
import UHC.Util.Utils
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Base.TermLike
import UHC.Light.Compiler.Base.HsName.Builtin
import UHC.Light.Compiler.Ty
import UHC.Light.Compiler.Ty.Pretty
import UHC.Light.Compiler.Gam
import Control.Monad
import UHC.Util.Binary
import UHC.Util.Serialize





{-# LINE 37 "src/ehc/Gam/ClGam.chs" #-}
-- If this changes, also change {%{EH}ConfigInternalVersions}
data ClGamInfo
  =  ClGamInfo
       { clgiPrToEvidRecTy      :: !Ty                  -- mapping from predicate type -> dictionary structure record, encoded as function
       , clgiPrToEvidDataTy     :: !Ty              	-- mapping from predicate type -> datatype, encoded as function
       , clgiRuleTy             :: !Ty              	-- predicate context + class head as function type
       , clgiDfltDictNm         :: !HsName              -- dictionary name of default instance fields constructing function
       , clgiDictTag            :: !CTag                -- tag of dictionary
       , clgiGenerDerivableL    :: [(HsName,HsName)]    -- list of fields with default value which can be derived using generic deriving
       }
       deriving Show

type ClGam     = Gam HsName ClGamInfo

emptyCLGI
  = ClGamInfo
      Ty_Any Ty_Any Ty_Any hsnUnknown CTagRec
      []

{-# LINE 70 "src/ehc/Gam/ClGam.chs" #-}
deriving instance Typeable ClGamInfo

{-# LINE 74 "src/ehc/Gam/ClGam.chs" #-}
instance PP ClGamInfo where
  pp clgi = "dictnm=" >#< pp (clgiDfltDictNm clgi) >-< indent 2 (
        "rule=" >#< ppTy (clgiRuleTy clgi)
    >-< "eviddataty=" >#< ppTy (clgiPrToEvidDataTy clgi)
    >-< "evidrecty=" >#< ppTy (clgiPrToEvidRecTy clgi)
    >-< "clgiGenerDerivableL=" >#< ppAssocL (clgiGenerDerivableL clgi)
    )

{-# LINE 86 "src/ehc/Gam/ClGam.chs" #-}
initClGam
  = assocLToGam
      [ (hsnPrArrow,    emptyCLGI)
      ]

{-# LINE 101 "src/ehc/Gam/ClGam.chs" #-}
instance Serialize ClGamInfo where
  sput (ClGamInfo a b c d e f) = sput a >> sput b >> sput c >> sput d >> sput e >> sput f
  sget = liftM6 ClGamInfo sget sget sget sget sget sget