module UHC.Light.Compiler.Gam.TyGam ( TyGamInfo (..) , emptyTGI , TyGam , tyGamLookupErr , mkTGIData , mkTGI , initTyGam , tyGamLookup ) 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 UHC.Light.Compiler.Error import qualified Data.Set as Set import UHC.Light.Compiler.VarMp import UHC.Light.Compiler.Substitutable import UHC.Light.Compiler.Ty.Trf.Quantify import Control.Monad import UHC.Util.Binary import UHC.Util.Serialize {-# LINE 40 "src/ehc/Gam/TyGam.chs" #-} -- If this changes, also change {%{EH}ConfigInternalVersions} data TyGamInfo = TyGamInfo { tgiTy :: !Ty } deriving Show {-# LINE 51 "src/ehc/Gam/TyGam.chs" #-} deriving instance Typeable TyGamInfo deriving instance Data TyGamInfo {-# LINE 56 "src/ehc/Gam/TyGam.chs" #-} mkTGIData :: Ty -> Ty -> TyGamInfo mkTGIData t _ = TyGamInfo t {-# LINE 61 "src/ehc/Gam/TyGam.chs" #-} mkTGI :: Ty -> TyGamInfo mkTGI t = mkTGIData t Ty_Any {-# LINE 66 "src/ehc/Gam/TyGam.chs" #-} emptyTGI :: TyGamInfo emptyTGI = TyGamInfo Ty_Any {-# LINE 75 "src/ehc/Gam/TyGam.chs" #-} type TyGam = Gam HsName TyGamInfo {-# LINE 93 "src/ehc/Gam/TyGam.chs" #-} tyGamLookupErr :: HsName -> TyGam -> (TyGamInfo,ErrL) tyGamLookupErr n g = case tyGamLookup n g of Nothing -> (emptyTGI,[rngLift emptyRange mkErr_NamesNotIntrod "type" [n]]) Just tgi -> (tgi,[]) {-# LINE 116 "src/ehc/Gam/TyGam.chs" #-} tyGamLookup :: HsName -> TyGam -> Maybe TyGamInfo tyGamLookup = gamLookup {-# LINE 142 "src/ehc/Gam/TyGam.chs" #-} initTyGam :: TyGam initTyGam = assocLToGam [ (hsnArrow , mkTGI (appCon hsnArrow)) , (hsnInt , mkTGI tyInt) , (hsnChar , mkTGI tyChar) , (hsnRow , mkTGI (appCon hsnUnknown)) , (hsnRec , mkTGI (appCon hsnRec)) , (hsnSum , mkTGI (appCon hsnSum)) , (hsnPrArrow , mkTGI (appCon hsnPrArrow)) , (hsnEqTilde , mkTGI (appCon hsnEqTilde)) , (hsnInteger , mkTGI tyInteger ) , (hsnAddrUnboxed , mkTGI (appCon hsnAddrUnboxed ) ) ] {-# LINE 218 "src/ehc/Gam/TyGam.chs" #-} instance VarUpdatable TyGamInfo VarMp where s `varUpd` tgi = tgi { tgiTy = s `varUpd` tgiTy tgi } s `varUpdCyc` tgi = substLift tgiTy (\i x -> i {tgiTy = x}) varUpdCyc s tgi instance VarExtractable TyGamInfo TyVarId where varFreeSet tgi = varFreeSet (tgiTy tgi) {-# LINE 229 "src/ehc/Gam/TyGam.chs" #-} instance PP TyGamInfo where pp tgi = ppTy (tgiTy tgi) {-# LINE 242 "src/ehc/Gam/TyGam.chs" #-} instance Serialize TyGamInfo where sput (TyGamInfo a) = sput a sget = liftM TyGamInfo sget