-- UUAGC 0.9.52.1 (build/103/lib-ehc/UHC/Light/Compiler/CoreRun/Check.) module UHC.Light.Compiler.CoreRun.Check(crmodCheck', Inh_AGItf (..), Syn_AGItf (..)) where import UHC.Light.Compiler.Base.Common import UHC.Light.Compiler.Opts import UHC.Light.Compiler.Error import UHC.Light.Compiler.CoreRun import qualified UHC.Util.Rel as Rel import qualified UHC.Util.RelMap as RelMap import qualified Data.Vector as V import Data.List import qualified UHC.Light.Compiler.Module.ImportExport as ModImpExp chkExp'' :: InhChk -> Exp -> Exp chkExp'' inhchk x = crr_Syn_Exp $ wrap_Exp (sem_Exp x) (Inh_Exp {inhchk_Inh_Exp=inhchk}) chkSExp'' :: InhChk -> SExp -> SExp chkSExp'' inhchk x = crr_Syn_SExp $ wrap_SExp (sem_SExp x) (Inh_SExp {inhchk_Inh_SExp=inhchk}) chkAlt'' :: InhChk -> Alt -> Alt chkAlt'' inhchk x = crr_Syn_Alt $ wrap_Alt (sem_Alt x) (Inh_Alt {inhchk_Inh_Alt=inhchk}) deriving instance Typeable Syn_AGItf crmodCheck' :: Inh_AGItf -> Mod -> Syn_AGItf crmodCheck' inh crmod = t where t = wrap_AGItf (sem_AGItf (AGItf_AGItf crmod)) inh -- | Not all AST datatypes are expressed as AG, inherited info therefore implemented manually data InhChk = InhChk { nm2refInhChk :: Nm2RefMp -- ^ name to ref mapping , impNmLkupInhChk :: Maybe (HsName -> Maybe Int) } -- AGItf ------------------------------------------------------- {- visit 0: inherited attributes: moduleNr : Maybe Int nm2ref : Nm2RefMp synthesized attributes: crr : Mod nm2refGath : Nm2RefMp alternatives: alternative AGItf: child module : Mod -} -- cata sem_AGItf :: AGItf -> T_AGItf sem_AGItf (AGItf_AGItf _module) = (sem_AGItf_AGItf (sem_Mod _module)) -- semantic domain type T_AGItf = (Maybe Int) -> Nm2RefMp -> ( Mod,Nm2RefMp) data Inh_AGItf = Inh_AGItf {moduleNr_Inh_AGItf :: !((Maybe Int)),nm2ref_Inh_AGItf :: !(Nm2RefMp)} data Syn_AGItf = Syn_AGItf {crr_Syn_AGItf :: !(Mod),nm2refGath_Syn_AGItf :: !(Nm2RefMp)} wrap_AGItf :: T_AGItf -> Inh_AGItf -> Syn_AGItf wrap_AGItf sem (Inh_AGItf _lhsImoduleNr _lhsInm2ref) = (let ( _lhsOcrr,_lhsOnm2refGath) = sem _lhsImoduleNr _lhsInm2ref in (Syn_AGItf _lhsOcrr _lhsOnm2refGath)) sem_AGItf_AGItf :: T_Mod -> T_AGItf sem_AGItf_AGItf module_ = (\ _lhsImoduleNr _lhsInm2ref -> (case (_lhsInm2ref) of { _moduleOnm2ref -> (case (_lhsImoduleNr) of { _moduleOmoduleNr -> (case (module_ _moduleOmoduleNr _moduleOnm2ref) of { ( _moduleIcrr,_moduleInm2refGath) -> (case (_moduleIcrr) of { _lhsOcrr -> (case (_moduleInm2refGath) of { _lhsOnm2refGath -> ( _lhsOcrr,_lhsOnm2refGath) }) }) }) }) })) -- Alt --------------------------------------------------------- {- visit 0: inherited attribute: inhchk : InhChk synthesized attribute: crr : Alt alternatives: alternative Alt: child ref2nm : {Ref2Nm} child expr : Exp visit 0: local crr : _ -} -- cata sem_Alt :: Alt -> T_Alt sem_Alt (Alt_Alt _ref2nm _expr) = (sem_Alt_Alt _ref2nm (sem_Exp _expr)) -- semantic domain type T_Alt = InhChk -> ( Alt) data Inh_Alt = Inh_Alt {inhchk_Inh_Alt :: !(InhChk)} data Syn_Alt = Syn_Alt {crr_Syn_Alt :: !(Alt)} wrap_Alt :: T_Alt -> Inh_Alt -> Syn_Alt wrap_Alt sem (Inh_Alt _lhsIinhchk) = (let ( _lhsOcrr) = sem _lhsIinhchk in (Syn_Alt _lhsOcrr)) sem_Alt_Alt :: Ref2Nm -> T_Exp -> T_Alt sem_Alt_Alt ref2nm_ expr_ = (\ _lhsIinhchk -> (case (_lhsIinhchk) of { _exprOinhchk -> (case (expr_ _exprOinhchk) of { ( _exprIcrr) -> (case (Alt_Alt ref2nm_ _exprIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) })) -- DataCon ----------------------------------------------------- {- visit 0: synthesized attribute: crr : DataCon alternatives: alternative Con: child conNm : {HsName} child tagNr : {Int} visit 0: local crr : _ -} -- cata sem_DataCon :: DataCon -> T_DataCon sem_DataCon (DataCon_Con _conNm _tagNr) = (sem_DataCon_Con _conNm _tagNr) -- semantic domain type T_DataCon = ( DataCon) sem_DataCon_Con :: HsName -> Int -> T_DataCon sem_DataCon_Con conNm_ tagNr_ = (case (DataCon_Con conNm_ tagNr_) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) -- DataConL ---------------------------------------------------- {- visit 0: synthesized attribute: crr : DataConL alternatives: alternative Cons: child hd : DataCon child tl : DataConL visit 0: local crr : _ alternative Nil: visit 0: local crr : _ -} -- cata sem_DataConL :: DataConL -> T_DataConL sem_DataConL list = (Prelude.foldr sem_DataConL_Cons sem_DataConL_Nil (Prelude.map sem_DataCon list)) -- semantic domain type T_DataConL = ( DataConL) sem_DataConL_Cons :: T_DataCon -> T_DataConL -> T_DataConL sem_DataConL_Cons hd_ tl_ = (case (tl_) of { ( _tlIcrr) -> (case (hd_) of { ( _hdIcrr) -> (case ((:) _hdIcrr _tlIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) }) sem_DataConL_Nil :: T_DataConL sem_DataConL_Nil = (case ([]) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) -- Exp --------------------------------------------------------- {- visit 0: inherited attribute: inhchk : InhChk synthesized attribute: crr : Exp alternatives: alternative SExp: child sexpr : SExp visit 0: local crr : _ alternative Tup: child tag : {Int} child args : {CRArray SExp} visit 0: local crr : _ alternative Let: child firstOff : {Int} child ref2nm : {Ref2Nm} child binds : {CRArray Bind} child body : Exp visit 0: local crr : _ alternative App: child func : Exp child args : {CRArray SExp} visit 0: local crr : _ alternative Lam: child mbNm : {Maybe HsName} child nrArgs : {Int} child stkDepth : {Int} child ref2nm : {Ref2Nm} child body : Exp visit 0: local crr : _ alternative Force: child expr : Exp visit 0: local crr : _ alternative Tail: child expr : Exp visit 0: local crr : _ alternative Case: child expr : SExp child alts : {CRArray Alt} visit 0: local crr : _ alternative FFI: child prim : {RunPrim} child args : {CRArray SExp} visit 0: local crr : _ -} -- cata sem_Exp :: Exp -> T_Exp sem_Exp (Exp_SExp _sexpr) = (sem_Exp_SExp (sem_SExp _sexpr)) sem_Exp (Exp_Tup _tag _args) = (sem_Exp_Tup _tag _args) sem_Exp (Exp_Let _firstOff _ref2nm _binds _body) = (sem_Exp_Let _firstOff _ref2nm _binds (sem_Exp _body)) sem_Exp (Exp_App _func _args) = (sem_Exp_App (sem_Exp _func) _args) sem_Exp (Exp_Lam _mbNm _nrArgs _stkDepth _ref2nm _body) = (sem_Exp_Lam _mbNm _nrArgs _stkDepth _ref2nm (sem_Exp _body)) sem_Exp (Exp_Force _expr) = (sem_Exp_Force (sem_Exp _expr)) sem_Exp (Exp_Tail _expr) = (sem_Exp_Tail (sem_Exp _expr)) sem_Exp (Exp_Case _expr _alts) = (sem_Exp_Case (sem_SExp _expr) _alts) sem_Exp (Exp_FFI _prim _args) = (sem_Exp_FFI _prim _args) -- semantic domain type T_Exp = InhChk -> ( Exp) data Inh_Exp = Inh_Exp {inhchk_Inh_Exp :: !(InhChk)} data Syn_Exp = Syn_Exp {crr_Syn_Exp :: !(Exp)} wrap_Exp :: T_Exp -> Inh_Exp -> Syn_Exp wrap_Exp sem (Inh_Exp _lhsIinhchk) = (let ( _lhsOcrr) = sem _lhsIinhchk in (Syn_Exp _lhsOcrr)) sem_Exp_SExp :: T_SExp -> T_Exp sem_Exp_SExp sexpr_ = (\ _lhsIinhchk -> (case (_lhsIinhchk) of { _sexprOinhchk -> (case (sexpr_ _sexprOinhchk) of { ( _sexprIcrr) -> (case (Exp_SExp _sexprIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) })) sem_Exp_Tup :: Int -> (CRArray SExp) -> T_Exp sem_Exp_Tup tag_ args_ = (\ _lhsIinhchk -> (case (Exp_Tup tag_ args_) of { _crr -> (case (_crr {args_Exp_Tup = V.map (chkSExp'' _lhsIinhchk) args_}) of { _lhsOcrr -> ( _lhsOcrr) }) })) sem_Exp_Let :: Int -> Ref2Nm -> (CRArray Bind) -> T_Exp -> T_Exp sem_Exp_Let firstOff_ ref2nm_ binds_ body_ = (\ _lhsIinhchk -> (case (_lhsIinhchk) of { _bodyOinhchk -> (case (body_ _bodyOinhchk) of { ( _bodyIcrr) -> (case (Exp_Let firstOff_ ref2nm_ binds_ _bodyIcrr) of { _crr -> (case (_crr {binds_Exp_Let = V.map (chkExp'' _lhsIinhchk) binds_}) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) })) sem_Exp_App :: T_Exp -> (CRArray SExp) -> T_Exp sem_Exp_App func_ args_ = (\ _lhsIinhchk -> (case (_lhsIinhchk) of { _funcOinhchk -> (case (func_ _funcOinhchk) of { ( _funcIcrr) -> (case (Exp_App _funcIcrr args_) of { _crr -> (case (_crr {args_Exp_App = V.map (chkSExp'' _lhsIinhchk) args_}) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) })) sem_Exp_Lam :: (Maybe HsName) -> Int -> Int -> Ref2Nm -> T_Exp -> T_Exp sem_Exp_Lam mbNm_ nrArgs_ stkDepth_ ref2nm_ body_ = (\ _lhsIinhchk -> (case (_lhsIinhchk) of { _bodyOinhchk -> (case (body_ _bodyOinhchk) of { ( _bodyIcrr) -> (case (Exp_Lam mbNm_ nrArgs_ stkDepth_ ref2nm_ _bodyIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) })) sem_Exp_Force :: T_Exp -> T_Exp sem_Exp_Force expr_ = (\ _lhsIinhchk -> (case (_lhsIinhchk) of { _exprOinhchk -> (case (expr_ _exprOinhchk) of { ( _exprIcrr) -> (case (Exp_Force _exprIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) })) sem_Exp_Tail :: T_Exp -> T_Exp sem_Exp_Tail expr_ = (\ _lhsIinhchk -> (case (_lhsIinhchk) of { _exprOinhchk -> (case (expr_ _exprOinhchk) of { ( _exprIcrr) -> (case (Exp_Tail _exprIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) })) sem_Exp_Case :: T_SExp -> (CRArray Alt) -> T_Exp sem_Exp_Case expr_ alts_ = (\ _lhsIinhchk -> (case (_lhsIinhchk) of { _exprOinhchk -> (case (expr_ _exprOinhchk) of { ( _exprIcrr) -> (case (Exp_Case _exprIcrr alts_) of { _crr -> (case (_crr {alts_Exp_Case = V.map (chkAlt'' _lhsIinhchk) alts_}) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) })) sem_Exp_FFI :: RunPrim -> (CRArray SExp) -> T_Exp sem_Exp_FFI prim_ args_ = (\ _lhsIinhchk -> (case (Exp_FFI prim_ args_) of { _crr -> (case (_crr {args_Exp_FFI = V.map (chkSExp'' _lhsIinhchk) args_}) of { _lhsOcrr -> ( _lhsOcrr) }) })) -- Export ------------------------------------------------------ {- visit 0: inherited attributes: moduleNm : HsName moduleNr : Maybe Int synthesized attributes: crr : Export nm2refGath : Nm2RefMp alternatives: alternative Export: child nm : {HsName} child offset : {Int} visit 0: local crr : _ -} -- cata sem_Export :: Export -> T_Export sem_Export (Export_Export _nm _offset) = (sem_Export_Export _nm _offset) -- semantic domain type T_Export = HsName -> (Maybe Int) -> ( Export,Nm2RefMp) sem_Export_Export :: HsName -> Int -> T_Export sem_Export_Export nm_ offset_ = (\ _lhsImoduleNm _lhsImoduleNr -> (case (Export_Export nm_ offset_) of { _crr -> (case (_crr) of { _lhsOcrr -> (case (RelMap.singleton nm_ (RRef_Exp _lhsImoduleNm offset_)) of { _lhsOnm2refGath -> ( _lhsOcrr,_lhsOnm2refGath) }) }) })) -- ExportL ----------------------------------------------------- {- visit 0: inherited attributes: moduleNm : HsName moduleNr : Maybe Int synthesized attributes: crr : ExportL nm2refGath : Nm2RefMp alternatives: alternative Cons: child hd : Export child tl : ExportL visit 0: local crr : _ alternative Nil: visit 0: local crr : _ -} -- cata sem_ExportL :: ExportL -> T_ExportL sem_ExportL list = (Prelude.foldr sem_ExportL_Cons sem_ExportL_Nil (Prelude.map sem_Export list)) -- semantic domain type T_ExportL = HsName -> (Maybe Int) -> ( ExportL,Nm2RefMp) sem_ExportL_Cons :: T_Export -> T_ExportL -> T_ExportL sem_ExportL_Cons hd_ tl_ = (\ _lhsImoduleNm _lhsImoduleNr -> (case (_lhsImoduleNr) of { _tlOmoduleNr -> (case (_lhsImoduleNm) of { _tlOmoduleNm -> (case (tl_ _tlOmoduleNm _tlOmoduleNr) of { ( _tlIcrr,_tlInm2refGath) -> (case (_lhsImoduleNr) of { _hdOmoduleNr -> (case (_lhsImoduleNm) of { _hdOmoduleNm -> (case (hd_ _hdOmoduleNm _hdOmoduleNr) of { ( _hdIcrr,_hdInm2refGath) -> (case ((:) _hdIcrr _tlIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> (case (_hdInm2refGath `nm2refUnion` _tlInm2refGath) of { _lhsOnm2refGath -> ( _lhsOcrr,_lhsOnm2refGath) }) }) }) }) }) }) }) }) })) sem_ExportL_Nil :: T_ExportL sem_ExportL_Nil = (\ _lhsImoduleNm _lhsImoduleNr -> (case ([]) of { _crr -> (case (_crr) of { _lhsOcrr -> (case (emptyNm2RefMp) of { _lhsOnm2refGath -> ( _lhsOcrr,_lhsOnm2refGath) }) }) })) -- Import ------------------------------------------------------ {- visit 0: synthesized attributes: crr : Import impNmL : [HsName] alternatives: alternative Import: child nm : {HsName} visit 0: local crr : _ -} -- cata sem_Import :: Import -> T_Import sem_Import (Import_Import _nm) = (sem_Import_Import _nm) -- semantic domain type T_Import = ( Import,([HsName])) sem_Import_Import :: HsName -> T_Import sem_Import_Import nm_ = (case (Import_Import nm_) of { _crr -> (case (_crr) of { _lhsOcrr -> (case ([nm_]) of { _lhsOimpNmL -> ( _lhsOcrr,_lhsOimpNmL) }) }) }) -- ImportL ----------------------------------------------------- {- visit 0: synthesized attributes: crr : ImportL impNmL : [HsName] alternatives: alternative Cons: child hd : Import child tl : ImportL visit 0: local crr : _ alternative Nil: visit 0: local crr : _ -} -- cata sem_ImportL :: ImportL -> T_ImportL sem_ImportL list = (Prelude.foldr sem_ImportL_Cons sem_ImportL_Nil (Prelude.map sem_Import list)) -- semantic domain type T_ImportL = ( ImportL,([HsName])) sem_ImportL_Cons :: T_Import -> T_ImportL -> T_ImportL sem_ImportL_Cons hd_ tl_ = (case (tl_) of { ( _tlIcrr,_tlIimpNmL) -> (case (hd_) of { ( _hdIcrr,_hdIimpNmL) -> (case ((:) _hdIcrr _tlIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> (case (_hdIimpNmL ++ _tlIimpNmL) of { _lhsOimpNmL -> ( _lhsOcrr,_lhsOimpNmL) }) }) }) }) }) sem_ImportL_Nil :: T_ImportL sem_ImportL_Nil = (case ([]) of { _crr -> (case (_crr) of { _lhsOcrr -> (case ([]) of { _lhsOimpNmL -> ( _lhsOcrr,_lhsOimpNmL) }) }) }) -- MbExp ------------------------------------------------------- {- visit 0: inherited attribute: inhchk : InhChk synthesized attribute: crr : MbExp alternatives: alternative Just: child just : Exp visit 0: local crr : _ alternative Nothing: visit 0: local crr : _ -} -- cata sem_MbExp :: MbExp -> T_MbExp sem_MbExp (Prelude.Just x) = (sem_MbExp_Just (sem_Exp x)) sem_MbExp Prelude.Nothing = sem_MbExp_Nothing -- semantic domain type T_MbExp = InhChk -> ( MbExp) sem_MbExp_Just :: T_Exp -> T_MbExp sem_MbExp_Just just_ = (\ _lhsIinhchk -> (case (_lhsIinhchk) of { _justOinhchk -> (case (just_ _justOinhchk) of { ( _justIcrr) -> (case (Just _justIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) })) sem_MbExp_Nothing :: T_MbExp sem_MbExp_Nothing = (\ _lhsIinhchk -> (case (Nothing) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) })) -- Meta -------------------------------------------------------- {- visit 0: synthesized attribute: crr : Meta alternatives: alternative Data: child tyNm : {HsName} child dataCons : DataConL visit 0: local crr : _ -} -- cata sem_Meta :: Meta -> T_Meta sem_Meta (Meta_Data _tyNm _dataCons) = (sem_Meta_Data _tyNm (sem_DataConL _dataCons)) -- semantic domain type T_Meta = ( Meta) sem_Meta_Data :: HsName -> T_DataConL -> T_Meta sem_Meta_Data tyNm_ dataCons_ = (case (dataCons_) of { ( _dataConsIcrr) -> (case (Meta_Data tyNm_ _dataConsIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) -- MetaL ------------------------------------------------------- {- visit 0: synthesized attribute: crr : MetaL alternatives: alternative Cons: child hd : Meta child tl : MetaL visit 0: local crr : _ alternative Nil: visit 0: local crr : _ -} -- cata sem_MetaL :: MetaL -> T_MetaL sem_MetaL list = (Prelude.foldr sem_MetaL_Cons sem_MetaL_Nil (Prelude.map sem_Meta list)) -- semantic domain type T_MetaL = ( MetaL) sem_MetaL_Cons :: T_Meta -> T_MetaL -> T_MetaL sem_MetaL_Cons hd_ tl_ = (case (tl_) of { ( _tlIcrr) -> (case (hd_) of { ( _hdIcrr) -> (case ((:) _hdIcrr _tlIcrr) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) }) }) sem_MetaL_Nil :: T_MetaL sem_MetaL_Nil = (case ([]) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }) -- Mod --------------------------------------------------------- {- visit 0: inherited attributes: moduleNr : Maybe Int nm2ref : Nm2RefMp synthesized attributes: crr : Mod nm2refGath : Nm2RefMp alternatives: alternative Mod: child ref2nm : {Ref2Nm} child moduleNm : {HsName} child moduleNr : {Maybe Int} child stkDepth : {Int} child imports : ImportL child exports : ExportL child metas : MetaL child binds : {CRArray Bind} child mbbody : MbExp visit 0: local inhchk : _ local crr : _ -} -- cata sem_Mod :: Mod -> T_Mod sem_Mod (Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth _imports _exports _metas _binds _mbbody) = (sem_Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth (sem_ImportL _imports) (sem_ExportL _exports) (sem_MetaL _metas) _binds (sem_MbExp _mbbody)) -- semantic domain type T_Mod = (Maybe Int) -> Nm2RefMp -> ( Mod,Nm2RefMp) data Inh_Mod = Inh_Mod {moduleNr_Inh_Mod :: !((Maybe Int)),nm2ref_Inh_Mod :: !(Nm2RefMp)} data Syn_Mod = Syn_Mod {crr_Syn_Mod :: !(Mod),nm2refGath_Syn_Mod :: !(Nm2RefMp)} wrap_Mod :: T_Mod -> Inh_Mod -> Syn_Mod wrap_Mod sem (Inh_Mod _lhsImoduleNr _lhsInm2ref) = (let ( _lhsOcrr,_lhsOnm2refGath) = sem _lhsImoduleNr _lhsInm2ref in (Syn_Mod _lhsOcrr _lhsOnm2refGath)) sem_Mod_Mod :: Ref2Nm -> HsName -> (Maybe Int) -> Int -> T_ImportL -> T_ExportL -> T_MetaL -> (CRArray Bind) -> T_MbExp -> T_Mod sem_Mod_Mod ref2nm_ moduleNm_ moduleNr_ stkDepth_ imports_ exports_ metas_ binds_ mbbody_ = (\ _lhsImoduleNr _lhsInm2ref -> (case (imports_) of { ( _importsIcrr,_importsIimpNmL) -> (case (InhChk _lhsInm2ref (Just $ \n -> elemIndex n _importsIimpNmL)) of { _inhchk -> (case (_inhchk) of { _mbbodyOinhchk -> (case (mbbody_ _mbbodyOinhchk) of { ( _mbbodyIcrr) -> (case (metas_) of { ( _metasIcrr) -> (case (_lhsImoduleNr) of { _exportsOmoduleNr -> (case (moduleNm_) of { _exportsOmoduleNm -> (case (exports_ _exportsOmoduleNm _exportsOmoduleNr) of { ( _exportsIcrr,_exportsInm2refGath) -> (case (Mod_Mod ref2nm_ moduleNm_ moduleNr_ stkDepth_ _importsIcrr _exportsIcrr _metasIcrr binds_ _mbbodyIcrr) of { _crr -> (case (_crr {moduleNr_Mod_Mod = _lhsImoduleNr, binds_Mod_Mod = V.map (chkExp'' _inhchk) binds_}) of { _lhsOcrr -> (case (_exportsInm2refGath) of { _lhsOnm2refGath -> ( _lhsOcrr,_lhsOnm2refGath) }) }) }) }) }) }) }) }) }) }) })) -- Pat --------------------------------------------------------- {- visit 0: inherited attribute: inhchk : InhChk synthesized attribute: crr : Pat alternatives: alternative Con: child tag : {Int} visit 0: local crr : _ -} -- cata sem_Pat :: Pat -> T_Pat sem_Pat (Pat_Con _tag) = (sem_Pat_Con _tag) -- semantic domain type T_Pat = InhChk -> ( Pat) sem_Pat_Con :: Int -> T_Pat sem_Pat_Con tag_ = (\ _lhsIinhchk -> (case (Pat_Con tag_) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) })) -- SExp -------------------------------------------------------- {- visit 0: inherited attribute: inhchk : InhChk synthesized attribute: crr : SExp alternatives: alternative Var: child ref : {RRef} visit 0: local crr : _ alternative Int: child int : {Int} visit 0: local crr : _ alternative Char: child char : {Char} visit 0: local crr : _ alternative String: child str : {String} visit 0: local crr : _ alternative Integer: child integer : {Integer} visit 0: local crr : _ alternative Dbg: child msg : {String} visit 0: local crr : _ -} -- cata sem_SExp :: SExp -> T_SExp sem_SExp (SExp_Var _ref) = (sem_SExp_Var _ref) sem_SExp (SExp_Int _int) = (sem_SExp_Int _int) sem_SExp (SExp_Char _char) = (sem_SExp_Char _char) sem_SExp (SExp_String _str) = (sem_SExp_String _str) sem_SExp (SExp_Integer _integer) = (sem_SExp_Integer _integer) sem_SExp (SExp_Dbg _msg) = (sem_SExp_Dbg _msg) -- semantic domain type T_SExp = InhChk -> ( SExp) data Inh_SExp = Inh_SExp {inhchk_Inh_SExp :: !(InhChk)} data Syn_SExp = Syn_SExp {crr_Syn_SExp :: !(SExp)} wrap_SExp :: T_SExp -> Inh_SExp -> Syn_SExp wrap_SExp sem (Inh_SExp _lhsIinhchk) = (let ( _lhsOcrr) = sem _lhsIinhchk in (Syn_SExp _lhsOcrr)) sem_SExp_Var :: RRef -> T_SExp sem_SExp_Var ref_ = (\ _lhsIinhchk -> (case (SExp_Var ref_) of { _crr -> (case (_crr {ref_SExp_Var = rrefResolveUnr (impNmLkupInhChk _lhsIinhchk) (nm2refInhChk _lhsIinhchk) ref_}) of { _lhsOcrr -> ( _lhsOcrr) }) })) sem_SExp_Int :: Int -> T_SExp sem_SExp_Int int_ = (\ _lhsIinhchk -> (case (SExp_Int int_) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) })) sem_SExp_Char :: Char -> T_SExp sem_SExp_Char char_ = (\ _lhsIinhchk -> (case (SExp_Char char_) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) })) sem_SExp_String :: String -> T_SExp sem_SExp_String str_ = (\ _lhsIinhchk -> (case (SExp_String str_) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) })) sem_SExp_Integer :: Integer -> T_SExp sem_SExp_Integer integer_ = (\ _lhsIinhchk -> (case (SExp_Integer integer_) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) })) sem_SExp_Dbg :: String -> T_SExp sem_SExp_Dbg msg_ = (\ _lhsIinhchk -> (case (SExp_Dbg msg_) of { _crr -> (case (_crr) of { _lhsOcrr -> ( _lhsOcrr) }) }))