-- UUAGC 0.9.52.1 (build/103/lib-ehc/UHC/Light/Compiler/CoreRun/ModImp) module UHC.Light.Compiler.CoreRun.ModImpExp(crmodImpExp', 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 UHC.Light.Compiler.Module.ImportExport as ModImpExp deriving instance Typeable Syn_AGItf crmodImpExp' :: Inh_AGItf -> Mod -> Syn_AGItf crmodImpExp' inh crmod = t where t = wrap_AGItf (sem_AGItf (AGItf_AGItf crmod)) inh -- AGItf ------------------------------------------------------- {- visit 0: inherited attribute: moduleNm : HsName synthesized attributes: hasMain : Bool impModNmL : [HsName] mod : ModImpExp.Mod realModuleNm : HsName 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 = HsName -> ( Bool,([HsName]),(ModImpExp.Mod),HsName) data Inh_AGItf = Inh_AGItf {moduleNm_Inh_AGItf :: !(HsName)} data Syn_AGItf = Syn_AGItf {hasMain_Syn_AGItf :: !(Bool),impModNmL_Syn_AGItf :: !(([HsName])),mod_Syn_AGItf :: !((ModImpExp.Mod)),realModuleNm_Syn_AGItf :: !(HsName)} wrap_AGItf :: T_AGItf -> Inh_AGItf -> Syn_AGItf wrap_AGItf sem (Inh_AGItf _lhsImoduleNm) = (let ( _lhsOhasMain,_lhsOimpModNmL,_lhsOmod,_lhsOrealModuleNm) = sem _lhsImoduleNm in (Syn_AGItf _lhsOhasMain _lhsOimpModNmL _lhsOmod _lhsOrealModuleNm)) sem_AGItf_AGItf :: T_Mod -> T_AGItf sem_AGItf_AGItf module_ = (\ _lhsImoduleNm -> (case (_lhsImoduleNm) of { _moduleOmoduleNm -> (case (module_ _moduleOmoduleNm) of { ( _moduleIhasMain,_moduleIimpModNmL,_moduleImod,_moduleIrealModuleNm) -> (case (_moduleIhasMain) of { _lhsOhasMain -> (case (_moduleIimpModNmL) of { _lhsOimpModNmL -> (case (_moduleImod) of { _lhsOmod -> (case (_moduleIrealModuleNm) of { _lhsOrealModuleNm -> ( _lhsOhasMain,_lhsOimpModNmL,_lhsOmod,_lhsOrealModuleNm) }) }) }) }) }) })) -- Alt --------------------------------------------------------- {- alternatives: alternative Alt: child ref2nm : {Ref2Nm} child expr : Exp -} -- cata sem_Alt :: Alt -> T_Alt sem_Alt (Alt_Alt _ref2nm _expr) = (sem_Alt_Alt _ref2nm (sem_Exp _expr)) -- semantic domain type T_Alt = ( ) sem_Alt_Alt :: Ref2Nm -> T_Exp -> T_Alt sem_Alt_Alt ref2nm_ expr_ = ( ) -- DataCon ----------------------------------------------------- {- alternatives: alternative Con: child conNm : {HsName} child tagNr : {Int} -} -- cata sem_DataCon :: DataCon -> T_DataCon sem_DataCon (DataCon_Con _conNm _tagNr) = (sem_DataCon_Con _conNm _tagNr) -- semantic domain type T_DataCon = ( ) sem_DataCon_Con :: HsName -> Int -> T_DataCon sem_DataCon_Con conNm_ tagNr_ = ( ) -- DataConL ---------------------------------------------------- {- alternatives: alternative Cons: child hd : DataCon child tl : DataConL alternative Nil: -} -- 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 = ( ) sem_DataConL_Cons :: T_DataCon -> T_DataConL -> T_DataConL sem_DataConL_Cons hd_ tl_ = ( ) sem_DataConL_Nil :: T_DataConL sem_DataConL_Nil = ( ) -- Exp --------------------------------------------------------- {- alternatives: alternative SExp: child sexpr : SExp alternative Tup: child tag : {Int} child args : {CRArray SExp} alternative Let: child firstOff : {Int} child ref2nm : {Ref2Nm} child binds : {CRArray Bind} child body : Exp alternative App: child func : Exp child args : {CRArray SExp} alternative Lam: child mbNm : {Maybe HsName} child nrArgs : {Int} child stkDepth : {Int} child ref2nm : {Ref2Nm} child body : Exp alternative Force: child expr : Exp alternative Tail: child expr : Exp alternative Case: child expr : SExp child alts : {CRArray Alt} alternative FFI: child prim : {RunPrim} child args : {CRArray SExp} -} -- 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 = ( ) sem_Exp_SExp :: T_SExp -> T_Exp sem_Exp_SExp sexpr_ = ( ) sem_Exp_Tup :: Int -> (CRArray SExp) -> T_Exp sem_Exp_Tup tag_ args_ = ( ) sem_Exp_Let :: Int -> Ref2Nm -> (CRArray Bind) -> T_Exp -> T_Exp sem_Exp_Let firstOff_ ref2nm_ binds_ body_ = ( ) sem_Exp_App :: T_Exp -> (CRArray SExp) -> T_Exp sem_Exp_App func_ args_ = ( ) sem_Exp_Lam :: (Maybe HsName) -> Int -> Int -> Ref2Nm -> T_Exp -> T_Exp sem_Exp_Lam mbNm_ nrArgs_ stkDepth_ ref2nm_ body_ = ( ) sem_Exp_Force :: T_Exp -> T_Exp sem_Exp_Force expr_ = ( ) sem_Exp_Tail :: T_Exp -> T_Exp sem_Exp_Tail expr_ = ( ) sem_Exp_Case :: T_SExp -> (CRArray Alt) -> T_Exp sem_Exp_Case expr_ alts_ = ( ) sem_Exp_FFI :: RunPrim -> (CRArray SExp) -> T_Exp sem_Exp_FFI prim_ args_ = ( ) -- Export ------------------------------------------------------ {- alternatives: alternative Export: child nm : {HsName} child offset : {Int} -} -- cata sem_Export :: Export -> T_Export sem_Export (Export_Export _nm _offset) = (sem_Export_Export _nm _offset) -- semantic domain type T_Export = ( ) sem_Export_Export :: HsName -> Int -> T_Export sem_Export_Export nm_ offset_ = ( ) -- ExportL ----------------------------------------------------- {- alternatives: alternative Cons: child hd : Export child tl : ExportL alternative Nil: -} -- 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 = ( ) sem_ExportL_Cons :: T_Export -> T_ExportL -> T_ExportL sem_ExportL_Cons hd_ tl_ = ( ) sem_ExportL_Nil :: T_ExportL sem_ExportL_Nil = ( ) -- Import ------------------------------------------------------ {- visit 0: synthesized attributes: impModNmL : [HsName] modImpL : [ModImpExp.ModImp] alternatives: alternative Import: child nm : {HsName} -} -- cata sem_Import :: Import -> T_Import sem_Import (Import_Import _nm) = (sem_Import_Import _nm) -- semantic domain type T_Import = ( ([HsName]),([ModImpExp.ModImp])) sem_Import_Import :: HsName -> T_Import sem_Import_Import nm_ = (case ([nm_]) of { _lhsOimpModNmL -> (case ([ModImpExp.ModImp True nm_ nm_ False [] emptyRange]) of { _lhsOmodImpL -> ( _lhsOimpModNmL,_lhsOmodImpL) }) }) -- ImportL ----------------------------------------------------- {- visit 0: synthesized attributes: impModNmL : [HsName] modImpL : [ModImpExp.ModImp] alternatives: alternative Cons: child hd : Import child tl : ImportL alternative Nil: -} -- 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 = ( ([HsName]),([ModImpExp.ModImp])) sem_ImportL_Cons :: T_Import -> T_ImportL -> T_ImportL sem_ImportL_Cons hd_ tl_ = (case (tl_) of { ( _tlIimpModNmL,_tlImodImpL) -> (case (hd_) of { ( _hdIimpModNmL,_hdImodImpL) -> (case (_hdIimpModNmL ++ _tlIimpModNmL) of { _lhsOimpModNmL -> (case (_hdImodImpL ++ _tlImodImpL) of { _lhsOmodImpL -> ( _lhsOimpModNmL,_lhsOmodImpL) }) }) }) }) sem_ImportL_Nil :: T_ImportL sem_ImportL_Nil = (case ([]) of { _lhsOimpModNmL -> (case ([]) of { _lhsOmodImpL -> ( _lhsOimpModNmL,_lhsOmodImpL) }) }) -- MbExp ------------------------------------------------------- {- visit 0: synthesized attribute: isJust : Bool alternatives: alternative Just: child just : Exp alternative Nothing: -} -- 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 = ( Bool) sem_MbExp_Just :: T_Exp -> T_MbExp sem_MbExp_Just just_ = (case (True) of { _lhsOisJust -> ( _lhsOisJust) }) sem_MbExp_Nothing :: T_MbExp sem_MbExp_Nothing = (case (False) of { _lhsOisJust -> ( _lhsOisJust) }) -- Meta -------------------------------------------------------- {- alternatives: alternative Data: child tyNm : {HsName} child dataCons : DataConL -} -- cata sem_Meta :: Meta -> T_Meta sem_Meta (Meta_Data _tyNm _dataCons) = (sem_Meta_Data _tyNm (sem_DataConL _dataCons)) -- semantic domain type T_Meta = ( ) sem_Meta_Data :: HsName -> T_DataConL -> T_Meta sem_Meta_Data tyNm_ dataCons_ = ( ) -- MetaL ------------------------------------------------------- {- alternatives: alternative Cons: child hd : Meta child tl : MetaL alternative Nil: -} -- 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 = ( ) sem_MetaL_Cons :: T_Meta -> T_MetaL -> T_MetaL sem_MetaL_Cons hd_ tl_ = ( ) sem_MetaL_Nil :: T_MetaL sem_MetaL_Nil = ( ) -- Mod --------------------------------------------------------- {- visit 0: inherited attribute: moduleNm : HsName synthesized attributes: hasMain : Bool impModNmL : [HsName] mod : ModImpExp.Mod realModuleNm : HsName 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 realModuleNm : _ -} -- 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 = HsName -> ( Bool,([HsName]),(ModImpExp.Mod),HsName) 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_ = (\ _lhsImoduleNm -> (case (mbbody_) of { ( _mbbodyIisJust) -> (case (_mbbodyIisJust) of { _lhsOhasMain -> (case (imports_) of { ( _importsIimpModNmL,_importsImodImpL) -> (case (_importsIimpModNmL) of { _lhsOimpModNmL -> (case (moduleNm_) of { _realModuleNm -> (case (ModImpExp.Mod _realModuleNm (Just _realModuleNm) Nothing _importsImodImpL Rel.empty Rel.empty []) of { _lhsOmod -> (case (_realModuleNm) of { _lhsOrealModuleNm -> ( _lhsOhasMain,_lhsOimpModNmL,_lhsOmod,_lhsOrealModuleNm) }) }) }) }) }) }) })) -- Pat --------------------------------------------------------- {- alternatives: alternative Con: child tag : {Int} -} -- cata sem_Pat :: Pat -> T_Pat sem_Pat (Pat_Con _tag) = (sem_Pat_Con _tag) -- semantic domain type T_Pat = ( ) sem_Pat_Con :: Int -> T_Pat sem_Pat_Con tag_ = ( ) -- SExp -------------------------------------------------------- {- alternatives: alternative Var: child ref : {RRef} alternative Int: child int : {Int} alternative Char: child char : {Char} alternative String: child str : {String} alternative Integer: child integer : {Integer} alternative Dbg: child msg : {String} -} -- 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 = ( ) sem_SExp_Var :: RRef -> T_SExp sem_SExp_Var ref_ = ( ) sem_SExp_Int :: Int -> T_SExp sem_SExp_Int int_ = ( ) sem_SExp_Char :: Char -> T_SExp sem_SExp_Char char_ = ( ) sem_SExp_String :: String -> T_SExp sem_SExp_String str_ = ( ) sem_SExp_Integer :: Integer -> T_SExp sem_SExp_Integer integer_ = ( ) sem_SExp_Dbg :: String -> T_SExp sem_SExp_Dbg msg_ = ( )