-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/ToCoreRun) module UHC.Light.Compiler.Core.ToCoreRun(cmod2CoreRun', cmod2CoreRunWithModNr, cmod2CoreRun) where import UHC.Light.Compiler.Base.Common import UHC.Light.Compiler.Base.TermLike import UHC.Light.Compiler.Opts import UHC.Light.Compiler.Ty import UHC.Light.Compiler.Core import Data.Maybe import qualified Data.Map as Map import Data.Char import UHC.Util.Utils import qualified UHC.Util.FastSeq as Seq import UHC.Light.Compiler.Base.HsName.Builtin import UHC.Light.Compiler.CodeGen.BuiltinSizeInfo import UHC.Light.Compiler.CodeGen.BuiltinPrims import UHC.Light.Compiler.CodeGen.BasicAnnot import qualified UHC.Light.Compiler.CoreRun as CR import qualified UHC.Light.Compiler.CoreRun.API as CR import qualified UHC.Light.Compiler.CoreRun.Prim as CR import UHC.Light.Compiler.Foreign.Extract cmod2CoreRun' :: EHCOpts -> Int -- sequence nr of module (offset), used to create global per module references -> CR.Nm2RefMp -- outer bindings -> CModule -> ( CR.Mod -- generated CoreRun , CR.Nm2RefMp -- name to ref mapping of toplevel bindings ) cmod2CoreRun' opts modNr nm2ref cmod = ( crm_Syn_CodeAGItf t , nm2refGath_Syn_CodeAGItf t ) where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) (Inh_CodeAGItf { modNr_Inh_CodeAGItf = modNr , opts_Inh_CodeAGItf = opts , nm2ref_Inh_CodeAGItf = nm2ref }) cmod2CoreRunWithModNr :: Int -> CModule -> CR.Mod cmod2CoreRunWithModNr nr m = m' where (m',_) = cmod2CoreRun' defaultEHCOpts nr Map.empty m cmod2CoreRun :: CModule -> CR.Mod cmod2CoreRun = cmod2CoreRunWithModNr 0 -- | What to do with binding in terms of thunking/forcing? data ToBe = ToBe_Thunked | ToBe_Forced | ToBe_LeftAsIs deriving Eq -- | Tail context data TailCtx = TailCtx_Plain | TailCtx_TailCall | TailCtx_CaseAlt tailCtxIsTailRec :: TailCtx -> Bool tailCtxIsTailRec TailCtx_TailCall = True tailCtxIsTailRec _ = False -- | Wrap according to tail context cseCtxWrap :: TailCtx -> CR.Exp -> CR.Exp cseCtxWrap TailCtx_TailCall = CR.mkTail cseCtxWrap _ = id -- | Construct application mkApp :: CR.Exp -> CR.CRArray CR.SExp -> CR.Exp mkApp f as = CR.mkApp' (CR.mkEval f) as -- | Wrap context saving if not at tail recursive position tailrec :: TailCtx -> CR.Exp -> CR.Exp tailrec tailCtx = if tailCtxIsTailRec tailCtx then id else id -- CR.Exp_Ret -- id -- | Wrap forcing if at tail recursive position taileval :: TailCtx -> CR.Exp -> CR.Exp taileval tailCtx = if tailCtxIsTailRec tailCtx then CR.mkEval else id -- CAlt -------------------------------------------------------- {- visit 0: chained attribute: refOffset : Int visit 1: inherited attributes: evalCtx : EvalCtx lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts scrutRef : CR.RRef tailCtx : TailCtx chained attribute: stackDepth : Int synthesized attributes: cra : [CR.Alt] refOffsetMax : Int stackDepthMax : Int alternatives: alternative Alt: child pat : CPat child expr : CExpr visit 1: local whatAbove : {WhatExpr} local nm2refNew : _ -} -- 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 = Int -> ( Int,T_CAlt_1) type T_CAlt_1 = EvalCtx -> Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> (CR.RRef) -> Int -> TailCtx -> ( ([CR.Alt]),Int,Int,Int) sem_CAlt_Alt :: T_CPat -> T_CExpr -> T_CAlt sem_CAlt_Alt pat_ expr_ = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CAlt_Alt_1 :: T_CAlt_1 sem_CAlt_Alt_1 = (\ _lhsIevalCtx _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIscrutRef _lhsIstackDepth _lhsItailCtx -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _exprOwhatAbove -> (case (_lhsItailCtx) of { _exprOtailCtx -> (case (_lhsImodNr) of { _exprOmodNr -> (case (_lhsIlev) of { _exprOlev -> (case (_lhsIstackDepth) of { _patOstackDepth -> (case (_lhsIrefOffset) of { _patOrefOffset -> (case (_lhsIopts) of { _patOopts -> (case (_lhsInm2ref) of { _patOnm2ref -> (case (_lhsImodNr) of { _patOmodNr -> (case (_lhsIlev) of { _patOlev -> (case (pat_ _patOlev _patOmodNr _patOnm2ref _patOopts _patOrefOffset _patOstackDepth) of { ( _patIcrp,_patIfldNmL,_patIrefOffset,_patIstackDepth) -> (case (Map.fromList [ (n, CR.RRef_Fld _lhsIscrutRef i) | (n,i) <- zip _patIfldNmL [0..] ]) of { _nm2refNew -> (case (_nm2refNew `Map.union` _lhsInm2ref) of { _exprOnm2ref -> (case (_lhsIstackDepth) of { _exprOstackDepth -> (case (_lhsIrefOffset) of { _exprOrefOffset -> (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_lhsIopts) of { _exprOopts -> (case (_lhsIevalCtx) of { _exprOevalCtx -> (case (True) of { _exprOisTopTup -> (case (True) of { _exprOisTopApp -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case ([CR.Alt_Alt (CR.nm2RefMpInverse _nm2refNew) _exprIcre]) of { _lhsOcra -> (case (max _exprIrefOffset _exprIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> (case (max _exprIstackDepth _exprIstackDepthMax) of { _lhsOstackDepthMax -> ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CAlt_Alt_1)) of { ( sem_CAlt_1) -> ( _lhsOrefOffset,sem_CAlt_1) }) })) -- CAltL ------------------------------------------------------- {- visit 0: chained attribute: refOffset : Int visit 1: inherited attributes: evalCtx : EvalCtx lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts scrutRef : CR.RRef tailCtx : TailCtx chained attribute: stackDepth : Int synthesized attributes: cra : [CR.Alt] refOffsetMax : Int stackDepthMax : Int 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 = Int -> ( Int,T_CAltL_1) type T_CAltL_1 = EvalCtx -> Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> (CR.RRef) -> Int -> TailCtx -> ( ([CR.Alt]),Int,Int,Int) sem_CAltL_Cons :: T_CAlt -> T_CAltL -> T_CAltL sem_CAltL_Cons hd_ tl_ = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _hdOrefOffset -> (case (hd_ _hdOrefOffset) of { ( _hdIrefOffset,hd_1) -> (case (_hdIrefOffset) of { _tlOrefOffset -> (case (tl_ _tlOrefOffset) of { ( _tlIrefOffset,tl_1) -> (case (_tlIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CAltL_Cons_1 :: T_CAltL_1 sem_CAltL_Cons_1 = (\ _lhsIevalCtx _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIscrutRef _lhsIstackDepth _lhsItailCtx -> (case (_lhsItailCtx) of { _tlOtailCtx -> (case (_lhsIstackDepth) of { _hdOstackDepth -> (case (_lhsItailCtx) of { _hdOtailCtx -> (case (_lhsIscrutRef) of { _hdOscrutRef -> (case (_lhsIopts) of { _hdOopts -> (case (_lhsInm2ref) of { _hdOnm2ref -> (case (_lhsImodNr) of { _hdOmodNr -> (case (_lhsIlev) of { _hdOlev -> (case (_lhsIevalCtx) of { _hdOevalCtx -> (case (hd_1 _hdOevalCtx _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOscrutRef _hdOstackDepth _hdOtailCtx) of { ( _hdIcra,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) -> (case (_hdIstackDepth) of { _tlOstackDepth -> (case (_lhsIscrutRef) of { _tlOscrutRef -> (case (_lhsInm2ref) of { _tlOnm2ref -> (case (_lhsImodNr) of { _tlOmodNr -> (case (_lhsIlev) of { _tlOlev -> (case (_lhsIopts) of { _tlOopts -> (case (_lhsIevalCtx) of { _tlOevalCtx -> (case (tl_1 _tlOevalCtx _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOscrutRef _tlOstackDepth _tlOtailCtx) of { ( _tlIcra,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) -> (case (_hdIcra ++ _tlIcra) of { _lhsOcra -> (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_tlIstackDepth) of { _lhsOstackDepth -> (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of { _lhsOstackDepthMax -> ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CAltL_Cons_1)) of { ( sem_CAltL_1) -> ( _lhsOrefOffset,sem_CAltL_1) }) }) }) }) }) })) sem_CAltL_Nil :: T_CAltL sem_CAltL_Nil = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CAltL_Nil_1 :: T_CAltL_1 sem_CAltL_Nil_1 = (\ _lhsIevalCtx _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIscrutRef _lhsIstackDepth _lhsItailCtx -> (case ([]) of { _lhsOcra -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> (case (0) of { _lhsOstackDepthMax -> ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) })) in sem_CAltL_Nil_1)) of { ( sem_CAltL_1) -> ( _lhsOrefOffset,sem_CAltL_1) }) })) -- CBind ------------------------------------------------------- {- visit 0: inherited attributes: isGlobal : Bool lev : Int modNr : Int chained attribute: refOffset : Int synthesized attributes: nm : HsName nm2refGath : CR.Nm2RefMp visit 1: inherited attributes: evalCtx : EvalCtx letBindingsCateg : CBindCateg nm2ref : CR.Nm2RefMp opts : EHCOpts chained attribute: stackDepth : Int synthesized attributes: crb : [(HsName, CR.Bind)] refOffsetMax : Int stackDepthMax : Int alternatives: alternative Bind: child nm : {HsName} child bindAspects : CBoundL visit 0: local ref : _ local nm2refGath : _ local refOffsetHere : _ visit 1: local crb : _ -} -- cata sem_CBind :: CBind -> T_CBind sem_CBind (CBind_Bind _nm _bindAspects) = (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) -- semantic domain type T_CBind = Bool -> Int -> Int -> Int -> ( HsName,(CR.Nm2RefMp),Int,T_CBind_1) type T_CBind_1 = EvalCtx -> CBindCateg -> (CR.Nm2RefMp) -> EHCOpts -> Int -> ( ([(HsName, CR.Bind)]),Int,Int,Int) sem_CBind_Bind :: HsName -> T_CBoundL -> T_CBind sem_CBind_Bind nm_ bindAspects_ = (\ _lhsIisGlobal _lhsIlev _lhsImodNr _lhsIrefOffset -> (case (nm_) of { _lhsOnm -> (case (if _lhsIisGlobal then CR.RRef_Glb _lhsImodNr _lhsIrefOffset else CR.RRef_Loc _lhsIlev _lhsIrefOffset) of { _ref -> (case (Map.singleton nm_ _ref) of { _nm2refGath -> (case (_nm2refGath) of { _lhsOnm2refGath -> (case (_lhsIrefOffset + 1) of { _refOffsetHere -> (case (_refOffsetHere) of { _lhsOrefOffset -> (case ((let sem_CBind_Bind_1 :: T_CBind_1 sem_CBind_Bind_1 = (\ _lhsIevalCtx _lhsIletBindingsCateg _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _bindAspectsOstackDepth -> (case (_lhsIrefOffset) of { _bindAspectsOrefOffset -> (case (_lhsInm2ref) of { _bindAspectsOnm2ref -> (case (_lhsImodNr) of { _bindAspectsOmodNr -> (case (_lhsIlev) of { _bindAspectsOlev -> (case (_lhsIisGlobal) of { _bindAspectsOisGlobal -> (case (_lhsIevalCtx) of { _bindAspectsOevalCtx -> (case (nm_) of { _bindAspectsOnm -> (case (_lhsIopts) of { _bindAspectsOopts -> (case (_lhsIletBindingsCateg) of { _bindAspectsOletBindingsCateg -> (case (bindAspects_ _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOmodNr _bindAspectsOnm _bindAspectsOnm2ref _bindAspectsOopts _bindAspectsOrefOffset _bindAspectsOstackDepth) of { ( _bindAspectsIcrb,_bindAspectsInm2refGath,_bindAspectsIrefOffset,_bindAspectsIrefOffsetMax,_bindAspectsIstackDepth,_bindAspectsIstackDepthMax) -> (case (take 1 _bindAspectsIcrb) of { _crb -> (case (_crb) of { _lhsOcrb -> (case (_bindAspectsIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_bindAspectsIstackDepth) of { _lhsOstackDepth -> (case (_bindAspectsIstackDepthMax) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CBind_Bind_1)) of { ( sem_CBind_1) -> ( _lhsOnm,_lhsOnm2refGath,_lhsOrefOffset,sem_CBind_1) }) }) }) }) }) }) })) -- CBindAnn ---------------------------------------------------- {- visit 0: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attributes: refOffset : Int stackDepth : Int alternatives: alternative Coe: child coe : {RelevCoe} -} -- cata sem_CBindAnn :: CBindAnn -> T_CBindAnn sem_CBindAnn (CBindAnn_Coe _coe) = (sem_CBindAnn_Coe _coe) -- semantic domain type T_CBindAnn = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> Int -> ( Int,Int) sem_CBindAnn_Coe :: RelevCoe -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOrefOffset,_lhsOstackDepth) }) })) -- CBindAnnL --------------------------------------------------- {- visit 0: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attributes: refOffset : Int stackDepth : Int 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 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> Int -> ( Int,Int) sem_CBindAnnL_Cons :: T_CBindAnn -> T_CBindAnnL -> T_CBindAnnL sem_CBindAnnL_Cons hd_ tl_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (_lhsIrefOffset) of { _hdOrefOffset -> (case (_lhsIstackDepth) of { _hdOstackDepth -> (case (_lhsIopts) of { _hdOopts -> (case (_lhsInm2ref) of { _hdOnm2ref -> (case (_lhsImodNr) of { _hdOmodNr -> (case (_lhsIlev) of { _hdOlev -> (case (hd_ _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOrefOffset _hdOstackDepth) of { ( _hdIrefOffset,_hdIstackDepth) -> (case (_hdIrefOffset) of { _tlOrefOffset -> (case (_hdIstackDepth) of { _tlOstackDepth -> (case (_lhsIopts) of { _tlOopts -> (case (_lhsInm2ref) of { _tlOnm2ref -> (case (_lhsImodNr) of { _tlOmodNr -> (case (_lhsIlev) of { _tlOlev -> (case (tl_ _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of { ( _tlIrefOffset,_tlIstackDepth) -> (case (_tlIrefOffset) of { _lhsOrefOffset -> (case (_tlIstackDepth) of { _lhsOstackDepth -> ( _lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_CBindAnnL_Nil :: T_CBindAnnL sem_CBindAnnL_Nil = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOrefOffset,_lhsOstackDepth) }) })) -- CBindL ------------------------------------------------------ {- visit 0: inherited attributes: isGlobal : Bool lev : Int modNr : Int chained attribute: refOffset : Int synthesized attribute: nm2refGath : CR.Nm2RefMp visit 1: inherited attributes: evalCtx : EvalCtx letBindingsCateg : CBindCateg nm2ref : CR.Nm2RefMp opts : EHCOpts chained attribute: stackDepth : Int synthesized attributes: crb : [(HsName, CR.Bind)] refOffsetMax : Int stackDepthMax : Int 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 = Bool -> Int -> Int -> Int -> ( (CR.Nm2RefMp),Int,T_CBindL_1) type T_CBindL_1 = EvalCtx -> CBindCateg -> (CR.Nm2RefMp) -> EHCOpts -> Int -> ( ([(HsName, CR.Bind)]),Int,Int,Int) sem_CBindL_Cons :: T_CBind -> T_CBindL -> T_CBindL sem_CBindL_Cons hd_ tl_ = (\ _lhsIisGlobal _lhsIlev _lhsImodNr _lhsIrefOffset -> (case (_lhsIrefOffset) of { _hdOrefOffset -> (case (_lhsImodNr) of { _hdOmodNr -> (case (_lhsIlev) of { _hdOlev -> (case (_lhsIisGlobal) of { _hdOisGlobal -> (case (hd_ _hdOisGlobal _hdOlev _hdOmodNr _hdOrefOffset) of { ( _hdInm,_hdInm2refGath,_hdIrefOffset,hd_1) -> (case (_hdIrefOffset) of { _tlOrefOffset -> (case (_lhsImodNr) of { _tlOmodNr -> (case (_lhsIlev) of { _tlOlev -> (case (_lhsIisGlobal) of { _tlOisGlobal -> (case (tl_ _tlOisGlobal _tlOlev _tlOmodNr _tlOrefOffset) of { ( _tlInm2refGath,_tlIrefOffset,tl_1) -> (case (_hdInm2refGath `Map.union` _tlInm2refGath) of { _lhsOnm2refGath -> (case (_tlIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CBindL_Cons_1 :: T_CBindL_1 sem_CBindL_Cons_1 = (\ _lhsIevalCtx _lhsIletBindingsCateg _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _hdOstackDepth -> (case (_lhsIevalCtx) of { _hdOevalCtx -> (case (_lhsIopts) of { _hdOopts -> (case (_lhsInm2ref) of { _hdOnm2ref -> (case (_lhsIletBindingsCateg) of { _hdOletBindingsCateg -> (case (hd_1 _hdOevalCtx _hdOletBindingsCateg _hdOnm2ref _hdOopts _hdOstackDepth) of { ( _hdIcrb,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) -> (case (_hdIstackDepth) of { _tlOstackDepth -> (case (_lhsInm2ref) of { _tlOnm2ref -> (case (_lhsIevalCtx) of { _tlOevalCtx -> (case (_lhsIopts) of { _tlOopts -> (case (_lhsIletBindingsCateg) of { _tlOletBindingsCateg -> (case (tl_1 _tlOevalCtx _tlOletBindingsCateg _tlOnm2ref _tlOopts _tlOstackDepth) of { ( _tlIcrb,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) -> (case (_hdIcrb ++ _tlIcrb) of { _lhsOcrb -> (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_tlIstackDepth) of { _lhsOstackDepth -> (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CBindL_Cons_1)) of { ( sem_CBindL_1) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBindL_1) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_CBindL_Nil :: T_CBindL sem_CBindL_Nil = (\ _lhsIisGlobal _lhsIlev _lhsImodNr _lhsIrefOffset -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CBindL_Nil_1 :: T_CBindL_1 sem_CBindL_Nil_1 = (\ _lhsIevalCtx _lhsIletBindingsCateg _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case ([]) of { _lhsOcrb -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> (case (0) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) })) in sem_CBindL_Nil_1)) of { ( sem_CBindL_1) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBindL_1) }) }) })) -- CBound ------------------------------------------------------ {- visit 0: inherited attributes: evalCtx : EvalCtx isGlobal : Bool lev : Int modNr : Int nm : HsName chained attribute: refOffset : Int synthesized attribute: nm2refGath : CR.Nm2RefMp visit 1: inherited attributes: isTopApp : Bool isTopTup : Bool letBindingsCateg : CBindCateg nm2ref : CR.Nm2RefMp opts : EHCOpts chained attribute: stackDepth : Int synthesized attributes: crb : [(HsName, CR.Bind)] refOffsetMax : Int stackDepthMax : Int alternatives: alternative Bind: child bindMeta : CMetas child expr : CExpr visit 0: local whatAbove : {WhatExpr} local toBe : _ local isToBeThunked : _ local lev : _ local refOffsetExpr : _ visit 1: local tailCtx : _ local nm2refNew : _ local isToBeALam : _ local stackDepthMaxThunked : _ local creMkForce : _ local creBind : _ local crb : _ local stackDepthExpr : _ intra isToBeThunked : _ intra toBe : _ alternative Meta: child aspectKeyS : {ACoreBindAspectKeyS} child cmetas : CMetas alternative RelevTy: child aspectKeyS : {ACoreBindAspectKeyS} child relevTy : {RelevTy} alternative Val: child aspectKeyS : {ACoreBindAspectKeyS} child mlev : {MetaLev} child lbl : {CLbl} child expr : CExpr visit 0: local whatAbove : {WhatExpr} local toBe : _ local isToBeThunked : _ local lev : _ local refOffsetExpr : _ visit 1: local tailCtx : _ local nm2refNew : _ local isToBeALam : _ local stackDepthMaxThunked : _ local creMkForce : _ local creBind : _ local crb : _ local stackDepthExpr : _ intra isToBeThunked : _ intra toBe : _ alternative Ty: child aspectKeyS : {ACoreBindAspectKeyS} child ty : {Ty} alternative FFE: child callconv : {FFIWay} child expEnt : {ForeignEnt} child expr : CExpr child ty : {Ty} visit 0: local whatAbove : {WhatExpr} visit 1: local tailCtx : _ -} -- cata sem_CBound :: CBound -> T_CBound sem_CBound (CBound_Bind _bindMeta _expr) = (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) sem_CBound (CBound_Meta _aspectKeyS _cmetas) = (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = (sem_CBound_RelevTy _aspectKeyS _relevTy) 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 = EvalCtx -> Bool -> Int -> Int -> HsName -> Int -> ( (CR.Nm2RefMp),Int,T_CBound_1) type T_CBound_1 = Bool -> Bool -> CBindCateg -> (CR.Nm2RefMp) -> EHCOpts -> Int -> ( ([(HsName, CR.Bind)]),Int,Int,Int) sem_CBound_Bind :: T_CMetas -> T_CExpr -> T_CBound sem_CBound_Bind bindMeta_ expr_ = (\ _lhsIevalCtx _lhsIisGlobal _lhsIlev _lhsImodNr _lhsInm _lhsIrefOffset -> (case (ExprIsBind _lhsInm) of { _whatAbove -> (case (_whatAbove) of { _exprOwhatAbove -> (case (_lhsImodNr) of { _exprOmodNr -> (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (let mba@(~(Just (_,w))) = whatExprMbApp _exprIwhatBelow isVar = isJust $ whatExprMbVar _exprIwhatBelow isGlbVar = isVar && _lhsIisGlobal isApp = isJust mba isTup = isApp && whatExprIsTup w isWHNF = whatExprIsWHNF _exprIwhatBelow isNotWHNF = not isWHNF in case _lhsIevalCtx of EvalCtx_Eval | isApp -> ToBe_LeftAsIs | isVar -> ToBe_Forced | isNotWHNF -> ToBe_Forced EvalCtx_Thunk | isTup -> ToBe_LeftAsIs | isGlbVar -> ToBe_Thunked | isNotWHNF -> ToBe_Thunked _ -> ToBe_LeftAsIs) of { _toBe -> (case (_toBe == ToBe_Thunked) of { _isToBeThunked -> (case (if _isToBeThunked then _lhsIlev + 1 else _lhsIlev) of { _lev -> (case (_lev) of { _exprOlev -> (case (if _isToBeThunked then 0 else _lhsIrefOffset) of { _refOffsetExpr -> (case (_refOffsetExpr) of { _exprOrefOffset -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_exprInm2refGath) of { _lhsOnm2refGath -> (case (if _isToBeThunked then _lhsIrefOffset else _exprIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CBound_Bind_1 :: T_CBound_1 sem_CBound_Bind_1 = (\ _lhsIisTopApp _lhsIisTopTup _lhsIletBindingsCateg _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (if _isToBeThunked then TailCtx_TailCall else TailCtx_Plain) of { _tailCtx -> (case (_tailCtx) of { _exprOtailCtx -> (case (_lhsInm2ref) of { _exprOnm2ref -> (case (if _isToBeThunked then _exprInm2refGath else Map.empty) of { _nm2refNew -> (case (_isToBeThunked || whatExprIsLam _exprIwhatBelow) of { _isToBeALam -> (case (if _isToBeALam then 0 else _lhsIstackDepth) of { _exprOstackDepth -> (case (_lhsIopts) of { _exprOopts -> (case (_lhsIevalCtx) of { _exprOevalCtx -> (case (True) of { _exprOisTopTup -> (case (True) of { _exprOisTopApp -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case (max _exprIstackDepth _exprIstackDepthMax) of { _stackDepthMaxThunked -> (case (case _toBe of ToBe_Forced -> tailrec _tailCtx . CR.mkEval ToBe_Thunked -> CR.Exp_Lam (Just _lhsInm) 0 (_stackDepthMaxThunked) (CR.nm2RefMpInverse _nm2refNew) ToBe_LeftAsIs -> id) of { _creMkForce -> (case (_creMkForce _exprIcre) of { _creBind -> (case ([( _lhsInm, _creBind )]) of { _crb -> (case (_crb) of { _lhsOcrb -> (case (if _isToBeThunked then _lhsIrefOffset else max _exprIrefOffset _exprIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (if _isToBeALam then _lhsIstackDepth+1 else _exprIstackDepth) of { _stackDepthExpr -> (case (_stackDepthExpr) of { _lhsOstackDepth -> (case (if _isToBeALam then _stackDepthExpr else _stackDepthMaxThunked) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CBound_Bind_1)) of { ( sem_CBound_1) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_CBound_Meta :: ACoreBindAspectKeyS -> T_CMetas -> T_CBound sem_CBound_Meta aspectKeyS_ cmetas_ = (\ _lhsIevalCtx _lhsIisGlobal _lhsIlev _lhsImodNr _lhsInm _lhsIrefOffset -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _cmetasOrefOffset -> (case (cmetas_ _cmetasOrefOffset) of { ( _cmetasIrefOffset,cmetas_1) -> (case (_cmetasIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CBound_Meta_1 :: T_CBound_1 sem_CBound_Meta_1 = (\ _lhsIisTopApp _lhsIisTopTup _lhsIletBindingsCateg _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case ([]) of { _lhsOcrb -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth) of { _cmetasOstackDepth -> (case (_lhsIopts) of { _cmetasOopts -> (case (_lhsInm2ref) of { _cmetasOnm2ref -> (case (_lhsImodNr) of { _cmetasOmodNr -> (case (_lhsIlev) of { _cmetasOlev -> (case (cmetas_1 _cmetasOlev _cmetasOmodNr _cmetasOnm2ref _cmetasOopts _cmetasOstackDepth) of { ( _cmetasIstackDepth) -> (case (_cmetasIstackDepth) of { _lhsOstackDepth -> (case (0) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) })) in sem_CBound_Meta_1)) of { ( sem_CBound_1) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) })) sem_CBound_RelevTy :: ACoreBindAspectKeyS -> RelevTy -> T_CBound sem_CBound_RelevTy aspectKeyS_ relevTy_ = (\ _lhsIevalCtx _lhsIisGlobal _lhsIlev _lhsImodNr _lhsInm _lhsIrefOffset -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CBound_RelevTy_1 :: T_CBound_1 sem_CBound_RelevTy_1 = (\ _lhsIisTopApp _lhsIisTopTup _lhsIletBindingsCateg _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case ([]) of { _lhsOcrb -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> (case (0) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) })) in sem_CBound_RelevTy_1)) of { ( sem_CBound_1) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) })) sem_CBound_Val :: ACoreBindAspectKeyS -> MetaLev -> CLbl -> T_CExpr -> T_CBound sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = (\ _lhsIevalCtx _lhsIisGlobal _lhsIlev _lhsImodNr _lhsInm _lhsIrefOffset -> (case (ExprIsBind _lhsInm) of { _whatAbove -> (case (_whatAbove) of { _exprOwhatAbove -> (case (_lhsImodNr) of { _exprOmodNr -> (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (let mba@(~(Just (_,w))) = whatExprMbApp _exprIwhatBelow isVar = isJust $ whatExprMbVar _exprIwhatBelow isGlbVar = isVar && _lhsIisGlobal isApp = isJust mba isTup = isApp && whatExprIsTup w isWHNF = whatExprIsWHNF _exprIwhatBelow isNotWHNF = not isWHNF in case _lhsIevalCtx of EvalCtx_Eval | isApp -> ToBe_LeftAsIs | isVar -> ToBe_Forced | isNotWHNF -> ToBe_Forced EvalCtx_Thunk | isTup -> ToBe_LeftAsIs | isGlbVar -> ToBe_Thunked | isNotWHNF -> ToBe_Thunked _ -> ToBe_LeftAsIs) of { _toBe -> (case (_toBe == ToBe_Thunked) of { _isToBeThunked -> (case (if _isToBeThunked then _lhsIlev + 1 else _lhsIlev) of { _lev -> (case (_lev) of { _exprOlev -> (case (if _isToBeThunked then 0 else _lhsIrefOffset) of { _refOffsetExpr -> (case (_refOffsetExpr) of { _exprOrefOffset -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_exprInm2refGath) of { _lhsOnm2refGath -> (case (if _isToBeThunked then _lhsIrefOffset else _exprIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CBound_Val_1 :: T_CBound_1 sem_CBound_Val_1 = (\ _lhsIisTopApp _lhsIisTopTup _lhsIletBindingsCateg _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (if _isToBeThunked then TailCtx_TailCall else TailCtx_Plain) of { _tailCtx -> (case (_tailCtx) of { _exprOtailCtx -> (case (_lhsInm2ref) of { _exprOnm2ref -> (case (if _isToBeThunked then _exprInm2refGath else Map.empty) of { _nm2refNew -> (case (_isToBeThunked || whatExprIsLam _exprIwhatBelow) of { _isToBeALam -> (case (if _isToBeALam then 0 else _lhsIstackDepth) of { _exprOstackDepth -> (case (_lhsIopts) of { _exprOopts -> (case (_lhsIisTopTup) of { _exprOisTopTup -> (case (_lhsIisTopApp) of { _exprOisTopApp -> (case (_lhsIevalCtx) of { _exprOevalCtx -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case (max _exprIstackDepth _exprIstackDepthMax) of { _stackDepthMaxThunked -> (case (case _toBe of ToBe_Forced -> tailrec _tailCtx . CR.mkEval ToBe_Thunked -> CR.Exp_Lam (Just _lhsInm) 0 (_stackDepthMaxThunked) (CR.nm2RefMpInverse _nm2refNew) ToBe_LeftAsIs -> id) of { _creMkForce -> (case (_creMkForce _exprIcre) of { _creBind -> (case ([( _lhsInm, _creBind )]) of { _crb -> (case (_crb) of { _lhsOcrb -> (case (if _isToBeThunked then _lhsIrefOffset else max _exprIrefOffset _exprIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (if _isToBeALam then _lhsIstackDepth+1 else _exprIstackDepth) of { _stackDepthExpr -> (case (_stackDepthExpr) of { _lhsOstackDepth -> (case (if _isToBeALam then _stackDepthExpr else _stackDepthMaxThunked) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CBound_Val_1)) of { ( sem_CBound_1) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_CBound_Ty :: ACoreBindAspectKeyS -> Ty -> T_CBound sem_CBound_Ty aspectKeyS_ ty_ = (\ _lhsIevalCtx _lhsIisGlobal _lhsIlev _lhsImodNr _lhsInm _lhsIrefOffset -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CBound_Ty_1 :: T_CBound_1 sem_CBound_Ty_1 = (\ _lhsIisTopApp _lhsIisTopTup _lhsIletBindingsCateg _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case ([]) of { _lhsOcrb -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> (case (0) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) })) in sem_CBound_Ty_1)) of { ( sem_CBound_1) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) })) sem_CBound_FFE :: FFIWay -> ForeignEnt -> T_CExpr -> Ty -> T_CBound sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = (\ _lhsIevalCtx _lhsIisGlobal _lhsIlev _lhsImodNr _lhsInm _lhsIrefOffset -> (case (ExprIsLam 0 Nothing) of { _whatAbove -> (case (_whatAbove) of { _exprOwhatAbove -> (case (_lhsIrefOffset) of { _exprOrefOffset -> (case (_lhsImodNr) of { _exprOmodNr -> (case (_lhsIlev) of { _exprOlev -> (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_exprInm2refGath) of { _lhsOnm2refGath -> (case (_exprIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CBound_FFE_1 :: T_CBound_1 sem_CBound_FFE_1 = (\ _lhsIisTopApp _lhsIisTopTup _lhsIletBindingsCateg _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _exprOstackDepth -> (case (_lhsInm2ref) of { _exprOnm2ref -> (case (TailCtx_Plain) of { _tailCtx -> (case (_tailCtx) of { _exprOtailCtx -> (case (_lhsIopts) of { _exprOopts -> (case (_lhsIevalCtx) of { _exprOevalCtx -> (case (True) of { _exprOisTopTup -> (case (True) of { _exprOisTopApp -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case (_exprIcrb) of { _lhsOcrb -> (case (_exprIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_exprIstackDepth) of { _lhsOstackDepth -> (case (_exprIstackDepthMax) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CBound_FFE_1)) of { ( sem_CBound_1) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) })) -- CBoundL ----------------------------------------------------- {- visit 0: inherited attributes: evalCtx : EvalCtx isGlobal : Bool letBindingsCateg : CBindCateg lev : Int modNr : Int nm : HsName nm2ref : CR.Nm2RefMp opts : EHCOpts chained attributes: refOffset : Int stackDepth : Int synthesized attributes: crb : [(HsName, CR.Bind)] nm2refGath : CR.Nm2RefMp refOffsetMax : Int stackDepthMax : Int 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 = EvalCtx -> Bool -> CBindCateg -> Int -> Int -> HsName -> (CR.Nm2RefMp) -> EHCOpts -> Int -> Int -> ( ([(HsName, CR.Bind)]),(CR.Nm2RefMp),Int,Int,Int,Int) sem_CBoundL_Cons :: T_CBound -> T_CBoundL -> T_CBoundL sem_CBoundL_Cons hd_ tl_ = (\ _lhsIevalCtx _lhsIisGlobal _lhsIletBindingsCateg _lhsIlev _lhsImodNr _lhsInm _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (_lhsIstackDepth) of { _hdOstackDepth -> (case (_lhsIrefOffset) of { _hdOrefOffset -> (case (_lhsInm) of { _hdOnm -> (case (_lhsIlev) of { _hdOlev -> (case (_lhsIisGlobal) of { _hdOisGlobal -> (case (_lhsIevalCtx) of { _hdOevalCtx -> (case (_lhsImodNr) of { _hdOmodNr -> (case (hd_ _hdOevalCtx _hdOisGlobal _hdOlev _hdOmodNr _hdOnm _hdOrefOffset) of { ( _hdInm2refGath,_hdIrefOffset,hd_1) -> (case (_lhsIopts) of { _hdOopts -> (case (_lhsInm2ref) of { _hdOnm2ref -> (case (_lhsIletBindingsCateg) of { _hdOletBindingsCateg -> (case (True) of { _hdOisTopTup -> (case (True) of { _hdOisTopApp -> (case (hd_1 _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOnm2ref _hdOopts _hdOstackDepth) of { ( _hdIcrb,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) -> (case (_hdIstackDepth) of { _tlOstackDepth -> (case (_hdIrefOffset) of { _tlOrefOffset -> (case (_lhsInm2ref) of { _tlOnm2ref -> (case (_lhsInm) of { _tlOnm -> (case (_lhsImodNr) of { _tlOmodNr -> (case (_lhsIlev) of { _tlOlev -> (case (_lhsIisGlobal) of { _tlOisGlobal -> (case (_lhsIevalCtx) of { _tlOevalCtx -> (case (_lhsIopts) of { _tlOopts -> (case (_lhsIletBindingsCateg) of { _tlOletBindingsCateg -> (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOmodNr _tlOnm _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of { ( _tlIcrb,_tlInm2refGath,_tlIrefOffset,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) -> (case (_hdIcrb ++ _tlIcrb) of { _lhsOcrb -> (case (_hdInm2refGath `Map.union` _tlInm2refGath) of { _lhsOnm2refGath -> (case (_tlIrefOffset) of { _lhsOrefOffset -> (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_tlIstackDepth) of { _lhsOstackDepth -> (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOnm2refGath,_lhsOrefOffset,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_CBoundL_Nil :: T_CBoundL sem_CBoundL_Nil = (\ _lhsIevalCtx _lhsIisGlobal _lhsIletBindingsCateg _lhsIlev _lhsImodNr _lhsInm _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case ([]) of { _lhsOcrb -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> (case (0) of { _lhsOstackDepthMax -> ( _lhsOcrb,_lhsOnm2refGath,_lhsOrefOffset,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) })) -- CDataCon ---------------------------------------------------- {- visit 0: synthesized attribute: crdc : [CR.DataCon] alternatives: alternative Con: child conNm : {HsName} child tagNr : {Int} child arity : {Int} -} -- cata sem_CDataCon :: CDataCon -> T_CDataCon sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = (sem_CDataCon_Con _conNm _tagNr _arity) -- semantic domain type T_CDataCon = ( ([CR.DataCon])) sem_CDataCon_Con :: HsName -> Int -> Int -> T_CDataCon sem_CDataCon_Con conNm_ tagNr_ arity_ = (case ([CR.DataCon_Con (hsnQualified conNm_) tagNr_]) of { _lhsOcrdc -> ( _lhsOcrdc) }) -- CDataConL --------------------------------------------------- {- visit 0: synthesized attribute: crdc : [CR.DataCon] 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 = ( ([CR.DataCon])) sem_CDataConL_Cons :: T_CDataCon -> T_CDataConL -> T_CDataConL sem_CDataConL_Cons hd_ tl_ = (case (tl_) of { ( _tlIcrdc) -> (case (hd_) of { ( _hdIcrdc) -> (case (_hdIcrdc ++ _tlIcrdc) of { _lhsOcrdc -> ( _lhsOcrdc) }) }) }) sem_CDataConL_Nil :: T_CDataConL sem_CDataConL_Nil = (case ([]) of { _lhsOcrdc -> ( _lhsOcrdc) }) -- CDeclMeta --------------------------------------------------- {- visit 0: synthesized attribute: crmt : [CR.Meta] alternatives: alternative Data: child tyNm : {HsName} child dataCons : CDataConL -} -- cata sem_CDeclMeta :: CDeclMeta -> T_CDeclMeta sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) -- semantic domain type T_CDeclMeta = ( ([CR.Meta])) sem_CDeclMeta_Data :: HsName -> T_CDataConL -> T_CDeclMeta sem_CDeclMeta_Data tyNm_ dataCons_ = (case (dataCons_) of { ( _dataConsIcrdc) -> (case ([CR.Meta_Data tyNm_ _dataConsIcrdc]) of { _lhsOcrmt -> ( _lhsOcrmt) }) }) -- CDeclMetaL -------------------------------------------------- {- visit 0: synthesized attribute: crmt : [CR.Meta] 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 = ( ([CR.Meta])) sem_CDeclMetaL_Cons :: T_CDeclMeta -> T_CDeclMetaL -> T_CDeclMetaL sem_CDeclMetaL_Cons hd_ tl_ = (case (tl_) of { ( _tlIcrmt) -> (case (hd_) of { ( _hdIcrmt) -> (case (_hdIcrmt ++ _tlIcrmt) of { _lhsOcrmt -> ( _lhsOcrmt) }) }) }) sem_CDeclMetaL_Nil :: T_CDeclMetaL sem_CDeclMetaL_Nil = (case ([]) of { _lhsOcrmt -> ( _lhsOcrmt) }) -- CExport ----------------------------------------------------- {- alternatives: alternative Export: child nm : {HsName} alternative ExportData: child nm : {HsName} child mbConNmL : {Maybe [HsName]} -} -- 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 = ( ) sem_CExport_Export :: HsName -> T_CExport sem_CExport_Export nm_ = ( ) sem_CExport_ExportData :: HsName -> (Maybe [HsName]) -> T_CExport sem_CExport_ExportData nm_ mbConNmL_ = ( ) -- CExportL ---------------------------------------------------- {- 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 = ( ) sem_CExportL_Cons :: T_CExport -> T_CExportL -> T_CExportL sem_CExportL_Cons hd_ tl_ = ( ) sem_CExportL_Nil :: T_CExportL sem_CExportL_Nil = ( ) -- CExpr ------------------------------------------------------- {- visit 0: synthesized attribute: whatBelow : WhatExpr visit 1: inherited attributes: lev : Int modNr : Int whatAbove : WhatExpr chained attribute: refOffset : Int synthesized attribute: nm2refGath : CR.Nm2RefMp visit 2: inherited attributes: evalCtx : EvalCtx isTopApp : Bool isTopTup : Bool nm2ref : CR.Nm2RefMp opts : EHCOpts tailCtx : TailCtx chained attribute: stackDepth : Int synthesized attributes: appFunKind : AppFunKind crb : [(HsName, CR.Bind)] cre : CR.Exp creAppArgL : [CR.SExp] creAppFun : TailCtx -> CR.CRArray CR.SExp -> CR.Exp creLamArgL : [HsName] creLamBody : CR.Exp crse : CR.SExp mbFFIApp : Maybe ( Ty , Bool , FFIWay , ForeignEnt , [Ty] ) mbLam : Maybe [HsName] mbVar : Maybe HsName refOffsetMax : Int stackDepthMax : Int vref : CR.RRef alternatives: alternative Var: child ref : {ACoreBindRef} visit 0: local nm : {HsName} local whatBelow : _ visit 1: intra nm : {HsName} visit 2: local vref : _ local crse : _ local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local mbVar : {Maybe HsName} local stackDepthHere : _ intra nm : {HsName} alternative Int: child int : {Int} visit 0: local whatBelow : _ visit 2: local crse : _ local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local stackDepthHere : _ local vref : _ alternative Char: child char : {Char} visit 0: local whatBelow : _ visit 2: local crse : _ local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local stackDepthHere : _ local vref : _ alternative String: child str : {String} visit 0: local whatBelow : _ visit 2: local crse : _ local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local stackDepthHere : _ local vref : _ alternative Integer: child integer : {Integer} visit 0: local whatBelow : _ visit 2: local crse : _ local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local stackDepthHere : _ local vref : _ alternative Tup: child tag : {CTag} visit 0: local whatBelow : _ visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local stackDepthHere : _ local vref : _ alternative Let: child categ : {CBindCateg} child binds : CBindL child body : CExpr visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} local isGlobal : _ local _tup1 : _ visit 2: local evalCtx : _ local letBindingsCateg : _ local _tup2 : _ local isTopTup : _ local isTopApp : {Bool} local nm2refNew : _ local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local refOffsetMax : _ local stackDepthMax : _ local vref : _ intra isGlobal : _ intra _tup1 : _ alternative App: child func : CExpr child arg : CBound visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} local isGlobal : _ visit 2: local tailCtx : _ local isTopTup : _ local creAppFun : _ local stackDepthFunc : _ local letBindingsCateg : _ local creAppArgL : _ local isTopApp' : _ local creBase : _ local cre : _ local creLamArgL : _ local creLamBody : _ local crse : _ local stackDepthMax : _ local vref : _ alternative Lam: child bind : CBind child body : CExpr visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} local isTopLam : _ local lev : _ local _tup3 : _ local refOffsetBody : _ local refOffset : _ local isGlobal : _ local nm2refNew : _ visit 2: local nm2ref : _ local isTopTup : _ local isTopApp : {Bool} local creLamArgL : _ local stackDepthMax : _ local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamBody : _ local crse : _ local argNm : _ local refOffsetMax : _ local vref : _ intra nm2refNew : _ intra isTopLam : _ intra refOffsetBody : _ alternative Case: child expr : CExpr child alts : CAltL child dflt : CExpr visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} visit 2: local isTopTup : _ local isTopApp : {Bool} local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local stackDepthHere : _ local stackDepthMax : _ local vref : _ alternative CaseAltFail: child failReason : {CaseAltFailReason} child errorExpr : CExpr visit 1: local whatAbove : {WhatExpr} visit 2: local isTopTup : _ local isTopApp : {Bool} local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local stackDepthHere : _ local vref : _ alternative TupDel: child expr : CExpr child tag : {CTag} child nm : {HsName} child offset : CExpr visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local isTopApp : {Bool} local isTopTup : _ local stackDepthHere : _ local vref : _ alternative TupIns: child expr : CExpr child tag : {CTag} child nm : {HsName} child offset : CExpr child fldExpr : CExpr visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local isTopApp : {Bool} local isTopTup : _ local stackDepthHere : _ local vref : _ alternative TupUpd: child expr : CExpr child tag : {CTag} child nm : {HsName} child offset : CExpr child fldExpr : CExpr visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local isTopApp : {Bool} local isTopTup : _ local stackDepthHere : _ local vref : _ alternative FFI: child callconv : {FFIWay} child safety : {String} child impEnt : {ForeignEnt} child ty : {Ty} visit 0: local whatBelow : _ visit 2: local foreignEntInfo : _ local creEntMb : _ local creMk : _ local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local mbPrimNeedEval : {Maybe PrimitiveNeedsEval} local primResNeedsEval : {Bool} local argTyLresTy : {( TyL, Ty )} local resTy : _ local argTyL : {TyL} local stackDepthHere : _ local vref : _ alternative Dbg: child info : {String} visit 0: local whatBelow : _ visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local stackDepthHere : _ local vref : _ alternative Hole: child uid : {UID} visit 0: local whatBelow : _ visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local stackDepthHere : _ local vref : _ alternative HoleLet: child bindsUid : {UID} child body : CExpr visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local isTopTup : _ local isTopApp : {Bool} local stackDepthHere : _ local vref : _ alternative CoeArg: visit 0: local whatBelow : _ visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local stackDepthHere : _ local vref : _ alternative ImplsApp: child func : CExpr child uid : {ImplsVarId} visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local isTopTup : _ local isTopApp : {Bool} local stackDepthHere : _ local vref : _ alternative ImplsLam: child uid : {ImplsVarId} child body : CExpr visit 0: local whatBelow : _ visit 1: local whatAbove : {WhatExpr} visit 2: local creBase : _ local cre : _ local creAppArgL : _ local creAppFun : _ local creLamArgL : _ local creLamBody : _ local crse : _ local isTopTup : _ local isTopApp : {Bool} local stackDepthHere : _ local vref : _ alternative Ann: child ann : CExprAnn child expr : CExpr visit 2: local crse : _ local vref : _ -} -- 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 = ( WhatExpr,T_CExpr_1) type T_CExpr_1 = Int -> Int -> Int -> WhatExpr -> ( (CR.Nm2RefMp),Int,T_CExpr_2) type T_CExpr_2 = EvalCtx -> Bool -> Bool -> (CR.Nm2RefMp) -> EHCOpts -> Int -> TailCtx -> ( AppFunKind,([(HsName, CR.Bind)]),(CR.Exp),([CR.SExp]),(TailCtx -> CR.CRArray CR.SExp -> CR.Exp),([HsName]),(CR.Exp),(CR.SExp),(Maybe ( Ty , Bool , FFIWay , ForeignEnt , [Ty] )),(Maybe [HsName]),(Maybe HsName),Int,Int,Int,(CR.RRef)) sem_CExpr_Var :: ACoreBindRef -> T_CExpr sem_CExpr_Var ref_ = (case (acbrefNm ref_) of { _nm -> (case (ExprIsVar _nm) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Var_1 :: T_CExpr_1 sem_CExpr_Var_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Var_2 :: T_CExpr_2 sem_CExpr_Var_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_Fun ref_) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (maybe (CR.RRef_Dbg _nm) (CR.rrefToDif _lhsIlev) $ Map.lookup _nm _lhsInm2ref) of { _vref -> (case (CR.mkVar' _vref) of { _crse -> (case (taileval _lhsItailCtx $ CR.mkExp _crse) of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Just _nm) of { _mbVar -> (case (_mbVar) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Var_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_Var_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) }) sem_CExpr_Int :: Int -> T_CExpr sem_CExpr_Int int_ = (case (ExprIsInt int_) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Int_1 :: T_CExpr_1 sem_CExpr_Int_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Int_2 :: T_CExpr_2 sem_CExpr_Int_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.mkInt' int_) of { _crse -> (case (CR.mkExp _crse) of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Int_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_Int_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_Char :: Char -> T_CExpr sem_CExpr_Char char_ = (case (ExprIsOtherWHNF) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Char_1 :: T_CExpr_1 sem_CExpr_Char_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Char_2 :: T_CExpr_2 sem_CExpr_Char_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.mkChar' char_) of { _crse -> (case (CR.mkExp _crse) of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Char_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_Char_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_String :: String -> T_CExpr sem_CExpr_String str_ = (case (ExprIsOtherWHNF) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_String_1 :: T_CExpr_1 sem_CExpr_String_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_String_2 :: T_CExpr_2 sem_CExpr_String_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.mkString' str_) of { _crse -> (case (CR.mkExp _crse) of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_String_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_String_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_Integer :: Integer -> T_CExpr sem_CExpr_Integer integer_ = (case (ExprIsOtherWHNF) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Integer_1 :: T_CExpr_1 sem_CExpr_Integer_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Integer_2 :: T_CExpr_2 sem_CExpr_Integer_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.SExp_Integer integer_) of { _crse -> (case (CR.mkExp _crse) of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Integer_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_Integer_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_Tup :: CTag -> T_CExpr sem_CExpr_Tup tag_ = (case (ExprIsTup tag_) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Tup_1 :: T_CExpr_1 sem_CExpr_Tup_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Tup_2 :: T_CExpr_2 sem_CExpr_Tup_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_Tag tag_) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.mkTup (ctagTag tag_) []) of { _creBase -> (case (_creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\_ -> cseCtxWrap TailCtx_Plain . CR.mkTup' (ctagTag tag_)) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Tup_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_Tup_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_Let :: CBindCateg -> T_CBindL -> T_CExpr -> T_CExpr sem_CExpr_Let categ_ binds_ body_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Let_1 :: T_CExpr_1 sem_CExpr_Let_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _bodyOwhatAbove -> (case (_lhsIrefOffset) of { _bindsOrefOffset -> (case (_lhsImodNr) of { _bindsOmodNr -> (case (_lhsIlev) of { _bindsOlev -> (case (_lhsIlev == cLevModule) of { _isGlobal -> (case (_isGlobal) of { _bindsOisGlobal -> (case (binds_ _bindsOisGlobal _bindsOlev _bindsOmodNr _bindsOrefOffset) of { ( _bindsInm2refGath,_bindsIrefOffset,binds_1) -> (case (_bindsIrefOffset) of { _bodyOrefOffset -> (case (_lhsImodNr) of { _bodyOmodNr -> (case (_lhsIlev) of { _bodyOlev -> (case (body_) of { ( _bodyIwhatBelow,body_1) -> (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of { ( _bodyInm2refGath,_bodyIrefOffset,body_2) -> (case (if _isGlobal then (Map.empty, _bindsInm2refGath `Map.union` _bodyInm2refGath) else (_bindsInm2refGath, Map.empty)) of { __tup1 -> (case (__tup1) of { (_,_lhsOnm2refGath) -> (case (_bodyIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Let_2 :: T_CExpr_2 sem_CExpr_Let_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case (_lhsIstackDepth) of { _bindsOstackDepth -> (case (if categ_ == CBindCateg_Strict then EvalCtx_Eval else EvalCtx_Thunk) of { _evalCtx -> (case (_evalCtx) of { _bindsOevalCtx -> (case (_lhsIopts) of { _bindsOopts -> (case (categ_) of { _letBindingsCateg -> (case (_letBindingsCateg) of { _bindsOletBindingsCateg -> (case (if _isGlobal then (_lhsInm2ref, _lhsInm2ref) else ( case categ_ of CBindCateg_Rec -> _bindsInm2refGath `Map.union` _lhsInm2ref _ -> _lhsInm2ref `Map.union` _bindsInm2refGath , _bindsInm2refGath `Map.union` _lhsInm2ref )) of { __tup2 -> (case (__tup2) of { (_bindsOnm2ref,_) -> (case (binds_1 _bindsOevalCtx _bindsOletBindingsCateg _bindsOnm2ref _bindsOopts _bindsOstackDepth) of { ( _bindsIcrb,_bindsIrefOffsetMax,_bindsIstackDepth,_bindsIstackDepthMax) -> (case (_bindsIstackDepth) of { _bodyOstackDepth -> (case (__tup2) of { (_,_bodyOnm2ref) -> (case (_lhsItailCtx) of { _bodyOtailCtx -> (case (_lhsIopts) of { _bodyOopts -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _bodyOisTopTup -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _bodyOisTopApp -> (case (_evalCtx) of { _bodyOevalCtx -> (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) -> (case (if _isGlobal then _bindsIcrb ++ _bodyIcrb else []) of { _lhsOcrb -> (case (__tup1) of { (_nm2refNew,_) -> (case (if _isGlobal then _bodyIcre else CR.Exp_Let _lhsIrefOffset (CR.nm2RefMpInverse _nm2refNew) (CR.crarrayFromList $ map snd _bindsIcrb) _bodyIcre) of { _creBase -> (case (_creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (max _bindsIrefOffsetMax _bodyIrefOffsetMax) of { _refOffsetMax -> (case (_refOffsetMax) of { _lhsOrefOffsetMax -> (case (_bodyIstackDepth) of { _lhsOstackDepth -> (case (max _bindsIstackDepthMax _bodyIstackDepthMax) of { _stackDepthMax -> (case (_stackDepthMax) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Let_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Let_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_App :: T_CExpr -> T_CBound -> T_CExpr sem_CExpr_App func_ arg_ = (case (func_) of { ( _funcIwhatBelow,func_1) -> (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_App_1 :: T_CExpr_1 sem_CExpr_App_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (_lhsIrefOffset) of { _funcOrefOffset -> (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of { _whatAbove -> (case (_whatAbove) of { _funcOwhatAbove -> (case (_lhsImodNr) of { _funcOmodNr -> (case (_lhsIlev) of { _funcOlev -> (case (func_1 _funcOlev _funcOmodNr _funcOrefOffset _funcOwhatAbove) of { ( _funcInm2refGath,_funcIrefOffset,func_2) -> (case (_funcIrefOffset) of { _argOrefOffset -> (case (_lhsImodNr) of { _argOmodNr -> (case (_lhsIlev) of { _argOlev -> (case (False) of { _isGlobal -> (case (_isGlobal) of { _argOisGlobal -> (case (hsnUnknown) of { _argOnm -> (case (EvalCtx_Thunk) of { _argOevalCtx -> (case (arg_ _argOevalCtx _argOisGlobal _argOlev _argOmodNr _argOnm _argOrefOffset) of { ( _argInm2refGath,_argIrefOffset,arg_1) -> (case (_funcInm2refGath `Map.union` _argInm2refGath) of { _lhsOnm2refGath -> (case (_argIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_App_2 :: T_CExpr_2 sem_CExpr_App_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (TailCtx_Plain) of { _tailCtx -> (case (_tailCtx) of { _funcOtailCtx -> (case (_lhsIstackDepth) of { _funcOstackDepth -> (case (_lhsIopts) of { _funcOopts -> (case (_lhsInm2ref) of { _funcOnm2ref -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _funcOisTopTup -> (case (_lhsIevalCtx) of { _funcOevalCtx -> (case (False) of { _funcOisTopApp -> (case (func_2 _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOnm2ref _funcOopts _funcOstackDepth _funcOtailCtx) of { ( _funcIappFunKind,_funcIcrb,_funcIcre,_funcIcreAppArgL,_funcIcreAppFun,_funcIcreLamArgL,_funcIcreLamBody,_funcIcrse,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIrefOffsetMax,_funcIstackDepth,_funcIstackDepthMax,_funcIvref) -> (case (_funcIappFunKind) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (_lhsInm2ref) of { _argOnm2ref -> (case (_funcIcreAppFun) of { _creAppFun -> (case (if whatExprIsTup _funcIwhatBelow || whatExprIsFFI _funcIwhatBelow then _lhsIstackDepth else _funcIstackDepth) of { _stackDepthFunc -> (case (_stackDepthFunc) of { _argOstackDepth -> (case (_lhsIopts) of { _argOopts -> (case (acoreBindcategPlain) of { _letBindingsCateg -> (case (_letBindingsCateg) of { _argOletBindingsCateg -> (case (_isTopTup) of { _argOisTopTup -> (case (True) of { _argOisTopApp -> (case (arg_1 _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOnm2ref _argOopts _argOstackDepth) of { ( _argIcrb,_argIrefOffsetMax,_argIstackDepth,_argIstackDepthMax) -> (case ((CR.exp2sexp $ snd $ head _argIcrb) : _funcIcreAppArgL) of { _creAppArgL -> (case (isNothing $ whatExprMbApp _lhsIwhatAbove) of { _isTopApp' -> (case (if _isTopApp' then _creAppFun _lhsItailCtx $ CR.crarrayFromList $ reverse _creAppArgL else CR.dbg "Core.ToCoreRun.CExpr.App.cre") of { _creBase -> (case (_creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (_funcImbFFIApp) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (_funcIrefOffsetMax `max` _argIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (if _isTopApp' then _lhsIstackDepth + 1 else _argIstackDepth) of { _lhsOstackDepth -> (case (max _argIstackDepth _argIstackDepthMax) of { _stackDepthMax -> (case (_stackDepthMax) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_App_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_App_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) }) sem_CExpr_Lam :: T_CBind -> T_CExpr -> T_CExpr sem_CExpr_Lam bind_ body_ = (case (body_) of { ( _bodyIwhatBelow,body_1) -> (case (maybe (ExprIsLam 1 Nothing) (\a -> ExprIsLam (a + 1) Nothing) $ whatExprMbLam _bodyIwhatBelow) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Lam_1 :: T_CExpr_1 sem_CExpr_Lam_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (case _lhsIwhatAbove of ExprIsLam a mbnm -> ExprIsLam (a + 1) mbnm ExprIsBind nm -> ExprIsLam 1 (Just nm) _ -> ExprIsLam 1 Nothing) of { _whatAbove -> (case (_whatAbove) of { _bodyOwhatAbove -> (case (_lhsImodNr) of { _bodyOmodNr -> (case (not $ whatExprIsLam _lhsIwhatAbove) of { _isTopLam -> (case (if _isTopLam then _lhsIlev + 1 else _lhsIlev) of { _lev -> (case (_lev) of { _bodyOlev -> (case (if _isTopLam then (0,1) else (_lhsIrefOffset, _lhsIrefOffset + 1)) of { __tup3 -> (case (__tup3) of { (_,_refOffsetBody) -> (case (_refOffsetBody) of { _bodyOrefOffset -> (case (__tup3) of { (_refOffset,_) -> (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of { ( _bodyInm2refGath,_bodyIrefOffset,body_2) -> (case (_refOffset) of { _bindOrefOffset -> (case (_lhsImodNr) of { _bindOmodNr -> (case (_lev) of { _bindOlev -> (case (False) of { _isGlobal -> (case (_isGlobal) of { _bindOisGlobal -> (case (bind_ _bindOisGlobal _bindOlev _bindOmodNr _bindOrefOffset) of { ( _bindInm,_bindInm2refGath,_bindIrefOffset,bind_1) -> (case (Map.insert _bindInm (CR.RRef_Loc _lev _refOffset) _bodyInm2refGath) of { _nm2refNew -> (case (if _isTopLam then Map.empty else _nm2refNew) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Lam_2 :: T_CExpr_2 sem_CExpr_Lam_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (if _isTopLam then _nm2refNew `Map.union` _lhsInm2ref else _lhsInm2ref) of { _nm2ref -> (case (_nm2ref) of { _bodyOnm2ref -> (case (_lhsIopts) of { _bodyOopts -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _bodyOisTopTup -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _bodyOisTopApp -> (case (_lhsIevalCtx) of { _bodyOevalCtx -> (case (_refOffsetBody) of { _bodyOstackDepth -> (case (TailCtx_TailCall) of { _bodyOtailCtx -> (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) -> (case (_bindInm : _bodyIcreLamArgL) of { _creLamArgL -> (case (max _bodyIstackDepth _bodyIstackDepthMax) of { _stackDepthMax -> (case (if _isTopLam then CR.Exp_Lam (whatExprMbBind _lhsIwhatAbove) (length _creLamArgL) (_stackDepthMax) (CR.nm2RefMpInverse _nm2refNew) _bodyIcreLamBody else CR.dbg "Core.ToCoreRun.CExpr.Lam.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_bodyIcreLamBody) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (_bindInm) of { _argNm -> (case (Just $ maybe [_argNm] (_argNm:) _bodyImbLam) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (max _bodyIrefOffset _bodyIrefOffsetMax) of { _refOffsetMax -> (case (_refOffsetMax) of { _lhsOrefOffsetMax -> (case (_bodyIstackDepth) of { _lhsOstackDepth -> (case (_stackDepthMax) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Lam_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Lam_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) }) sem_CExpr_Case :: T_CExpr -> T_CAltL -> T_CExpr -> T_CExpr sem_CExpr_Case expr_ alts_ dflt_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Case_1 :: T_CExpr_1 sem_CExpr_Case_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _dfltOwhatAbove -> (case (_lhsIrefOffset) of { _exprOrefOffset -> (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (_whatAbove) of { _exprOwhatAbove -> (case (_lhsImodNr) of { _exprOmodNr -> (case (_lhsIlev) of { _exprOlev -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_exprIrefOffset) of { _altsOrefOffset -> (case (alts_ _altsOrefOffset) of { ( _altsIrefOffset,alts_1) -> (case (_altsIrefOffset) of { _dfltOrefOffset -> (case (_lhsImodNr) of { _dfltOmodNr -> (case (_lhsIlev) of { _dfltOlev -> (case (dflt_) of { ( _dfltIwhatBelow,dflt_1) -> (case (dflt_1 _dfltOlev _dfltOmodNr _dfltOrefOffset _dfltOwhatAbove) of { ( _dfltInm2refGath,_dfltIrefOffset,dflt_2) -> (case (_exprInm2refGath `Map.union` _dfltInm2refGath) of { _lhsOnm2refGath -> (case (_dfltIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Case_2 :: T_CExpr_2 sem_CExpr_Case_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (_lhsItailCtx) of { _altsOtailCtx -> (case (_lhsInm2ref) of { _altsOnm2ref -> (case (_lhsImodNr) of { _altsOmodNr -> (case (_lhsIlev) of { _altsOlev -> (case (_lhsInm2ref) of { _exprOnm2ref -> (case (maybe CR.noRRef (\n -> maybe (CR.RRef_Dbg n) id $ Map.lookup n _lhsInm2ref) $ whatExprMbVar _exprIwhatBelow) of { _altsOscrutRef -> (case (_lhsIstackDepth) of { _altsOstackDepth -> (case (_lhsIopts) of { _altsOopts -> (case (_lhsIevalCtx) of { _altsOevalCtx -> (case (alts_1 _altsOevalCtx _altsOlev _altsOmodNr _altsOnm2ref _altsOopts _altsOscrutRef _altsOstackDepth _altsOtailCtx) of { ( _altsIcra,_altsIrefOffsetMax,_altsIstackDepth,_altsIstackDepthMax) -> (case (_lhsIstackDepth) of { _exprOstackDepth -> (case (_lhsIopts) of { _exprOopts -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _exprOisTopTup -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _exprOisTopApp -> (case (_lhsIevalCtx) of { _exprOevalCtx -> (case (TailCtx_Plain) of { _exprOtailCtx -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case (CR.Exp_Case (CR.mkVar' $ CR.RRef_Tag _exprIvref) $ CR.crarrayFromList _altsIcra) of { _creBase -> (case (_creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (_lhsItailCtx) of { _dfltOtailCtx -> (case (_altsIstackDepth) of { _dfltOstackDepth -> (case (_lhsIopts) of { _dfltOopts -> (case (_lhsInm2ref) of { _dfltOnm2ref -> (case (_isTopTup) of { _dfltOisTopTup -> (case (_isTopApp) of { _dfltOisTopApp -> (case (_lhsIevalCtx) of { _dfltOevalCtx -> (case (dflt_2 _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOnm2ref _dfltOopts _dfltOstackDepth _dfltOtailCtx) of { ( _dfltIappFunKind,_dfltIcrb,_dfltIcre,_dfltIcreAppArgL,_dfltIcreAppFun,_dfltIcreLamArgL,_dfltIcreLamBody,_dfltIcrse,_dfltImbFFIApp,_dfltImbLam,_dfltImbVar,_dfltIrefOffsetMax,_dfltIstackDepth,_dfltIstackDepthMax,_dfltIvref) -> (case (_exprIrefOffsetMax `max` _altsIrefOffsetMax `max` _dfltIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (max _exprIstackDepthMax _altsIstackDepthMax) of { _stackDepthMax -> (case (_stackDepthMax) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Case_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Case_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_CaseAltFail :: CaseAltFailReason -> T_CExpr -> T_CExpr sem_CExpr_CaseAltFail failReason_ errorExpr_ = (case (errorExpr_) of { ( _errorExprIwhatBelow,errorExpr_1) -> (case (_errorExprIwhatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_CaseAltFail_1 :: T_CExpr_1 sem_CExpr_CaseAltFail_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _errorExprOwhatAbove -> (case (_lhsIrefOffset) of { _errorExprOrefOffset -> (case (_lhsImodNr) of { _errorExprOmodNr -> (case (_lhsIlev) of { _errorExprOlev -> (case (errorExpr_1 _errorExprOlev _errorExprOmodNr _errorExprOrefOffset _errorExprOwhatAbove) of { ( _errorExprInm2refGath,_errorExprIrefOffset,errorExpr_2) -> (case (_errorExprInm2refGath) of { _lhsOnm2refGath -> (case (_errorExprIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_CaseAltFail_2 :: T_CExpr_2 sem_CExpr_CaseAltFail_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (_lhsItailCtx) of { _errorExprOtailCtx -> (case (_lhsIstackDepth) of { _errorExprOstackDepth -> (case (_lhsIopts) of { _errorExprOopts -> (case (_lhsInm2ref) of { _errorExprOnm2ref -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _errorExprOisTopTup -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _errorExprOisTopApp -> (case (_lhsIevalCtx) of { _errorExprOevalCtx -> (case (errorExpr_2 _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOnm2ref _errorExprOopts _errorExprOstackDepth _errorExprOtailCtx) of { ( _errorExprIappFunKind,_errorExprIcrb,_errorExprIcre,_errorExprIcreAppArgL,_errorExprIcreAppFun,_errorExprIcreLamArgL,_errorExprIcreLamBody,_errorExprIcrse,_errorExprImbFFIApp,_errorExprImbLam,_errorExprImbVar,_errorExprIrefOffsetMax,_errorExprIstackDepth,_errorExprIstackDepthMax,_errorExprIvref) -> (case (_errorExprIappFunKind) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (_errorExprImbLam) of { _lhsOmbLam -> (case (_errorExprImbVar) of { _lhsOmbVar -> (case (_errorExprIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_CaseAltFail_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) })) in sem_CExpr_CaseAltFail_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_TupDel :: T_CExpr -> CTag -> HsName -> T_CExpr -> T_CExpr sem_CExpr_TupDel expr_ tag_ nm_ offset_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_TupDel_1 :: T_CExpr_1 sem_CExpr_TupDel_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _offsetOwhatAbove -> (case (_lhsIrefOffset) of { _exprOrefOffset -> (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (_whatAbove) of { _exprOwhatAbove -> (case (_lhsImodNr) of { _exprOmodNr -> (case (_lhsIlev) of { _exprOlev -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_exprIrefOffset) of { _offsetOrefOffset -> (case (_lhsImodNr) of { _offsetOmodNr -> (case (_lhsIlev) of { _offsetOlev -> (case (offset_) of { ( _offsetIwhatBelow,offset_1) -> (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) -> (case (_exprInm2refGath `Map.union` _offsetInm2refGath) of { _lhsOnm2refGath -> (case (_offsetIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_TupDel_2 :: T_CExpr_2 sem_CExpr_TupDel_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (_lhsItailCtx) of { _offsetOtailCtx -> (case (_lhsIstackDepth) of { _exprOstackDepth -> (case (_lhsItailCtx) of { _exprOtailCtx -> (case (_lhsIopts) of { _exprOopts -> (case (_lhsInm2ref) of { _exprOnm2ref -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _exprOisTopApp -> (case (_lhsIevalCtx) of { _exprOevalCtx -> (case (False) of { _exprOisTopTup -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case (_exprIstackDepth) of { _offsetOstackDepth -> (case (_lhsIopts) of { _offsetOopts -> (case (_lhsInm2ref) of { _offsetOnm2ref -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _offsetOisTopTup -> (case (_isTopApp) of { _offsetOisTopApp -> (case (_lhsIevalCtx) of { _offsetOevalCtx -> (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) -> (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_TupDel_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_TupDel_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_TupIns :: T_CExpr -> CTag -> HsName -> T_CExpr -> T_CExpr -> T_CExpr sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_TupIns_1 :: T_CExpr_1 sem_CExpr_TupIns_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _fldExprOwhatAbove -> (case (_lhsIrefOffset) of { _exprOrefOffset -> (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (_whatAbove) of { _exprOwhatAbove -> (case (_lhsImodNr) of { _exprOmodNr -> (case (_lhsIlev) of { _exprOlev -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_exprIrefOffset) of { _offsetOrefOffset -> (case (offset_) of { ( _offsetIwhatBelow,offset_1) -> (case (_whatAbove) of { _offsetOwhatAbove -> (case (_lhsImodNr) of { _offsetOmodNr -> (case (_lhsIlev) of { _offsetOlev -> (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) -> (case (_offsetIrefOffset) of { _fldExprOrefOffset -> (case (_lhsImodNr) of { _fldExprOmodNr -> (case (_lhsIlev) of { _fldExprOlev -> (case (fldExpr_) of { ( _fldExprIwhatBelow,fldExpr_1) -> (case (fldExpr_1 _fldExprOlev _fldExprOmodNr _fldExprOrefOffset _fldExprOwhatAbove) of { ( _fldExprInm2refGath,_fldExprIrefOffset,fldExpr_2) -> (case (_exprInm2refGath `Map.union` _offsetInm2refGath `Map.union` _fldExprInm2refGath) of { _lhsOnm2refGath -> (case (_fldExprIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_TupIns_2 :: T_CExpr_2 sem_CExpr_TupIns_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (_lhsItailCtx) of { _fldExprOtailCtx -> (case (_lhsIstackDepth) of { _exprOstackDepth -> (case (_lhsItailCtx) of { _exprOtailCtx -> (case (_lhsIopts) of { _exprOopts -> (case (_lhsInm2ref) of { _exprOnm2ref -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _exprOisTopApp -> (case (_lhsIevalCtx) of { _exprOevalCtx -> (case (False) of { _exprOisTopTup -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case (_exprIstackDepth) of { _offsetOstackDepth -> (case (_lhsItailCtx) of { _offsetOtailCtx -> (case (_lhsIopts) of { _offsetOopts -> (case (_lhsInm2ref) of { _offsetOnm2ref -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _offsetOisTopTup -> (case (_isTopApp) of { _offsetOisTopApp -> (case (_lhsIevalCtx) of { _offsetOevalCtx -> (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) -> (case (_offsetIstackDepth) of { _fldExprOstackDepth -> (case (_lhsIopts) of { _fldExprOopts -> (case (_lhsInm2ref) of { _fldExprOnm2ref -> (case (_isTopTup) of { _fldExprOisTopTup -> (case (_isTopApp) of { _fldExprOisTopApp -> (case (_lhsIevalCtx) of { _fldExprOevalCtx -> (case (fldExpr_2 _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOnm2ref _fldExprOopts _fldExprOstackDepth _fldExprOtailCtx) of { ( _fldExprIappFunKind,_fldExprIcrb,_fldExprIcre,_fldExprIcreAppArgL,_fldExprIcreAppFun,_fldExprIcreLamArgL,_fldExprIcreLamBody,_fldExprIcrse,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIrefOffsetMax,_fldExprIstackDepth,_fldExprIstackDepthMax,_fldExprIvref) -> (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax `max` _fldExprIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_TupIns_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_TupIns_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_TupUpd :: T_CExpr -> CTag -> HsName -> T_CExpr -> T_CExpr -> T_CExpr sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_TupUpd_1 :: T_CExpr_1 sem_CExpr_TupUpd_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _fldExprOwhatAbove -> (case (_lhsIrefOffset) of { _exprOrefOffset -> (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (_whatAbove) of { _exprOwhatAbove -> (case (_lhsImodNr) of { _exprOmodNr -> (case (_lhsIlev) of { _exprOlev -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_exprIrefOffset) of { _offsetOrefOffset -> (case (offset_) of { ( _offsetIwhatBelow,offset_1) -> (case (_whatAbove) of { _offsetOwhatAbove -> (case (_lhsImodNr) of { _offsetOmodNr -> (case (_lhsIlev) of { _offsetOlev -> (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) -> (case (_offsetIrefOffset) of { _fldExprOrefOffset -> (case (_lhsImodNr) of { _fldExprOmodNr -> (case (_lhsIlev) of { _fldExprOlev -> (case (fldExpr_) of { ( _fldExprIwhatBelow,fldExpr_1) -> (case (fldExpr_1 _fldExprOlev _fldExprOmodNr _fldExprOrefOffset _fldExprOwhatAbove) of { ( _fldExprInm2refGath,_fldExprIrefOffset,fldExpr_2) -> (case (_exprInm2refGath `Map.union` _offsetInm2refGath `Map.union` _fldExprInm2refGath) of { _lhsOnm2refGath -> (case (_fldExprIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_TupUpd_2 :: T_CExpr_2 sem_CExpr_TupUpd_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (_lhsItailCtx) of { _fldExprOtailCtx -> (case (_lhsIstackDepth) of { _exprOstackDepth -> (case (_lhsItailCtx) of { _exprOtailCtx -> (case (_lhsIopts) of { _exprOopts -> (case (_lhsInm2ref) of { _exprOnm2ref -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _exprOisTopApp -> (case (_lhsIevalCtx) of { _exprOevalCtx -> (case (False) of { _exprOisTopTup -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case (_exprIstackDepth) of { _offsetOstackDepth -> (case (_lhsItailCtx) of { _offsetOtailCtx -> (case (_lhsIopts) of { _offsetOopts -> (case (_lhsInm2ref) of { _offsetOnm2ref -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _offsetOisTopTup -> (case (_isTopApp) of { _offsetOisTopApp -> (case (_lhsIevalCtx) of { _offsetOevalCtx -> (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) -> (case (_offsetIstackDepth) of { _fldExprOstackDepth -> (case (_lhsIopts) of { _fldExprOopts -> (case (_lhsInm2ref) of { _fldExprOnm2ref -> (case (_isTopTup) of { _fldExprOisTopTup -> (case (_isTopApp) of { _fldExprOisTopApp -> (case (_lhsIevalCtx) of { _fldExprOevalCtx -> (case (fldExpr_2 _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOnm2ref _fldExprOopts _fldExprOstackDepth _fldExprOtailCtx) of { ( _fldExprIappFunKind,_fldExprIcrb,_fldExprIcre,_fldExprIcreAppArgL,_fldExprIcreAppFun,_fldExprIcreLamArgL,_fldExprIcreLamBody,_fldExprIcrse,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIrefOffsetMax,_fldExprIstackDepth,_fldExprIstackDepthMax,_fldExprIvref) -> (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax `max` _fldExprIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_TupUpd_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_TupUpd_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_FFI :: FFIWay -> String -> ForeignEnt -> Ty -> T_CExpr sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = (case (ExprIsFFI) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_FFI_1 :: T_CExpr_1 sem_CExpr_FFI_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_FFI_2 :: T_CExpr_2 sem_CExpr_FFI_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_FFI) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (foreignEntExtract impEnt_) of { _foreignEntInfo -> (case (forextractMbEnt _foreignEntInfo) of { _creEntMb -> (case (\as -> maybe (CR.dbg $ "Core.ToCoreRun.CExpr.FFI.cre: " ++ show _foreignEntInfo) (\ent -> CR.mkFFI' ent as) _creEntMb) of { _creMk -> (case (_creMk CR.emptyCRArray) of { _creBase -> (case (_creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\_ -> cseCtxWrap TailCtx_Plain . _creMk) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (maybe Nothing lookupPrimNeedsEval $ forextractMbEnt _foreignEntInfo) of { _mbPrimNeedEval -> (case (maybe False primResNeedEval _mbPrimNeedEval) of { _primResNeedsEval -> (case (appUnArr ty_) of { _argTyLresTy -> (case (snd _argTyLresTy) of { _resTy -> (case (fst _argTyLresTy) of { _argTyL -> (case (Just ( _resTy , _primResNeedsEval , callconv_ , impEnt_ , _argTyL )) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_FFI_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_FFI_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_Dbg :: String -> T_CExpr sem_CExpr_Dbg info_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Dbg_1 :: T_CExpr_1 sem_CExpr_Dbg_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Dbg_2 :: T_CExpr_2 sem_CExpr_Dbg_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Dbg_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_Dbg_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_Hole :: UID -> T_CExpr sem_CExpr_Hole uid_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Hole_1 :: T_CExpr_1 sem_CExpr_Hole_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Hole_2 :: T_CExpr_2 sem_CExpr_Hole_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Hole_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_Hole_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_HoleLet :: UID -> T_CExpr -> T_CExpr sem_CExpr_HoleLet bindsUid_ body_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_HoleLet_1 :: T_CExpr_1 sem_CExpr_HoleLet_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _bodyOwhatAbove -> (case (_lhsIrefOffset) of { _bodyOrefOffset -> (case (_lhsImodNr) of { _bodyOmodNr -> (case (_lhsIlev) of { _bodyOlev -> (case (body_) of { ( _bodyIwhatBelow,body_1) -> (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of { ( _bodyInm2refGath,_bodyIrefOffset,body_2) -> (case (_bodyInm2refGath) of { _lhsOnm2refGath -> (case (_bodyIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_HoleLet_2 :: T_CExpr_2 sem_CExpr_HoleLet_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (_lhsItailCtx) of { _bodyOtailCtx -> (case (_lhsIstackDepth) of { _bodyOstackDepth -> (case (_lhsIopts) of { _bodyOopts -> (case (_lhsInm2ref) of { _bodyOnm2ref -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _bodyOisTopTup -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _bodyOisTopApp -> (case (_lhsIevalCtx) of { _bodyOevalCtx -> (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) -> (case (_bodyIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_HoleLet_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_HoleLet_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_CoeArg :: T_CExpr sem_CExpr_CoeArg = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_CoeArg_1 :: T_CExpr_1 sem_CExpr_CoeArg_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (Map.empty) of { _lhsOnm2refGath -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_CoeArg_2 :: T_CExpr_2 sem_CExpr_CoeArg_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (0) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_CoeArg_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) in sem_CExpr_CoeArg_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_ImplsApp :: T_CExpr -> ImplsVarId -> T_CExpr sem_CExpr_ImplsApp func_ uid_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_ImplsApp_1 :: T_CExpr_1 sem_CExpr_ImplsApp_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _funcOwhatAbove -> (case (_lhsIrefOffset) of { _funcOrefOffset -> (case (_lhsImodNr) of { _funcOmodNr -> (case (_lhsIlev) of { _funcOlev -> (case (func_) of { ( _funcIwhatBelow,func_1) -> (case (func_1 _funcOlev _funcOmodNr _funcOrefOffset _funcOwhatAbove) of { ( _funcInm2refGath,_funcIrefOffset,func_2) -> (case (_funcInm2refGath) of { _lhsOnm2refGath -> (case (_funcIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_ImplsApp_2 :: T_CExpr_2 sem_CExpr_ImplsApp_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (_lhsItailCtx) of { _funcOtailCtx -> (case (_lhsIstackDepth) of { _funcOstackDepth -> (case (_lhsIopts) of { _funcOopts -> (case (_lhsInm2ref) of { _funcOnm2ref -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _funcOisTopTup -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _funcOisTopApp -> (case (_lhsIevalCtx) of { _funcOevalCtx -> (case (func_2 _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOnm2ref _funcOopts _funcOstackDepth _funcOtailCtx) of { ( _funcIappFunKind,_funcIcrb,_funcIcre,_funcIcreAppArgL,_funcIcreAppFun,_funcIcreLamArgL,_funcIcreLamBody,_funcIcrse,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIrefOffsetMax,_funcIstackDepth,_funcIstackDepthMax,_funcIvref) -> (case (_funcIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_ImplsApp_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_ImplsApp_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_ImplsLam :: ImplsVarId -> T_CExpr -> T_CExpr sem_CExpr_ImplsLam uid_ body_ = (case (ExprIsOther) of { _whatBelow -> (case (_whatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_ImplsLam_1 :: T_CExpr_1 sem_CExpr_ImplsLam_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _bodyOwhatAbove -> (case (_lhsIrefOffset) of { _bodyOrefOffset -> (case (_lhsImodNr) of { _bodyOmodNr -> (case (_lhsIlev) of { _bodyOlev -> (case (body_) of { ( _bodyIwhatBelow,body_1) -> (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of { ( _bodyInm2refGath,_bodyIrefOffset,body_2) -> (case (_bodyInm2refGath) of { _lhsOnm2refGath -> (case (_bodyIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_ImplsLam_2 :: T_CExpr_2 sem_CExpr_ImplsLam_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (AppFunKind_NoApp) of { _lhsOappFunKind -> (case ([]) of { _lhsOcrb -> (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of { _creBase -> (case (cseCtxWrap _lhsItailCtx _creBase) of { _cre -> (case (_cre) of { _lhsOcre -> (case ([]) of { _creAppArgL -> (case (_creAppArgL) of { _lhsOcreAppArgL -> (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of { _creAppFun -> (case (_creAppFun) of { _lhsOcreAppFun -> (case ([]) of { _creLamArgL -> (case (_creLamArgL) of { _lhsOcreLamArgL -> (case (_cre) of { _creLamBody -> (case (_creLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (Nothing) of { _lhsOmbFFIApp -> (case (Nothing) of { _lhsOmbLam -> (case (Nothing) of { _lhsOmbVar -> (case (_lhsItailCtx) of { _bodyOtailCtx -> (case (_lhsIstackDepth) of { _bodyOstackDepth -> (case (_lhsIopts) of { _bodyOopts -> (case (_lhsInm2ref) of { _bodyOnm2ref -> (case (True) of { _isTopTup -> (case (_isTopTup) of { _bodyOisTopTup -> (case (True) of { _isTopApp -> (case (_isTopApp) of { _bodyOisTopApp -> (case (_lhsIevalCtx) of { _bodyOevalCtx -> (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) -> (case (_bodyIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_lhsIstackDepth + 1) of { _stackDepthHere -> (case (_stackDepthHere) of { _lhsOstackDepth -> (case (_stackDepthHere) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_ImplsLam_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_ImplsLam_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) sem_CExpr_Ann :: T_CExprAnn -> T_CExpr -> T_CExpr sem_CExpr_Ann ann_ expr_ = (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (_exprIwhatBelow) of { _lhsOwhatBelow -> (case ((let sem_CExpr_Ann_1 :: T_CExpr_1 sem_CExpr_Ann_1 = (\ _lhsIlev _lhsImodNr _lhsIrefOffset _lhsIwhatAbove -> (case (_lhsIwhatAbove) of { _exprOwhatAbove -> (case (_lhsIrefOffset) of { _annOrefOffset -> (case (ann_ _annOrefOffset) of { ( _annIrefOffset,ann_1) -> (case (_annIrefOffset) of { _exprOrefOffset -> (case (_lhsImodNr) of { _exprOmodNr -> (case (_lhsIlev) of { _exprOlev -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_exprInm2refGath) of { _lhsOnm2refGath -> (case (_exprIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExpr_Ann_2 :: T_CExpr_2 sem_CExpr_Ann_2 = (\ _lhsIevalCtx _lhsIisTopApp _lhsIisTopTup _lhsInm2ref _lhsIopts _lhsIstackDepth _lhsItailCtx -> (case (_lhsItailCtx) of { _exprOtailCtx -> (case (_lhsIstackDepth) of { _annOstackDepth -> (case (_lhsIopts) of { _annOopts -> (case (_lhsInm2ref) of { _annOnm2ref -> (case (_lhsImodNr) of { _annOmodNr -> (case (_lhsIlev) of { _annOlev -> (case (ann_1 _annOlev _annOmodNr _annOnm2ref _annOopts _annOstackDepth) of { ( _annIstackDepth) -> (case (_annIstackDepth) of { _exprOstackDepth -> (case (_lhsIopts) of { _exprOopts -> (case (_lhsInm2ref) of { _exprOnm2ref -> (case (_lhsIisTopTup) of { _exprOisTopTup -> (case (_lhsIisTopApp) of { _exprOisTopApp -> (case (_lhsIevalCtx) of { _exprOevalCtx -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case (_exprIappFunKind) of { _lhsOappFunKind -> (case (_exprIcrb) of { _lhsOcrb -> (case (_exprIcre) of { _lhsOcre -> (case (_exprIcreAppArgL) of { _lhsOcreAppArgL -> (case (_exprIcreAppFun) of { _lhsOcreAppFun -> (case (_exprIcreLamArgL) of { _lhsOcreLamArgL -> (case (_exprIcreLamBody) of { _lhsOcreLamBody -> (case (panic "Core.ToCoreRun.CExpr.crse") of { _crse -> (case (_crse) of { _lhsOcrse -> (case (_exprImbFFIApp) of { _lhsOmbFFIApp -> (case (_exprImbLam) of { _lhsOmbLam -> (case (_exprImbVar) of { _lhsOmbVar -> (case (_exprIrefOffsetMax) of { _lhsOrefOffsetMax -> (case (_exprIstackDepth) of { _lhsOstackDepth -> (case (_exprIstackDepthMax) of { _lhsOstackDepthMax -> (case (panic "Core.ToCoreRun.CExpr.ref") of { _vref -> (case (_vref) of { _lhsOvref -> ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Ann_2)) of { ( sem_CExpr_2) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) })) in sem_CExpr_Ann_1)) of { ( sem_CExpr_1) -> ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) -- CExprAnn ---------------------------------------------------- {- visit 0: chained attribute: refOffset : Int visit 1: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attribute: stackDepth : Int alternatives: alternative Ty: child ty : {Ty} alternative Coe: child coe : {RelevCoe} alternative Debug: child info : {String} -} -- cata sem_CExprAnn :: CExprAnn -> T_CExprAnn sem_CExprAnn (CExprAnn_Ty _ty) = (sem_CExprAnn_Ty _ty) sem_CExprAnn (CExprAnn_Coe _coe) = (sem_CExprAnn_Coe _coe) sem_CExprAnn (CExprAnn_Debug _info) = (sem_CExprAnn_Debug _info) -- semantic domain type T_CExprAnn = Int -> ( Int,T_CExprAnn_1) type T_CExprAnn_1 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> ( Int) sem_CExprAnn_Ty :: Ty -> T_CExprAnn sem_CExprAnn_Ty ty_ = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExprAnn_Ty_1 :: T_CExprAnn_1 sem_CExprAnn_Ty_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CExprAnn_Ty_1)) of { ( sem_CExprAnn_1) -> ( _lhsOrefOffset,sem_CExprAnn_1) }) })) sem_CExprAnn_Coe :: RelevCoe -> T_CExprAnn sem_CExprAnn_Coe coe_ = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExprAnn_Coe_1 :: T_CExprAnn_1 sem_CExprAnn_Coe_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CExprAnn_Coe_1)) of { ( sem_CExprAnn_1) -> ( _lhsOrefOffset,sem_CExprAnn_1) }) })) sem_CExprAnn_Debug :: String -> T_CExprAnn sem_CExprAnn_Debug info_ = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CExprAnn_Debug_1 :: T_CExprAnn_1 sem_CExprAnn_Debug_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CExprAnn_Debug_1)) of { ( sem_CExprAnn_1) -> ( _lhsOrefOffset,sem_CExprAnn_1) }) })) -- CImport ----------------------------------------------------- {- alternatives: alternative Import: child nm : {HsName} -} -- cata sem_CImport :: CImport -> T_CImport sem_CImport (CImport_Import _nm) = (sem_CImport_Import _nm) -- semantic domain type T_CImport = ( ) sem_CImport_Import :: HsName -> T_CImport sem_CImport_Import nm_ = ( ) -- CImportL ---------------------------------------------------- {- 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 = ( ) sem_CImportL_Cons :: T_CImport -> T_CImportL -> T_CImportL sem_CImportL_Cons hd_ tl_ = ( ) sem_CImportL_Nil :: T_CImportL sem_CImportL_Nil = ( ) -- CMetaBind --------------------------------------------------- {- visit 0: chained attribute: refOffset : Int visit 1: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attribute: stackDepth : Int alternatives: alternative Plain: alternative Function0: alternative Function1: alternative Apply0: -} -- cata sem_CMetaBind :: CMetaBind -> T_CMetaBind sem_CMetaBind (CMetaBind_Plain) = (sem_CMetaBind_Plain) sem_CMetaBind (CMetaBind_Function0) = (sem_CMetaBind_Function0) sem_CMetaBind (CMetaBind_Function1) = (sem_CMetaBind_Function1) sem_CMetaBind (CMetaBind_Apply0) = (sem_CMetaBind_Apply0) -- semantic domain type T_CMetaBind = Int -> ( Int,T_CMetaBind_1) type T_CMetaBind_1 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> ( Int) sem_CMetaBind_Plain :: T_CMetaBind sem_CMetaBind_Plain = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetaBind_Plain_1 :: T_CMetaBind_1 sem_CMetaBind_Plain_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CMetaBind_Plain_1)) of { ( sem_CMetaBind_1) -> ( _lhsOrefOffset,sem_CMetaBind_1) }) })) sem_CMetaBind_Function0 :: T_CMetaBind sem_CMetaBind_Function0 = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetaBind_Function0_1 :: T_CMetaBind_1 sem_CMetaBind_Function0_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CMetaBind_Function0_1)) of { ( sem_CMetaBind_1) -> ( _lhsOrefOffset,sem_CMetaBind_1) }) })) sem_CMetaBind_Function1 :: T_CMetaBind sem_CMetaBind_Function1 = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetaBind_Function1_1 :: T_CMetaBind_1 sem_CMetaBind_Function1_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CMetaBind_Function1_1)) of { ( sem_CMetaBind_1) -> ( _lhsOrefOffset,sem_CMetaBind_1) }) })) sem_CMetaBind_Apply0 :: T_CMetaBind sem_CMetaBind_Apply0 = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetaBind_Apply0_1 :: T_CMetaBind_1 sem_CMetaBind_Apply0_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CMetaBind_Apply0_1)) of { ( sem_CMetaBind_1) -> ( _lhsOrefOffset,sem_CMetaBind_1) }) })) -- CMetaVal ---------------------------------------------------- {- visit 0: chained attribute: refOffset : Int visit 1: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attribute: stackDepth : Int alternatives: alternative Val: alternative Dict: alternative DictClass: child tracks : {[Track]} alternative DictInstance: child tracks : {[Track]} alternative Track: child track : {Track} -} -- cata sem_CMetaVal :: CMetaVal -> T_CMetaVal sem_CMetaVal (CMetaVal_Val) = (sem_CMetaVal_Val) sem_CMetaVal (CMetaVal_Dict) = (sem_CMetaVal_Dict) sem_CMetaVal (CMetaVal_DictClass _tracks) = (sem_CMetaVal_DictClass _tracks) sem_CMetaVal (CMetaVal_DictInstance _tracks) = (sem_CMetaVal_DictInstance _tracks) sem_CMetaVal (CMetaVal_Track _track) = (sem_CMetaVal_Track _track) -- semantic domain type T_CMetaVal = Int -> ( Int,T_CMetaVal_1) type T_CMetaVal_1 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> ( Int) sem_CMetaVal_Val :: T_CMetaVal sem_CMetaVal_Val = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetaVal_Val_1 :: T_CMetaVal_1 sem_CMetaVal_Val_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CMetaVal_Val_1)) of { ( sem_CMetaVal_1) -> ( _lhsOrefOffset,sem_CMetaVal_1) }) })) sem_CMetaVal_Dict :: T_CMetaVal sem_CMetaVal_Dict = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetaVal_Dict_1 :: T_CMetaVal_1 sem_CMetaVal_Dict_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CMetaVal_Dict_1)) of { ( sem_CMetaVal_1) -> ( _lhsOrefOffset,sem_CMetaVal_1) }) })) sem_CMetaVal_DictClass :: ([Track]) -> T_CMetaVal sem_CMetaVal_DictClass tracks_ = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetaVal_DictClass_1 :: T_CMetaVal_1 sem_CMetaVal_DictClass_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CMetaVal_DictClass_1)) of { ( sem_CMetaVal_1) -> ( _lhsOrefOffset,sem_CMetaVal_1) }) })) sem_CMetaVal_DictInstance :: ([Track]) -> T_CMetaVal sem_CMetaVal_DictInstance tracks_ = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetaVal_DictInstance_1 :: T_CMetaVal_1 sem_CMetaVal_DictInstance_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CMetaVal_DictInstance_1)) of { ( sem_CMetaVal_1) -> ( _lhsOrefOffset,sem_CMetaVal_1) }) })) sem_CMetaVal_Track :: Track -> T_CMetaVal sem_CMetaVal_Track track_ = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetaVal_Track_1 :: T_CMetaVal_1 sem_CMetaVal_Track_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) })) in sem_CMetaVal_Track_1)) of { ( sem_CMetaVal_1) -> ( _lhsOrefOffset,sem_CMetaVal_1) }) })) -- CMetas ------------------------------------------------------ {- visit 0: chained attribute: refOffset : Int visit 1: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attribute: stackDepth : Int alternatives: alternative Tuple: child x1 : CMetaBind child x2 : CMetaVal -} -- cata sem_CMetas :: CMetas -> T_CMetas sem_CMetas ( x1,x2) = (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) -- semantic domain type T_CMetas = Int -> ( Int,T_CMetas_1) type T_CMetas_1 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> ( Int) sem_CMetas_Tuple :: T_CMetaBind -> T_CMetaVal -> T_CMetas sem_CMetas_Tuple x1_ x2_ = (\ _lhsIrefOffset -> (case (_lhsIrefOffset) of { _x1OrefOffset -> (case (x1_ _x1OrefOffset) of { ( _x1IrefOffset,x1_1) -> (case (_x1IrefOffset) of { _x2OrefOffset -> (case (x2_ _x2OrefOffset) of { ( _x2IrefOffset,x2_1) -> (case (_x2IrefOffset) of { _lhsOrefOffset -> (case ((let sem_CMetas_Tuple_1 :: T_CMetas_1 sem_CMetas_Tuple_1 = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIstackDepth -> (case (_lhsIstackDepth) of { _x1OstackDepth -> (case (_lhsIopts) of { _x1Oopts -> (case (_lhsInm2ref) of { _x1Onm2ref -> (case (_lhsImodNr) of { _x1OmodNr -> (case (_lhsIlev) of { _x1Olev -> (case (x1_1 _x1Olev _x1OmodNr _x1Onm2ref _x1Oopts _x1OstackDepth) of { ( _x1IstackDepth) -> (case (_x1IstackDepth) of { _x2OstackDepth -> (case (_lhsIopts) of { _x2Oopts -> (case (_lhsInm2ref) of { _x2Onm2ref -> (case (_lhsImodNr) of { _x2OmodNr -> (case (_lhsIlev) of { _x2Olev -> (case (x2_1 _x2Olev _x2OmodNr _x2Onm2ref _x2Oopts _x2OstackDepth) of { ( _x2IstackDepth) -> (case (_x2IstackDepth) of { _lhsOstackDepth -> ( _lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_CMetas_Tuple_1)) of { ( sem_CMetas_1) -> ( _lhsOrefOffset,sem_CMetas_1) }) }) }) }) }) })) -- CModule ----------------------------------------------------- {- visit 0: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts synthesized attributes: crm : CR.Mod nm2refGath : CR.Nm2RefMp alternatives: alternative Mod: child moduleNm : {HsName} child exports : CExportL child imports : CImportL child declMetas : CDeclMetaL child expr : CExpr visit 0: local whatAbove : {WhatExpr} local tailCtx : _ local nm2refNew : _ local crmBinds : _ local creMod : _ -} -- 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 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> ( (CR.Mod),(CR.Nm2RefMp)) sem_CModule_Mod :: HsName -> T_CExportL -> T_CImportL -> T_CDeclMetaL -> T_CExpr -> T_CModule sem_CModule_Mod moduleNm_ exports_ imports_ declMetas_ expr_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _exprOwhatAbove -> (case (TailCtx_Plain) of { _tailCtx -> (case (_tailCtx) of { _exprOtailCtx -> (case (_lhsImodNr) of { _exprOmodNr -> (case (_lhsIlev) of { _exprOlev -> (case (0) of { _exprOrefOffset -> (case (expr_) of { ( _exprIwhatBelow,expr_1) -> (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> (case (_exprInm2refGath) of { _nm2refNew -> (case (_nm2refNew `Map.union` _lhsInm2ref) of { _exprOnm2ref -> (case (0) of { _exprOstackDepth -> (case (_lhsIopts) of { _exprOopts -> (case (EvalCtx_Eval) of { _exprOevalCtx -> (case (True) of { _exprOisTopTup -> (case (True) of { _exprOisTopApp -> (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) -> (case (CR.crarrayFromList $ map snd _exprIcrb) of { _crmBinds -> (case (_exprIcre) of { _creMod -> (case (declMetas_) of { ( _declMetasIcrmt) -> (case (CR.Mod_Mod (CR.nm2RefMpInverse _nm2refNew) moduleNm_ _lhsImodNr (_exprIstackDepthMax + 2 ) _declMetasIcrmt _crmBinds (CR.mkEval _creMod)) of { _lhsOcrm -> (case (_exprInm2refGath) of { _lhsOnm2refGath -> ( _lhsOcrm,_lhsOnm2refGath) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) -- CPat -------------------------------------------------------- {- visit 0: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attributes: refOffset : Int stackDepth : Int synthesized attributes: crp : CR.Pat fldNmL : [HsName] alternatives: alternative Var: child pnm : {HsName} alternative Con: child tag : {CTag} child rest : CPatRest child binds : CPatFldL alternative Int: child int : {Int} alternative Char: child char : {Char} alternative BoolExpr: child cexpr : {CExpr} -} -- 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 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> Int -> ( (CR.Pat),([HsName]),Int,Int) sem_CPat_Var :: HsName -> T_CPat sem_CPat_Var pnm_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (CR.Pat_Con 0) of { _lhsOcrp -> (case ([]) of { _lhsOfldNmL -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) })) sem_CPat_Con :: CTag -> T_CPatRest -> T_CPatFldL -> T_CPat sem_CPat_Con tag_ rest_ binds_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (CR.Pat_Con (ctagTag tag_)) of { _lhsOcrp -> (case (_lhsIstackDepth) of { _restOstackDepth -> (case (_lhsIrefOffset) of { _restOrefOffset -> (case (_lhsIopts) of { _restOopts -> (case (_lhsInm2ref) of { _restOnm2ref -> (case (_lhsImodNr) of { _restOmodNr -> (case (_lhsIlev) of { _restOlev -> (case (rest_ _restOlev _restOmodNr _restOnm2ref _restOopts _restOrefOffset _restOstackDepth) of { ( _restIrefOffset,_restIstackDepth) -> (case (_restIstackDepth) of { _bindsOstackDepth -> (case (_restIrefOffset) of { _bindsOrefOffset -> (case (_lhsIopts) of { _bindsOopts -> (case (_lhsInm2ref) of { _bindsOnm2ref -> (case (_lhsImodNr) of { _bindsOmodNr -> (case (_lhsIlev) of { _bindsOlev -> (case (binds_ _bindsOlev _bindsOmodNr _bindsOnm2ref _bindsOopts _bindsOrefOffset _bindsOstackDepth) of { ( _bindsIfldNmL,_bindsIrefOffset,_bindsIstackDepth) -> (case (_bindsIfldNmL) of { _lhsOfldNmL -> (case (_bindsIrefOffset) of { _lhsOrefOffset -> (case (_bindsIstackDepth) of { _lhsOstackDepth -> ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_CPat_Int :: Int -> T_CPat sem_CPat_Int int_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (CR.Pat_Con 0) of { _lhsOcrp -> (case ([]) of { _lhsOfldNmL -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) })) sem_CPat_Char :: Char -> T_CPat sem_CPat_Char char_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (CR.Pat_Con 0) of { _lhsOcrp -> (case ([]) of { _lhsOfldNmL -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) })) sem_CPat_BoolExpr :: CExpr -> T_CPat sem_CPat_BoolExpr cexpr_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (CR.Pat_Con 0) of { _lhsOcrp -> (case ([]) of { _lhsOfldNmL -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) })) -- CPatFld ----------------------------------------------------- {- visit 0: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attributes: refOffset : Int stackDepth : Int synthesized attribute: fldNmL : [HsName] alternatives: alternative Fld: child lbl : {HsName} child offset : CExpr child bind : CBind child fldAnns : CBindAnnL visit 0: local whatAbove : {WhatExpr} local fldNm : _ local tailCtx : _ -} -- 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 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> Int -> ( ([HsName]),Int,Int) sem_CPatFld_Fld :: HsName -> T_CExpr -> T_CBind -> T_CBindAnnL -> T_CPatFld sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (_lhsIrefOffset) of { _offsetOrefOffset -> (case (offset_) of { ( _offsetIwhatBelow,offset_1) -> (case (ExprIsOther) of { _whatAbove -> (case (_whatAbove) of { _offsetOwhatAbove -> (case (_lhsImodNr) of { _offsetOmodNr -> (case (_lhsIlev) of { _offsetOlev -> (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) -> (case (_offsetIrefOffset) of { _bindOrefOffset -> (case (_lhsImodNr) of { _bindOmodNr -> (case (_lhsIlev) of { _bindOlev -> (case (False) of { _bindOisGlobal -> (case (bind_ _bindOisGlobal _bindOlev _bindOmodNr _bindOrefOffset) of { ( _bindInm,_bindInm2refGath,_bindIrefOffset,bind_1) -> (case (_bindInm) of { _fldNm -> (case ([_fldNm]) of { _lhsOfldNmL -> (case (_bindIrefOffset) of { _fldAnnsOrefOffset -> (case (_lhsIstackDepth) of { _offsetOstackDepth -> (case (TailCtx_Plain) of { _tailCtx -> (case (_tailCtx) of { _offsetOtailCtx -> (case (_lhsIopts) of { _offsetOopts -> (case (_lhsInm2ref) of { _offsetOnm2ref -> (case (EvalCtx_Eval) of { _offsetOevalCtx -> (case (True) of { _offsetOisTopTup -> (case (True) of { _offsetOisTopApp -> (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) -> (case (_offsetIstackDepth) of { _bindOstackDepth -> (case (EvalCtx_None) of { _bindOevalCtx -> (case (_lhsIopts) of { _bindOopts -> (case (_lhsInm2ref) of { _bindOnm2ref -> (case (acoreBindcategPlain) of { _bindOletBindingsCateg -> (case (bind_1 _bindOevalCtx _bindOletBindingsCateg _bindOnm2ref _bindOopts _bindOstackDepth) of { ( _bindIcrb,_bindIrefOffsetMax,_bindIstackDepth,_bindIstackDepthMax) -> (case (_bindIstackDepth) of { _fldAnnsOstackDepth -> (case (_lhsIopts) of { _fldAnnsOopts -> (case (_lhsInm2ref) of { _fldAnnsOnm2ref -> (case (_lhsImodNr) of { _fldAnnsOmodNr -> (case (_lhsIlev) of { _fldAnnsOlev -> (case (fldAnns_ _fldAnnsOlev _fldAnnsOmodNr _fldAnnsOnm2ref _fldAnnsOopts _fldAnnsOrefOffset _fldAnnsOstackDepth) of { ( _fldAnnsIrefOffset,_fldAnnsIstackDepth) -> (case (_fldAnnsIrefOffset) of { _lhsOrefOffset -> (case (_fldAnnsIstackDepth) of { _lhsOstackDepth -> ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) -- CPatFldL ---------------------------------------------------- {- visit 0: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attributes: refOffset : Int stackDepth : Int synthesized attribute: fldNmL : [HsName] 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 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> Int -> ( ([HsName]),Int,Int) sem_CPatFldL_Cons :: T_CPatFld -> T_CPatFldL -> T_CPatFldL sem_CPatFldL_Cons hd_ tl_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (_lhsIstackDepth) of { _hdOstackDepth -> (case (_lhsIrefOffset) of { _hdOrefOffset -> (case (_lhsIlev) of { _hdOlev -> (case (_lhsIopts) of { _hdOopts -> (case (_lhsInm2ref) of { _hdOnm2ref -> (case (_lhsImodNr) of { _hdOmodNr -> (case (hd_ _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOrefOffset _hdOstackDepth) of { ( _hdIfldNmL,_hdIrefOffset,_hdIstackDepth) -> (case (_hdIstackDepth) of { _tlOstackDepth -> (case (_hdIrefOffset) of { _tlOrefOffset -> (case (_lhsIopts) of { _tlOopts -> (case (_lhsInm2ref) of { _tlOnm2ref -> (case (_lhsImodNr) of { _tlOmodNr -> (case (_lhsIlev) of { _tlOlev -> (case (tl_ _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of { ( _tlIfldNmL,_tlIrefOffset,_tlIstackDepth) -> (case (_hdIfldNmL ++ _tlIfldNmL) of { _lhsOfldNmL -> (case (_tlIrefOffset) of { _lhsOrefOffset -> (case (_tlIstackDepth) of { _lhsOstackDepth -> ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_CPatFldL_Nil :: T_CPatFldL sem_CPatFldL_Nil = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case ([]) of { _lhsOfldNmL -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) })) -- CPatRest ---------------------------------------------------- {- visit 0: inherited attributes: lev : Int modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts chained attributes: refOffset : Int stackDepth : Int alternatives: alternative Var: child nm : {HsName} alternative Empty: -} -- 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 = Int -> Int -> (CR.Nm2RefMp) -> EHCOpts -> Int -> Int -> ( Int,Int) sem_CPatRest_Var :: HsName -> T_CPatRest sem_CPatRest_Var nm_ = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOrefOffset,_lhsOstackDepth) }) })) sem_CPatRest_Empty :: T_CPatRest sem_CPatRest_Empty = (\ _lhsIlev _lhsImodNr _lhsInm2ref _lhsIopts _lhsIrefOffset _lhsIstackDepth -> (case (_lhsIrefOffset) of { _lhsOrefOffset -> (case (_lhsIstackDepth) of { _lhsOstackDepth -> ( _lhsOrefOffset,_lhsOstackDepth) }) })) -- CodeAGItf --------------------------------------------------- {- visit 0: inherited attributes: modNr : Int nm2ref : CR.Nm2RefMp opts : EHCOpts synthesized attributes: crm : CR.Mod nm2refGath : CR.Nm2RefMp alternatives: alternative AGItf: child module : CModule -} -- cata sem_CodeAGItf :: CodeAGItf -> T_CodeAGItf sem_CodeAGItf (CodeAGItf_AGItf _module) = (sem_CodeAGItf_AGItf (sem_CModule _module)) -- semantic domain type T_CodeAGItf = Int -> (CR.Nm2RefMp) -> EHCOpts -> ( (CR.Mod),(CR.Nm2RefMp)) data Inh_CodeAGItf = Inh_CodeAGItf {modNr_Inh_CodeAGItf :: !(Int),nm2ref_Inh_CodeAGItf :: !((CR.Nm2RefMp)),opts_Inh_CodeAGItf :: !(EHCOpts)} data Syn_CodeAGItf = Syn_CodeAGItf {crm_Syn_CodeAGItf :: !((CR.Mod)),nm2refGath_Syn_CodeAGItf :: !((CR.Nm2RefMp))} wrap_CodeAGItf :: T_CodeAGItf -> Inh_CodeAGItf -> Syn_CodeAGItf wrap_CodeAGItf sem (Inh_CodeAGItf _lhsImodNr _lhsInm2ref _lhsIopts) = (let ( _lhsOcrm,_lhsOnm2refGath) = sem _lhsImodNr _lhsInm2ref _lhsIopts in (Syn_CodeAGItf _lhsOcrm _lhsOnm2refGath)) sem_CodeAGItf_AGItf :: T_CModule -> T_CodeAGItf sem_CodeAGItf_AGItf module_ = (\ _lhsImodNr _lhsInm2ref _lhsIopts -> (case (_lhsInm2ref) of { _moduleOnm2ref -> (case (_lhsImodNr) of { _moduleOmodNr -> (case (cLevModule) of { _moduleOlev -> (case (_lhsIopts) of { _moduleOopts -> (case (module_ _moduleOlev _moduleOmodNr _moduleOnm2ref _moduleOopts) of { ( _moduleIcrm,_moduleInm2refGath) -> (case (_moduleIcrm) of { _lhsOcrm -> (case (_moduleInm2refGath) of { _lhsOnm2refGath -> ( _lhsOcrm,_lhsOnm2refGath) }) }) }) }) }) }) }))