-- UUAGC 0.9.52.1 (build/103/lib-ehc/UHC/Light/Compiler/Core/PrettyTra) module UHC.Light.Compiler.Core.PrettyTrace(ppASTCModule) where import UHC.Util.Pretty import UHC.Light.Compiler.Base.HsName.Builtin import UHC.Light.Compiler.Base.CfgPP import UHC.Light.Compiler.Opts.Base import UHC.Light.Compiler.Base.Common import UHC.Light.Compiler.Ty import UHC.Light.Compiler.Core import UHC.Light.Compiler.Base.Trace import UHC.Light.Compiler.Ty.Pretty import qualified Data.Set as Set import UHC.Light.Compiler.Foreign.Pretty ppASTCModule :: EHCOpts -> {- LamMp -> -} CModule -> PP_Doc ppASTCModule opts {- lamMp -} cmod = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) (Inh_CodeAGItf { {- lamMp_Inh_CodeAGItf = lamMp , -} opts_Inh_CodeAGItf = opts }) in (ppAST_Syn_CodeAGItf t) -- CAlt -------------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Alt: child pat : CPat child expr : CExpr visit 0: local trppHere : _ -} -- cata sem_CAlt :: CAlt -> T_CAlt sem_CAlt (CAlt_Alt _pat _expr) = (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) -- semantic domain type T_CAlt = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CAlt_Alt :: T_CPat -> T_CExpr -> T_CAlt sem_CAlt_Alt pat_ expr_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (_lhsItr) of { _patOtr -> (case (_lhsIopts) of { _patOopts -> (case (pat_ _patOopts _patOtr) of { ( _patIppAST) -> (case (ppNestTrPP ["CAlt","Alt"] [] [_patIppAST, _exprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) })) -- CAltL ------------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Cons: child hd : CAlt child tl : CAltL alternative Nil: -} -- cata sem_CAltL :: CAltL -> T_CAltL sem_CAltL list = (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) -- semantic domain type T_CAltL = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CAltL_Cons :: T_CAlt -> T_CAltL -> T_CAltL sem_CAltL_Cons hd_ tl_ = (\ _lhsIopts _lhsItr -> (case (_lhsItr) of { _tlOtr -> (case (_lhsIopts) of { _tlOopts -> (case (tl_ _tlOopts _tlOtr) of { ( _tlIppAST) -> (case (_lhsItr) of { _hdOtr -> (case (_lhsIopts) of { _hdOopts -> (case (hd_ _hdOopts _hdOtr) of { ( _hdIppAST) -> (case (_hdIppAST >-< _tlIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) sem_CAltL_Nil :: T_CAltL sem_CAltL_Nil = (\ _lhsIopts _lhsItr -> (case (empty) of { _lhsOppAST -> ( _lhsOppAST) })) -- CBind ------------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Bind: child nm : {HsName} child bindAspects : CBoundL visit 0: local trppHere : _ -} -- cata sem_CBind :: CBind -> T_CBind sem_CBind (CBind_Bind _nm _bindAspects) = (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) -- semantic domain type T_CBind = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CBind_Bind :: HsName -> T_CBoundL -> T_CBind sem_CBind_Bind nm_ bindAspects_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _bindAspectsOtr -> (case (_lhsIopts) of { _bindAspectsOopts -> (case (bindAspects_ _bindAspectsOopts _bindAspectsOtr) of { ( _bindAspectsIppAST) -> (case (ppNestTrPP ["CBind","Bind"] [ppTrNm nm_] [_bindAspectsIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) })) -- CBindAnn ---------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Coe: child coe : {()} visit 0: local trppHere : _ -} -- cata sem_CBindAnn :: CBindAnn -> T_CBindAnn sem_CBindAnn (CBindAnn_Coe _coe) = (sem_CBindAnn_Coe _coe) -- semantic domain type T_CBindAnn = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CBindAnn","Coe"] [pp coe_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) -- CBindAnnL --------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Cons: child hd : CBindAnn child tl : CBindAnnL alternative Nil: -} -- cata sem_CBindAnnL :: CBindAnnL -> T_CBindAnnL sem_CBindAnnL list = (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) -- semantic domain type T_CBindAnnL = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CBindAnnL_Cons :: T_CBindAnn -> T_CBindAnnL -> T_CBindAnnL sem_CBindAnnL_Cons hd_ tl_ = (\ _lhsIopts _lhsItr -> (case (_lhsItr) of { _tlOtr -> (case (_lhsIopts) of { _tlOopts -> (case (tl_ _tlOopts _tlOtr) of { ( _tlIppAST) -> (case (_lhsItr) of { _hdOtr -> (case (_lhsIopts) of { _hdOopts -> (case (hd_ _hdOopts _hdOtr) of { ( _hdIppAST) -> (case (_hdIppAST >-< _tlIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) sem_CBindAnnL_Nil :: T_CBindAnnL sem_CBindAnnL_Nil = (\ _lhsIopts _lhsItr -> (case (empty) of { _lhsOppAST -> ( _lhsOppAST) })) -- CBindL ------------------------------------------------------ {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Cons: child hd : CBind child tl : CBindL alternative Nil: -} -- cata sem_CBindL :: CBindL -> T_CBindL sem_CBindL list = (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) -- semantic domain type T_CBindL = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CBindL_Cons :: T_CBind -> T_CBindL -> T_CBindL sem_CBindL_Cons hd_ tl_ = (\ _lhsIopts _lhsItr -> (case (_lhsItr) of { _tlOtr -> (case (_lhsIopts) of { _tlOopts -> (case (tl_ _tlOopts _tlOtr) of { ( _tlIppAST) -> (case (_lhsItr) of { _hdOtr -> (case (_lhsIopts) of { _hdOopts -> (case (hd_ _hdOopts _hdOtr) of { ( _hdIppAST) -> (case (_hdIppAST >-< _tlIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) sem_CBindL_Nil :: T_CBindL sem_CBindL_Nil = (\ _lhsIopts _lhsItr -> (case (empty) of { _lhsOppAST -> ( _lhsOppAST) })) -- CBound ------------------------------------------------------ {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Bind: child expr : CExpr visit 0: local trppHere : _ alternative Val: child aspectKeyS : {ACoreBindAspectKeyS} child mlev : {MetaLev} child lbl : {CLbl} child expr : CExpr visit 0: local trppHere : _ alternative Ty: child aspectKeyS : {ACoreBindAspectKeyS} child ty : {Ty} visit 0: local trppHere : _ alternative FFE: child callconv : {FFIWay} child expEnt : {ForeignEnt} child expr : CExpr child ty : {Ty} visit 0: local trppHere : _ -} -- cata sem_CBound :: CBound -> T_CBound sem_CBound (CBound_Bind _expr) = (sem_CBound_Bind (sem_CExpr _expr)) sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) sem_CBound (CBound_Ty _aspectKeyS _ty) = (sem_CBound_Ty _aspectKeyS _ty) sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) -- semantic domain type T_CBound = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CBound_Bind :: T_CExpr -> T_CBound sem_CBound_Bind expr_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (ppNestTrPP ["CBound","Bind"] [] [_exprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) })) sem_CBound_Val :: ACoreBindAspectKeyS -> MetaLev -> CLbl -> T_CExpr -> T_CBound sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (ppNestTrPP ["CBound","Val"] [pp aspectKeyS_, pp mlev_, pp lbl_] [_exprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) })) sem_CBound_Ty :: ACoreBindAspectKeyS -> Ty -> T_CBound sem_CBound_Ty aspectKeyS_ ty_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CBound","Ty"] [pp aspectKeyS_, pp ty_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CBound_FFE :: FFIWay -> ForeignEnt -> T_CExpr -> Ty -> T_CBound sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (ppNestTrPP ["CBound","FFE"] [pp callconv_, pp expEnt_, pp ty_] [_exprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) })) -- CBoundL ----------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Cons: child hd : CBound child tl : CBoundL alternative Nil: -} -- cata sem_CBoundL :: CBoundL -> T_CBoundL sem_CBoundL list = (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) -- semantic domain type T_CBoundL = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CBoundL_Cons :: T_CBound -> T_CBoundL -> T_CBoundL sem_CBoundL_Cons hd_ tl_ = (\ _lhsIopts _lhsItr -> (case (_lhsItr) of { _tlOtr -> (case (_lhsIopts) of { _tlOopts -> (case (tl_ _tlOopts _tlOtr) of { ( _tlIppAST) -> (case (_lhsItr) of { _hdOtr -> (case (_lhsIopts) of { _hdOopts -> (case (hd_ _hdOopts _hdOtr) of { ( _hdIppAST) -> (case (_hdIppAST >-< _tlIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) sem_CBoundL_Nil :: T_CBoundL sem_CBoundL_Nil = (\ _lhsIopts _lhsItr -> (case (empty) of { _lhsOppAST -> ( _lhsOppAST) })) -- CDataCon ---------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Con: child conNm : {HsName} child tagNr : {Int} child arity : {Int} visit 0: local trppHere : _ -} -- cata sem_CDataCon :: CDataCon -> T_CDataCon sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = (sem_CDataCon_Con _conNm _tagNr _arity) -- semantic domain type T_CDataCon = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CDataCon_Con :: HsName -> Int -> Int -> T_CDataCon sem_CDataCon_Con conNm_ tagNr_ arity_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CDataCon","Con"] [ppTrNm conNm_, pp tagNr_, pp arity_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) -- CDataConL --------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Cons: child hd : CDataCon child tl : CDataConL alternative Nil: -} -- cata sem_CDataConL :: CDataConL -> T_CDataConL sem_CDataConL list = (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) -- semantic domain type T_CDataConL = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CDataConL_Cons :: T_CDataCon -> T_CDataConL -> T_CDataConL sem_CDataConL_Cons hd_ tl_ = (\ _lhsIopts _lhsItr -> (case (_lhsItr) of { _tlOtr -> (case (_lhsIopts) of { _tlOopts -> (case (tl_ _tlOopts _tlOtr) of { ( _tlIppAST) -> (case (_lhsItr) of { _hdOtr -> (case (_lhsIopts) of { _hdOopts -> (case (hd_ _hdOopts _hdOtr) of { ( _hdIppAST) -> (case (_hdIppAST >-< _tlIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) sem_CDataConL_Nil :: T_CDataConL sem_CDataConL_Nil = (\ _lhsIopts _lhsItr -> (case (empty) of { _lhsOppAST -> ( _lhsOppAST) })) -- CDeclMeta --------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Data: child tyNm : {HsName} child dataCons : CDataConL visit 0: local trppHere : _ -} -- cata sem_CDeclMeta :: CDeclMeta -> T_CDeclMeta sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) -- semantic domain type T_CDeclMeta = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CDeclMeta_Data :: HsName -> T_CDataConL -> T_CDeclMeta sem_CDeclMeta_Data tyNm_ dataCons_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _dataConsOtr -> (case (_lhsIopts) of { _dataConsOopts -> (case (dataCons_ _dataConsOopts _dataConsOtr) of { ( _dataConsIppAST) -> (case (ppNestTrPP ["CDeclMeta","Data"] [ppTrNm tyNm_] [_dataConsIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) })) -- CDeclMetaL -------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Cons: child hd : CDeclMeta child tl : CDeclMetaL alternative Nil: -} -- cata sem_CDeclMetaL :: CDeclMetaL -> T_CDeclMetaL sem_CDeclMetaL list = (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) -- semantic domain type T_CDeclMetaL = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CDeclMetaL_Cons :: T_CDeclMeta -> T_CDeclMetaL -> T_CDeclMetaL sem_CDeclMetaL_Cons hd_ tl_ = (\ _lhsIopts _lhsItr -> (case (_lhsItr) of { _tlOtr -> (case (_lhsIopts) of { _tlOopts -> (case (tl_ _tlOopts _tlOtr) of { ( _tlIppAST) -> (case (_lhsItr) of { _hdOtr -> (case (_lhsIopts) of { _hdOopts -> (case (hd_ _hdOopts _hdOtr) of { ( _hdIppAST) -> (case (_hdIppAST >-< _tlIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) sem_CDeclMetaL_Nil :: T_CDeclMetaL sem_CDeclMetaL_Nil = (\ _lhsIopts _lhsItr -> (case (empty) of { _lhsOppAST -> ( _lhsOppAST) })) -- CExport ----------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Export: child nm : {HsName} visit 0: local trppHere : _ alternative ExportData: child nm : {HsName} child mbConNmL : {Maybe [HsName]} visit 0: local trppHere : _ -} -- cata sem_CExport :: CExport -> T_CExport sem_CExport (CExport_Export _nm) = (sem_CExport_Export _nm) sem_CExport (CExport_ExportData _nm _mbConNmL) = (sem_CExport_ExportData _nm _mbConNmL) -- semantic domain type T_CExport = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CExport_Export :: HsName -> T_CExport sem_CExport_Export nm_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExport","Export"] [ppTrNm nm_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExport_ExportData :: HsName -> (Maybe [HsName]) -> T_CExport sem_CExport_ExportData nm_ mbConNmL_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExport","ExportData"] [ppTrNm nm_, pp $ fmap ppParensCommas' mbConNmL_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) -- CExportL ---------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Cons: child hd : CExport child tl : CExportL alternative Nil: -} -- cata sem_CExportL :: CExportL -> T_CExportL sem_CExportL list = (Prelude.foldr sem_CExportL_Cons sem_CExportL_Nil (Prelude.map sem_CExport list)) -- semantic domain type T_CExportL = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CExportL_Cons :: T_CExport -> T_CExportL -> T_CExportL sem_CExportL_Cons hd_ tl_ = (\ _lhsIopts _lhsItr -> (case (_lhsItr) of { _tlOtr -> (case (_lhsIopts) of { _tlOopts -> (case (tl_ _tlOopts _tlOtr) of { ( _tlIppAST) -> (case (_lhsItr) of { _hdOtr -> (case (_lhsIopts) of { _hdOopts -> (case (hd_ _hdOopts _hdOtr) of { ( _hdIppAST) -> (case (_hdIppAST >-< _tlIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) sem_CExportL_Nil :: T_CExportL sem_CExportL_Nil = (\ _lhsIopts _lhsItr -> (case (empty) of { _lhsOppAST -> ( _lhsOppAST) })) -- CExpr ------------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Var: child ref : {ACoreBindRef} visit 0: local trppHere : _ alternative Int: child int : {Int} visit 0: local trppHere : _ alternative Char: child char : {Char} visit 0: local trppHere : _ alternative String: child str : {String} visit 0: local trppHere : _ alternative Integer: child integer : {Integer} visit 0: local trppHere : _ alternative Tup: child tag : {CTag} visit 0: local trppHere : _ alternative Let: child categ : {CBindCateg} child binds : CBindL child body : CExpr visit 0: local trppHere : _ alternative App: child func : CExpr child arg : CBound visit 0: local trppHere : _ alternative Lam: child bind : CBind child body : CExpr visit 0: local trppHere : _ alternative Case: child expr : CExpr child alts : CAltL child dflt : CExpr visit 0: local trppHere : _ alternative CaseAltFail: child failReason : {CaseAltFailReason} child errorExpr : CExpr visit 0: local trppHere : _ alternative TupDel: child expr : CExpr child tag : {CTag} child nm : {HsName} child offset : CExpr visit 0: local trppHere : _ alternative TupIns: child expr : CExpr child tag : {CTag} child nm : {HsName} child offset : CExpr child fldExpr : CExpr visit 0: local trppHere : _ alternative TupUpd: child expr : CExpr child tag : {CTag} child nm : {HsName} child offset : CExpr child fldExpr : CExpr visit 0: local trppHere : _ alternative FFI: child callconv : {FFIWay} child safety : {String} child impEnt : {ForeignEnt} child ty : {Ty} visit 0: local trppHere : _ alternative Dbg: child info : {String} visit 0: local trppHere : _ alternative Hole: child uid : {UID} visit 0: local trppHere : _ alternative HoleLet: child bindsUid : {UID} child body : CExpr visit 0: local trppHere : _ alternative CoeArg: visit 0: local trppHere : _ alternative ImplsApp: child func : CExpr child uid : {ImplsVarId} visit 0: local trppHere : _ alternative ImplsLam: child uid : {ImplsVarId} child body : CExpr visit 0: local trppHere : _ alternative Ann: child ann : CExprAnn child expr : CExpr visit 0: local trppHere : _ -} -- cata sem_CExpr :: CExpr -> T_CExpr sem_CExpr (CExpr_Var _ref) = (sem_CExpr_Var _ref) sem_CExpr (CExpr_Int _int) = (sem_CExpr_Int _int) sem_CExpr (CExpr_Char _char) = (sem_CExpr_Char _char) sem_CExpr (CExpr_String _str) = (sem_CExpr_String _str) sem_CExpr (CExpr_Integer _integer) = (sem_CExpr_Integer _integer) sem_CExpr (CExpr_Tup _tag) = (sem_CExpr_Tup _tag) sem_CExpr (CExpr_Let _categ _binds _body) = (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) sem_CExpr (CExpr_App _func _arg) = (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) sem_CExpr (CExpr_Lam _bind _body) = (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) sem_CExpr (CExpr_Case _expr _alts _dflt) = (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = (sem_CExpr_FFI _callconv _safety _impEnt _ty) sem_CExpr (CExpr_Dbg _info) = (sem_CExpr_Dbg _info) sem_CExpr (CExpr_Hole _uid) = (sem_CExpr_Hole _uid) sem_CExpr (CExpr_HoleLet _bindsUid _body) = (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) sem_CExpr (CExpr_CoeArg) = (sem_CExpr_CoeArg) sem_CExpr (CExpr_ImplsApp _func _uid) = (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) sem_CExpr (CExpr_ImplsLam _uid _body) = (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) sem_CExpr (CExpr_Ann _ann _expr) = (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) -- semantic domain type T_CExpr = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CExpr_Var :: ACoreBindRef -> T_CExpr sem_CExpr_Var ref_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","Var"] [pp ref_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_Int :: Int -> T_CExpr sem_CExpr_Int int_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","Int"] [pp int_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_Char :: Char -> T_CExpr sem_CExpr_Char char_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","Char"] [pp char_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_String :: String -> T_CExpr sem_CExpr_String str_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","String"] [pp str_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_Integer :: Integer -> T_CExpr sem_CExpr_Integer integer_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","Integer"] [pp integer_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_Tup :: CTag -> T_CExpr sem_CExpr_Tup tag_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","Tup"] [pp tag_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_Let :: CBindCateg -> T_CBindL -> T_CExpr -> T_CExpr sem_CExpr_Let categ_ binds_ body_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _bodyOtr -> (case (_lhsIopts) of { _bodyOopts -> (case (body_ _bodyOopts _bodyOtr) of { ( _bodyIppAST) -> (case (_lhsItr) of { _bindsOtr -> (case (_lhsIopts) of { _bindsOopts -> (case (binds_ _bindsOopts _bindsOtr) of { ( _bindsIppAST) -> (case (ppNestTrPP ["CExpr","Let"] [pp categ_] [_bindsIppAST] _trppHere >-< _bodyIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) })) sem_CExpr_App :: T_CExpr -> T_CBound -> T_CExpr sem_CExpr_App func_ arg_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _argOtr -> (case (_lhsIopts) of { _argOopts -> (case (arg_ _argOopts _argOtr) of { ( _argIppAST) -> (case (_lhsItr) of { _funcOtr -> (case (_lhsIopts) of { _funcOopts -> (case (func_ _funcOopts _funcOtr) of { ( _funcIppAST) -> (case (ppNestTrPP ["CExpr","App"] [] [_funcIppAST,_argIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) })) sem_CExpr_Lam :: T_CBind -> T_CExpr -> T_CExpr sem_CExpr_Lam bind_ body_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _bodyOtr -> (case (_lhsIopts) of { _bodyOopts -> (case (body_ _bodyOopts _bodyOtr) of { ( _bodyIppAST) -> (case (_lhsItr) of { _bindOtr -> (case (_lhsIopts) of { _bindOopts -> (case (bind_ _bindOopts _bindOtr) of { ( _bindIppAST) -> (case (ppNestTrPP ["CExpr","Lam"] [] [_bindIppAST,_bodyIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) })) sem_CExpr_Case :: T_CExpr -> T_CAltL -> T_CExpr -> T_CExpr sem_CExpr_Case expr_ alts_ dflt_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _dfltOtr -> (case (_lhsIopts) of { _dfltOopts -> (case (dflt_ _dfltOopts _dfltOtr) of { ( _dfltIppAST) -> (case (_lhsItr) of { _altsOtr -> (case (_lhsIopts) of { _altsOopts -> (case (alts_ _altsOopts _altsOtr) of { ( _altsIppAST) -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (ppNestTrPP ["CExpr","Case"] [] [_exprIppAST, _dfltIppAST, _altsIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) }) }) }) })) sem_CExpr_CaseAltFail :: CaseAltFailReason -> T_CExpr -> T_CExpr sem_CExpr_CaseAltFail failReason_ errorExpr_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _errorExprOtr -> (case (_lhsIopts) of { _errorExprOopts -> (case (errorExpr_ _errorExprOopts _errorExprOtr) of { ( _errorExprIppAST) -> (case (ppNestTrPP ["CExpr","CaseAltFail"] [pp failReason_] [_errorExprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) })) sem_CExpr_TupDel :: T_CExpr -> CTag -> HsName -> T_CExpr -> T_CExpr sem_CExpr_TupDel expr_ tag_ nm_ offset_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _offsetOtr -> (case (_lhsIopts) of { _offsetOopts -> (case (offset_ _offsetOopts _offsetOtr) of { ( _offsetIppAST) -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (ppNestTrPP ["CExpr","TupDel"] [pp tag_, ppTrNm nm_] [_offsetIppAST, _exprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) })) sem_CExpr_TupIns :: T_CExpr -> CTag -> HsName -> T_CExpr -> T_CExpr -> T_CExpr sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _fldExprOtr -> (case (_lhsIopts) of { _fldExprOopts -> (case (fldExpr_ _fldExprOopts _fldExprOtr) of { ( _fldExprIppAST) -> (case (_lhsItr) of { _offsetOtr -> (case (_lhsIopts) of { _offsetOopts -> (case (offset_ _offsetOopts _offsetOtr) of { ( _offsetIppAST) -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (ppNestTrPP ["CExpr","TupIns"] [pp tag_, ppTrNm nm_] [_offsetIppAST, _fldExprIppAST, _exprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) }) }) }) })) sem_CExpr_TupUpd :: T_CExpr -> CTag -> HsName -> T_CExpr -> T_CExpr -> T_CExpr sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _fldExprOtr -> (case (_lhsIopts) of { _fldExprOopts -> (case (fldExpr_ _fldExprOopts _fldExprOtr) of { ( _fldExprIppAST) -> (case (_lhsItr) of { _offsetOtr -> (case (_lhsIopts) of { _offsetOopts -> (case (offset_ _offsetOopts _offsetOtr) of { ( _offsetIppAST) -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (ppNestTrPP ["CExpr","TupUpd"] [pp tag_, ppTrNm nm_] [_offsetIppAST, _fldExprIppAST, _exprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) }) }) }) })) sem_CExpr_FFI :: FFIWay -> String -> ForeignEnt -> Ty -> T_CExpr sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","FFI"] [pp callconv_, pp safety_, pp impEnt_, pp ty_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_Dbg :: String -> T_CExpr sem_CExpr_Dbg info_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","Dbg"] [pp info_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_Hole :: UID -> T_CExpr sem_CExpr_Hole uid_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","Hole"] [pp uid_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_HoleLet :: UID -> T_CExpr -> T_CExpr sem_CExpr_HoleLet bindsUid_ body_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _bodyOtr -> (case (_lhsIopts) of { _bodyOopts -> (case (body_ _bodyOopts _bodyOtr) of { ( _bodyIppAST) -> (case (ppNestTrPP ["CExpr","HoleLet"] [pp bindsUid_] [_bodyIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) })) sem_CExpr_CoeArg :: T_CExpr sem_CExpr_CoeArg = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExpr","CoeArg"] [] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExpr_ImplsApp :: T_CExpr -> ImplsVarId -> T_CExpr sem_CExpr_ImplsApp func_ uid_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _funcOtr -> (case (_lhsIopts) of { _funcOopts -> (case (func_ _funcOopts _funcOtr) of { ( _funcIppAST) -> (case (ppNestTrPP ["CExpr","ImplsApp"] [pp uid_] [_funcIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) })) sem_CExpr_ImplsLam :: ImplsVarId -> T_CExpr -> T_CExpr sem_CExpr_ImplsLam uid_ body_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _bodyOtr -> (case (_lhsIopts) of { _bodyOopts -> (case (body_ _bodyOopts _bodyOtr) of { ( _bodyIppAST) -> (case (ppNestTrPP ["CExpr","ImplsLam"] [pp uid_] [_bodyIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) })) sem_CExpr_Ann :: T_CExprAnn -> T_CExpr -> T_CExpr sem_CExpr_Ann ann_ expr_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (_lhsItr) of { _annOtr -> (case (_lhsIopts) of { _annOopts -> (case (ann_ _annOopts _annOtr) of { ( _annIppAST) -> (case (ppNestTrPP ["CExpr","Ann"] [] [_annIppAST, _exprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) })) -- CExprAnn ---------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Ty: child ty : {Ty} visit 0: local trppHere : _ alternative Debug: child info : {String} visit 0: local trppHere : _ -} -- cata sem_CExprAnn :: CExprAnn -> T_CExprAnn sem_CExprAnn (CExprAnn_Ty _ty) = (sem_CExprAnn_Ty _ty) sem_CExprAnn (CExprAnn_Debug _info) = (sem_CExprAnn_Debug _info) -- semantic domain type T_CExprAnn = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CExprAnn_Ty :: Ty -> T_CExprAnn sem_CExprAnn_Ty ty_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExprAnn","Ty"] [pp ty_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CExprAnn_Debug :: String -> T_CExprAnn sem_CExprAnn_Debug info_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CExprAnn","Debug"] [pp info_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) -- CImport ----------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Import: child nm : {HsName} visit 0: local trppHere : _ -} -- cata sem_CImport :: CImport -> T_CImport sem_CImport (CImport_Import _nm) = (sem_CImport_Import _nm) -- semantic domain type T_CImport = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CImport_Import :: HsName -> T_CImport sem_CImport_Import nm_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CImport","Import"] [ppTrNm nm_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) -- CImportL ---------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Cons: child hd : CImport child tl : CImportL alternative Nil: -} -- cata sem_CImportL :: CImportL -> T_CImportL sem_CImportL list = (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) -- semantic domain type T_CImportL = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CImportL_Cons :: T_CImport -> T_CImportL -> T_CImportL sem_CImportL_Cons hd_ tl_ = (\ _lhsIopts _lhsItr -> (case (_lhsItr) of { _tlOtr -> (case (_lhsIopts) of { _tlOopts -> (case (tl_ _tlOopts _tlOtr) of { ( _tlIppAST) -> (case (_lhsItr) of { _hdOtr -> (case (_lhsIopts) of { _hdOopts -> (case (hd_ _hdOopts _hdOtr) of { ( _hdIppAST) -> (case (_hdIppAST >-< _tlIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) sem_CImportL_Nil :: T_CImportL sem_CImportL_Nil = (\ _lhsIopts _lhsItr -> (case (empty) of { _lhsOppAST -> ( _lhsOppAST) })) -- CModule ----------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Mod: child moduleNm : {HsName} child exports : CExportL child imports : CImportL child declMetas : CDeclMetaL child expr : CExpr visit 0: local trppHere : _ -} -- cata sem_CModule :: CModule -> T_CModule sem_CModule (CModule_Mod _moduleNm _exports _imports _declMetas _expr) = (sem_CModule_Mod _moduleNm (sem_CExportL _exports) (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) -- semantic domain type T_CModule = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CModule_Mod :: HsName -> T_CExportL -> T_CImportL -> T_CDeclMetaL -> T_CExpr -> T_CModule sem_CModule_Mod moduleNm_ exports_ imports_ declMetas_ expr_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _exprOtr -> (case (_lhsIopts) of { _exprOopts -> (case (expr_ _exprOopts _exprOtr) of { ( _exprIppAST) -> (case (_lhsItr) of { _declMetasOtr -> (case (_lhsIopts) of { _declMetasOopts -> (case (declMetas_ _declMetasOopts _declMetasOtr) of { ( _declMetasIppAST) -> (case (_lhsItr) of { _importsOtr -> (case (_lhsIopts) of { _importsOopts -> (case (imports_ _importsOopts _importsOtr) of { ( _importsIppAST) -> (case (_lhsItr) of { _exportsOtr -> (case (_lhsIopts) of { _exportsOopts -> (case (exports_ _exportsOopts _exportsOtr) of { ( _exportsIppAST) -> (case (ppNestTrPP ["CModule","Mod"] [ppTrNm moduleNm_] [_exportsIppAST,_importsIppAST,_declMetasIppAST,_exprIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) }) }) }) }) }) }) })) -- CPat -------------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Var: child pnm : {HsName} visit 0: local trppHere : _ alternative Con: child tag : {CTag} child rest : CPatRest child binds : CPatFldL visit 0: local trppHere : _ alternative Int: child int : {Int} visit 0: local trppHere : _ alternative Char: child char : {Char} visit 0: local trppHere : _ alternative BoolExpr: child cexpr : {CExpr} visit 0: inst cexpr' : CExpr local trppHere : _ -} -- cata sem_CPat :: CPat -> T_CPat sem_CPat (CPat_Var _pnm) = (sem_CPat_Var _pnm) sem_CPat (CPat_Con _tag _rest _binds) = (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) sem_CPat (CPat_Int _int) = (sem_CPat_Int _int) sem_CPat (CPat_Char _char) = (sem_CPat_Char _char) sem_CPat (CPat_BoolExpr _cexpr) = (sem_CPat_BoolExpr _cexpr) -- semantic domain type T_CPat = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CPat_Var :: HsName -> T_CPat sem_CPat_Var pnm_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CPat","Var"] [ppTrNm pnm_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CPat_Con :: CTag -> T_CPatRest -> T_CPatFldL -> T_CPat sem_CPat_Con tag_ rest_ binds_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _bindsOtr -> (case (_lhsIopts) of { _bindsOopts -> (case (binds_ _bindsOopts _bindsOtr) of { ( _bindsIppAST) -> (case (_lhsItr) of { _restOtr -> (case (_lhsIopts) of { _restOopts -> (case (rest_ _restOopts _restOtr) of { ( _restIppAST) -> (case (ppNestTrPP ["CPat","Con"] [pp tag_] [_restIppAST, _bindsIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) })) sem_CPat_Int :: Int -> T_CPat sem_CPat_Int int_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CPat","Int"] [pp int_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CPat_Char :: Char -> T_CPat sem_CPat_Char char_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CPat","Char"] [pp char_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CPat_BoolExpr :: CExpr -> T_CPat sem_CPat_BoolExpr cexpr_ = (\ _lhsIopts _lhsItr -> (case (cexpr_) of { cexpr'_val_ -> (case ((sem_CExpr cexpr'_val_)) of { cexpr'_inst_ -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _cexpr'Otr -> (case (_lhsIopts) of { _cexpr'Oopts -> (case (cexpr'_inst_ _cexpr'Oopts _cexpr'Otr) of { ( _cexpr'IppAST) -> (case (ppNestTrPP ["CPat","BoolExpr"] [] [_cexpr'IppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) -- CPatFld ----------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Fld: child lbl : {HsName} child offset : CExpr child bind : CBind child fldAnns : CBindAnnL visit 0: local trppHere : _ -} -- cata sem_CPatFld :: CPatFld -> T_CPatFld sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) -- semantic domain type T_CPatFld = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CPatFld_Fld :: HsName -> T_CExpr -> T_CBind -> T_CBindAnnL -> T_CPatFld sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (_lhsItr) of { _fldAnnsOtr -> (case (_lhsIopts) of { _fldAnnsOopts -> (case (fldAnns_ _fldAnnsOopts _fldAnnsOtr) of { ( _fldAnnsIppAST) -> (case (_lhsItr) of { _bindOtr -> (case (_lhsIopts) of { _bindOopts -> (case (bind_ _bindOopts _bindOtr) of { ( _bindIppAST) -> (case (_lhsItr) of { _offsetOtr -> (case (_lhsIopts) of { _offsetOopts -> (case (offset_ _offsetOopts _offsetOtr) of { ( _offsetIppAST) -> (case (ppNestTrPP ["CPatFld","Fld"] [ppTrNm lbl_] [_offsetIppAST, _bindIppAST, _fldAnnsIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) }) }) }) }) })) -- CPatFldL ---------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Cons: child hd : CPatFld child tl : CPatFldL alternative Nil: -} -- cata sem_CPatFldL :: CPatFldL -> T_CPatFldL sem_CPatFldL list = (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) -- semantic domain type T_CPatFldL = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CPatFldL_Cons :: T_CPatFld -> T_CPatFldL -> T_CPatFldL sem_CPatFldL_Cons hd_ tl_ = (\ _lhsIopts _lhsItr -> (case (_lhsItr) of { _tlOtr -> (case (_lhsIopts) of { _tlOopts -> (case (tl_ _tlOopts _tlOtr) of { ( _tlIppAST) -> (case (_lhsItr) of { _hdOtr -> (case (_lhsIopts) of { _hdOopts -> (case (hd_ _hdOopts _hdOtr) of { ( _hdIppAST) -> (case (_hdIppAST >-< _tlIppAST) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }) })) sem_CPatFldL_Nil :: T_CPatFldL sem_CPatFldL_Nil = (\ _lhsIopts _lhsItr -> (case (empty) of { _lhsOppAST -> ( _lhsOppAST) })) -- CPatRest ---------------------------------------------------- {- visit 0: inherited attributes: opts : EHCOpts tr : TraceOn -> [PP_Doc] -> TrPP synthesized attribute: ppAST : PP_Doc alternatives: alternative Var: child nm : {HsName} visit 0: local trppHere : _ alternative Empty: visit 0: local trppHere : _ -} -- cata sem_CPatRest :: CPatRest -> T_CPatRest sem_CPatRest (CPatRest_Var _nm) = (sem_CPatRest_Var _nm) sem_CPatRest (CPatRest_Empty) = (sem_CPatRest_Empty) -- semantic domain type T_CPatRest = EHCOpts -> (TraceOn -> [PP_Doc] -> TrPP) -> ( PP_Doc) sem_CPatRest_Var :: HsName -> T_CPatRest sem_CPatRest_Var nm_ = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CPatRest","Var"] [ppTrNm nm_] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) sem_CPatRest_Empty :: T_CPatRest sem_CPatRest_Empty = (\ _lhsIopts _lhsItr -> (case (trppEmpty) of { _trppHere -> (case (ppNestTrPP ["CPatRest","Empty"] [] [] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) })) -- CodeAGItf --------------------------------------------------- {- visit 0: inherited attribute: opts : EHCOpts synthesized attribute: ppAST : PP_Doc alternatives: alternative AGItf: child module : CModule visit 0: local trppHere : _ local tr : _ -} -- cata sem_CodeAGItf :: CodeAGItf -> T_CodeAGItf sem_CodeAGItf (CodeAGItf_AGItf _module) = (sem_CodeAGItf_AGItf (sem_CModule _module)) -- semantic domain type T_CodeAGItf = EHCOpts -> ( PP_Doc) data Inh_CodeAGItf = Inh_CodeAGItf {opts_Inh_CodeAGItf :: !(EHCOpts)} data Syn_CodeAGItf = Syn_CodeAGItf {ppAST_Syn_CodeAGItf :: !(PP_Doc)} wrap_CodeAGItf :: T_CodeAGItf -> Inh_CodeAGItf -> Syn_CodeAGItf wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIopts) = (let ( _lhsOppAST) = sem _lhsIopts in (Syn_CodeAGItf _lhsOppAST)) sem_CodeAGItf_AGItf :: T_CModule -> T_CodeAGItf sem_CodeAGItf_AGItf module_ = (\ _lhsIopts -> (case (trppEmpty) of { _trppHere -> (case (trPP (`Set.member` ehcOptTraceOn _lhsIopts)) of { _tr -> (case (_tr) of { _moduleOtr -> (case (_lhsIopts) of { _moduleOopts -> (case (module_ _moduleOopts _moduleOtr) of { ( _moduleIppAST) -> (case (ppNestTrPP ["CodeAGItf","AGItf"] [] [_moduleIppAST] _trppHere) of { _lhsOppAST -> ( _lhsOppAST) }) }) }) }) }) }))