uhc-light-1.1.9.1: src/UHC/Light/Compiler/Core/Pretty.hs
-- UUAGC 0.9.52.1 (build/103/lib-ehc/UHC/Light/Compiler/Core/Pretty.ag)
module UHC.Light.Compiler.Core.Pretty(ppCModule
, ppCBindL) where
import UHC.Util.Pretty
import UHC.Light.Compiler.Base.HsName.Builtin
import UHC.Light.Compiler.Base.CfgPP
import UHC.Light.Compiler.Opts.Base
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Ty
import UHC.Light.Compiler.Core
import UHC.Light.Compiler.Scanner.Common(coreScanOpts)
import UHC.Light.Compiler.Ty.Pretty
import UHC.Light.Compiler.AnaDomain.Pretty
import qualified Data.Map as Map
import qualified Data.Set as Set
import UHC.Light.Compiler.Foreign.Pretty
ppCModule :: EHCOpts -> {- LamMp -> -} CModule -> PP_Doc
ppCModule opts {- lamMp -} cmod
= let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod))
(Inh_CodeAGItf
{ {- lamMp_Inh_CodeAGItf = lamMp
, -} opts_Inh_CodeAGItf = opts
})
in (pp_Syn_CodeAGItf t)
ppCExpr :: CExpr -> PP_Doc
ppCExpr ce
= let t = wrap_CExpr (sem_CExpr ce)
(Inh_CExpr
{ varPPMp_Inh_CExpr = Map.empty
-- , lamMp_Inh_CExpr = Map.empty
, ppHow_Inh_CExpr = howHor
, opts_Inh_CExpr = emptyEHCOpts
, mlev_Inh_CExpr = metaLevVal
})
in (pp_Syn_CExpr t)
ppCBound :: CBound -> PP_Doc
ppCBound ce
= let t = wrap_CBound (sem_CBound ce)
(Inh_CBound
{ varPPMp_Inh_CBound = Map.empty
-- , lamMp_Inh_CBound = Map.empty
, ppHow_Inh_CBound = howHor
, opts_Inh_CBound = emptyEHCOpts
, nm_Inh_CBound = hsnUnknown
, minMetaLev_Inh_CBound = metaLevVal -- gathMinMetaLev_Syn_CBound t
, mlev_Inh_CBound = metaLevVal -- gathMinMetaLev_Syn_CBound t
})
in (pp_Syn_CBound t)
instance PP CBound where
pp = ppCBound
instance PP CExpr where
pp = ppCExpr
ppCNm' :: EHCOpts -> HsName -> PP_Doc
ppCNm' opts
| CoreOpt_Readable `elem` ehcOptCoreOpts opts = pp
| otherwise = ppCoreNm
ppCNm :: HsName -> PP_Doc
ppCNm = ppCNm' emptyEHCOpts
ppTrack :: Track -> PP_Doc
ppTrack t = text (show t)
ppHole :: UID -> PP_Doc
ppHole i = "<" >|< pp i >|< ">"
ppOptCMetas :: CMetas -> PP_Doc
ppOptCMetas x
= let t = wrap_CMetas (sem_CMetas x)
(Inh_CMetas
{ {- lamMp_Inh_CMetas = Map.empty
, -} opts_Inh_CMetas = emptyEHCOpts
, mlev_Inh_CMetas = metaLevVal
})
in (pp_Syn_CMetas t)
ehcOptDumpMore :: EHCOpts -> Bool
ehcOptDumpMore opts = CoreOpt_DumpAlsoNonParseable `elem` ehcOptCoreOpts opts
alsoMore :: EHCOpts -> (PP_Doc -> PP_Doc) -> PP_Doc -> PP_Doc
alsoMore opts mk
| ehcOptDumpMore opts = mk
| otherwise = id
whenMore :: EHCOpts -> PP_Doc -> PP_Doc
whenMore opts
| ehcOptDumpMore opts = id
| otherwise = const empty
ppCBindL :: CBindL -> PP_Doc
ppCBindL
= ppAssocL
. map (\b -> case b of
CBind_Bind n [CBound_Bind m v] -> (n,v >|< ppOptCMetas m)
CBind_Bind n a -> (n, vlist a)
)
ppSignedInt :: Int -> PP_Doc
ppSignedInt n = " " >#< show n
ppDef :: (PP a, PP b) => a -> b -> PP_Doc
ppDef n v = n >-< indent 2 v
ppDef' :: (PP a, PP b) => a -> b -> PP_Doc
ppDef' n v = ppOr (n >-< indent 2 v) (n >#< v)
-- ppDef' n v = ppDef n v
ppOr :: (PP a, PP b) => a -> b -> PP_Doc
-- ppOr a b = join (a >//< b)
ppOr a b = pp a
ppOr' :: (PP a, PP b) => a -> b -> PP_Doc
-- ppOr' a b = ppOr a b
ppOr' a b = pp a
ppLit :: String -> String -> PP_Doc
ppLit kind val = "#" >|< kind >|< pp (show val)
ppTag :: CTag -> PP_Doc
ppTag t
-- = ppCTag' CfgPP_Plain t
= ppCTag' CfgPP_Core t
ppCurlyList :: (a -> PP_Doc) -> [a] -> PP_Doc
ppCurlyList pL xs = ppListSep "{ " " }" ", " $ map pL xs
type CmbPP = PP_Doc -> PP_Doc -> PP_Doc
data HowPP
= HowPP
{ howDef :: CmbPP
, howAside :: CmbPP
, howList :: [PP_Doc] -> PP_Doc
, howSep :: PP_Doc -> PP_Doc -> PP_Doc -> [PP_Doc] -> PP_Doc
}
howVert = HowPP ppDef (>-<) vlist ppBlock
howHor = HowPP (>#<) (>#<) ppSpaces ppListSep
-- | pp a CBound, for internal use here
ppBound :: EHCOpts -> Bool -> Maybe String -> String -> PP_Doc -> PP_Doc
ppBound opts isSingleNoNm mbLev s pv
= lev $ sep (pp s) pv
where sep | isSingleNoNm = flip const
| otherwise = (>#<)
lev | ehcOptDumpMore opts = maybe id (>#<) mbLev
| otherwise = id
-- | pp vertically with semicolon termination
ppSemiTerminated :: [PP_Doc] -> PP_Doc
ppSemiTerminated = vlist . map ppSemi
type PPBindInfo
= ( String -- separator
, Bool -- outside parenthesization required
, PP_Doc -- actual payload
)
-- CAlt --------------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attribute:
pp : PP_Doc
alternatives:
alternative Alt:
child pat : CPat
child expr : CExpr
-}
-- 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 = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( PP_Doc)
sem_CAlt_Alt :: T_CPat ->
T_CExpr ->
T_CAlt
sem_CAlt_Alt pat_ expr_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _exprOvarPPMp ->
(case (_lhsIppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_lhsImlev) of
{ _exprOmlev ->
(case (_lhsIvarPPMp) of
{ _patOvarPPMp ->
(case (_lhsIppHow) of
{ _patOppHow ->
(case (_lhsIopts) of
{ _patOopts ->
(case (_lhsImlev) of
{ _patOmlev ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case (pat_ _patOmlev _patOopts _patOppHow _patOvarPPMp) of
{ ( _patIfldNmL,_patIpp) ->
(case (howDef _lhsIppHow (_patIpp >#< "->") (_exprIpp)) of
{ _lhsOpp ->
( _lhsOpp) }) }) }) }) }) }) }) }) }) }) }))
-- CAltL -------------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
pp : PP_Doc
ppL : [PP_Doc]
alternatives:
alternative Cons:
child hd : CAlt
child tl : CAltL
alternative Nil:
-}
-- cata
sem_CAltL :: CAltL ->
T_CAltL
sem_CAltL list =
(Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list))
-- semantic domain
type T_CAltL = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( PP_Doc,([PP_Doc]))
sem_CAltL_Cons :: T_CAlt ->
T_CAltL ->
T_CAltL
sem_CAltL_Cons hd_ tl_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _tlOvarPPMp ->
(case (_lhsIppHow) of
{ _tlOppHow ->
(case (_lhsIopts) of
{ _tlOopts ->
(case (_lhsImlev) of
{ _tlOmlev ->
(case (_lhsIvarPPMp) of
{ _hdOvarPPMp ->
(case (_lhsIppHow) of
{ _hdOppHow ->
(case (_lhsIopts) of
{ _hdOopts ->
(case (_lhsImlev) of
{ _hdOmlev ->
(case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of
{ ( _tlIpp,_tlIppL) ->
(case (hd_ _hdOmlev _hdOopts _hdOppHow _hdOvarPPMp) of
{ ( _hdIpp) ->
(case (_hdIpp >-< _tlIpp) of
{ _lhsOpp ->
(case (_hdIpp : _tlIppL) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CAltL_Nil :: T_CAltL
sem_CAltL_Nil =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (empty) of
{ _lhsOpp ->
(case ([]) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }))
-- CBind -------------------------------------------------------
{-
visit 0:
inherited attribute:
mlev : MetaLev
synthesized attribute:
gathMinMetaLev : MetaLev
visit 1:
inherited attributes:
minMetaLev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
nm : HsName
pp : PP_Doc
alternatives:
alternative Bind:
child nm : {HsName}
child bindAspects : CBoundL
-}
-- cata
sem_CBind :: CBind ->
T_CBind
sem_CBind (CBind_Bind _nm _bindAspects) =
(sem_CBind_Bind _nm (sem_CBoundL _bindAspects))
-- semantic domain
type T_CBind = MetaLev ->
( MetaLev,T_CBind_1)
type T_CBind_1 = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( HsName,PP_Doc)
sem_CBind_Bind :: HsName ->
T_CBoundL ->
T_CBind
sem_CBind_Bind nm_ bindAspects_ =
(\ _lhsImlev ->
(case (_lhsImlev) of
{ _bindAspectsOmlev ->
(case (bindAspects_ _bindAspectsOmlev) of
{ ( _bindAspectsIgathMinMetaLev,_bindAspectsIgathVarPPMp,bindAspects_1) ->
(case (_bindAspectsIgathMinMetaLev) of
{ _lhsOgathMinMetaLev ->
(case ((let sem_CBind_Bind_1 :: T_CBind_1
sem_CBind_Bind_1 =
(\ _lhsIminMetaLev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (nm_) of
{ _lhsOnm ->
(case (_lhsIppHow) of
{ _bindAspectsOppHow ->
(case (_lhsIopts) of
{ _bindAspectsOopts ->
(case (_lhsIminMetaLev) of
{ _bindAspectsOminMetaLev ->
(case (Map.union _bindAspectsIgathVarPPMp _lhsIvarPPMp) of
{ _bindAspectsOvarPPMp ->
(case (nm_) of
{ _bindAspectsOnm ->
(case (bindAspects_1 _bindAspectsOminMetaLev _bindAspectsOnm _bindAspectsOopts _bindAspectsOppHow _bindAspectsOvarPPMp) of
{ ( _bindAspectsIpp,_bindAspectsIppBindInfoL,_bindAspectsIppL) ->
(case (let p [ ] = empty
p [a] = a
p as = ppCurlysSemisBlock as
par | or [ m | (_,m,_) <- _bindAspectsIppBindInfoL ] = ppParens
| otherwise = id
isSingleNoNm = hsnIsWild nm_ && length _bindAspectsIppBindInfoL == 1
def | isSingleNoNm = par val
| otherwise = par $ howDef _lhsIppHow (ppCNm' _lhsIopts nm_) val
where val = p $ [ ppBound _lhsIopts isSingleNoNm Nothing s pv | (s,_,pv) <- _bindAspectsIppBindInfoL ]
in def) of
{ _lhsOpp ->
( _lhsOnm,_lhsOpp) }) }) }) }) }) }) }) }))
in sem_CBind_Bind_1)) of
{ ( sem_CBind_1) ->
( _lhsOgathMinMetaLev,sem_CBind_1) }) }) }) }))
-- CBindAnn ----------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attribute:
pp : PP_Doc
alternatives:
alternative Coe:
child coe : {RelevCoe}
visit 0:
local pp : _
-}
-- cata
sem_CBindAnn :: CBindAnn ->
T_CBindAnn
sem_CBindAnn (CBindAnn_Coe _coe) =
(sem_CBindAnn_Coe _coe)
-- semantic domain
type T_CBindAnn = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( PP_Doc)
sem_CBindAnn_Coe :: RelevCoe ->
T_CBindAnn
sem_CBindAnn_Coe coe_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ("~" >#< ppRelevCoe _lhsIvarPPMp coe_) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOpp) }) }))
-- CBindAnnL ---------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
pp : PP_Doc
ppL : [PP_Doc]
alternatives:
alternative Cons:
child hd : CBindAnn
child tl : CBindAnnL
alternative Nil:
-}
-- cata
sem_CBindAnnL :: CBindAnnL ->
T_CBindAnnL
sem_CBindAnnL list =
(Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list))
-- semantic domain
type T_CBindAnnL = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( PP_Doc,([PP_Doc]))
sem_CBindAnnL_Cons :: T_CBindAnn ->
T_CBindAnnL ->
T_CBindAnnL
sem_CBindAnnL_Cons hd_ tl_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _tlOvarPPMp ->
(case (_lhsIvarPPMp) of
{ _hdOvarPPMp ->
(case (_lhsIppHow) of
{ _tlOppHow ->
(case (_lhsIopts) of
{ _tlOopts ->
(case (_lhsImlev) of
{ _tlOmlev ->
(case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of
{ ( _tlIpp,_tlIppL) ->
(case (_lhsIppHow) of
{ _hdOppHow ->
(case (_lhsIopts) of
{ _hdOopts ->
(case (_lhsImlev) of
{ _hdOmlev ->
(case (hd_ _hdOmlev _hdOopts _hdOppHow _hdOvarPPMp) of
{ ( _hdIpp) ->
(case (_hdIpp >-< _tlIpp) of
{ _lhsOpp ->
(case (_hdIpp : _tlIppL) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CBindAnnL_Nil :: T_CBindAnnL
sem_CBindAnnL_Nil =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (empty) of
{ _lhsOpp ->
(case ([]) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }))
-- CBindL ------------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
pp : PP_Doc
ppL : [PP_Doc]
alternatives:
alternative Cons:
child hd : CBind
child tl : CBindL
visit 0:
local minMetaLev : _
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 = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( PP_Doc,([PP_Doc]))
sem_CBindL_Cons :: T_CBind ->
T_CBindL ->
T_CBindL
sem_CBindL_Cons hd_ tl_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _tlOvarPPMp ->
(case (_lhsIppHow) of
{ _tlOppHow ->
(case (_lhsIopts) of
{ _tlOopts ->
(case (_lhsImlev) of
{ _tlOmlev ->
(case (_lhsIvarPPMp) of
{ _hdOvarPPMp ->
(case (_lhsIppHow) of
{ _hdOppHow ->
(case (_lhsIopts) of
{ _hdOopts ->
(case (_lhsImlev) of
{ _hdOmlev ->
(case (hd_ _hdOmlev) of
{ ( _hdIgathMinMetaLev,hd_1) ->
(case (_hdIgathMinMetaLev) of
{ _minMetaLev ->
(case (_minMetaLev) of
{ _hdOminMetaLev ->
(case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of
{ ( _tlIpp,_tlIppL) ->
(case (hd_1 _hdOminMetaLev _hdOopts _hdOppHow _hdOvarPPMp) of
{ ( _hdInm,_hdIpp) ->
(case (_hdIpp >-< _tlIpp) of
{ _lhsOpp ->
(case (_hdIpp : _tlIppL) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CBindL_Nil :: T_CBindL
sem_CBindL_Nil =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (empty) of
{ _lhsOpp ->
(case ([]) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }))
-- CBound ------------------------------------------------------
{-
visit 0:
inherited attribute:
mlev : MetaLev
synthesized attributes:
gathMinMetaLev : MetaLev
gathVarPPMp : VarPPMp
visit 1:
inherited attributes:
minMetaLev : MetaLev
nm : HsName
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
pp : PP_Doc
ppBindInfoL : [PPBindInfo]
alternatives:
alternative Bind:
child bindMeta : CMetas
child expr : CExpr
visit 0:
local mlevHere : _
visit 1:
local ppBound : _
local pp : _
local sep : _
local mustPar : _
intra mlevHere : _
alternative Meta:
child aspectKeyS : {ACoreBindAspectKeyS}
child cmetas : CMetas
visit 1:
local ppBound : _
local pp : _
local sep : _
local mustPar : _
alternative RelevTy:
child aspectKeyS : {ACoreBindAspectKeyS}
child relevTy : {RelevTy}
visit 0:
local _tup1 : _
visit 1:
local tyPP : {PP_Doc}
local ppBound : _
local pp : _
local sep : _
local mustPar : _
intra _tup1 : _
alternative Val:
child aspectKeyS : {ACoreBindAspectKeyS}
child mlev : {MetaLev}
child lbl : {CLbl}
child expr : CExpr
visit 0:
local mlevHere : _
visit 1:
local ppHow : _
local _tup2 : _
local lev : _
local sep : _
local ppBound : _
local pp : _
local mustPar : _
intra mlevHere : _
alternative Ty:
child aspectKeyS : {ACoreBindAspectKeyS}
child ty : {Ty}
visit 0:
local mlevHere : _
visit 1:
local tyPP : {PP_Doc}
local ppBound : _
local pp : _
local sep : _
local mustPar : _
alternative FFE:
child callconv : {FFIWay}
child expEnt : {ForeignEnt}
child expr : CExpr
child ty : {Ty}
visit 1:
local ppBound : _
local pp : _
local sep : _
local mustPar : _
-}
-- 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 = MetaLev ->
( MetaLev,VarPPMp,T_CBound_1)
type T_CBound_1 = MetaLev ->
HsName ->
EHCOpts ->
HowPP ->
VarPPMp ->
( PP_Doc,([PPBindInfo]))
data Inh_CBound = Inh_CBound {minMetaLev_Inh_CBound :: !(MetaLev),mlev_Inh_CBound :: !(MetaLev),nm_Inh_CBound :: !(HsName),opts_Inh_CBound :: !(EHCOpts),ppHow_Inh_CBound :: !(HowPP),varPPMp_Inh_CBound :: !(VarPPMp)}
data Syn_CBound = Syn_CBound {gathMinMetaLev_Syn_CBound :: !(MetaLev),gathVarPPMp_Syn_CBound :: !(VarPPMp),pp_Syn_CBound :: !(PP_Doc),ppBindInfoL_Syn_CBound :: !(([PPBindInfo]))}
wrap_CBound :: T_CBound ->
Inh_CBound ->
Syn_CBound
wrap_CBound sem (Inh_CBound _lhsIminMetaLev _lhsImlev _lhsInm _lhsIopts _lhsIppHow _lhsIvarPPMp) =
(let ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_1) = sem _lhsImlev
( _lhsOpp,_lhsOppBindInfoL) = sem_1 _lhsIminMetaLev _lhsInm _lhsIopts _lhsIppHow _lhsIvarPPMp
in (Syn_CBound _lhsOgathMinMetaLev _lhsOgathVarPPMp _lhsOpp _lhsOppBindInfoL))
sem_CBound_Bind :: T_CMetas ->
T_CExpr ->
T_CBound
sem_CBound_Bind bindMeta_ expr_ =
(\ _lhsImlev ->
(case (_lhsImlev + metaLevVal) of
{ _mlevHere ->
(case (_mlevHere) of
{ _lhsOgathMinMetaLev ->
(case (Map.empty) of
{ _lhsOgathVarPPMp ->
(case ((let sem_CBound_Bind_1 :: T_CBound_1
sem_CBound_Bind_1 =
(\ _lhsIminMetaLev
_lhsInm
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _exprOvarPPMp ->
(case (_lhsIppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_mlevHere) of
{ _exprOmlev ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case (_lhsIopts) of
{ _bindMetaOopts ->
(case (_lhsImlev) of
{ _bindMetaOmlev ->
(case (bindMeta_ _bindMetaOmlev _bindMetaOopts) of
{ ( _bindMetaIpp) ->
(case (whenMore _lhsIopts _bindMetaIpp >-< _exprIpp) of
{ _ppBound ->
(case (_ppBound) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
(case ("=") of
{ _sep ->
(case (False) of
{ _mustPar ->
(case ([(_sep,_mustPar,_ppBound)]) of
{ _lhsOppBindInfoL ->
( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
in sem_CBound_Bind_1)) of
{ ( sem_CBound_1) ->
( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }) }))
sem_CBound_Meta :: ACoreBindAspectKeyS ->
T_CMetas ->
T_CBound
sem_CBound_Meta aspectKeyS_ cmetas_ =
(\ _lhsImlev ->
(case (100) of
{ _lhsOgathMinMetaLev ->
(case (Map.empty) of
{ _lhsOgathVarPPMp ->
(case ((let sem_CBound_Meta_1 :: T_CBound_1
sem_CBound_Meta_1 =
(\ _lhsIminMetaLev
_lhsInm
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIopts) of
{ _cmetasOopts ->
(case (_lhsImlev) of
{ _cmetasOmlev ->
(case (cmetas_ _cmetasOmlev _cmetasOopts) of
{ ( _cmetasIpp) ->
(case (ppACBaspKeyS aspectKeyS_ >#< _cmetasIpp) of
{ _ppBound ->
(case (_ppBound) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
(case ("::M") of
{ _sep ->
(case (False) of
{ _mustPar ->
(case ([(_sep,_mustPar,_ppBound)]) of
{ _lhsOppBindInfoL ->
( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }) }) }))
in sem_CBound_Meta_1)) of
{ ( sem_CBound_1) ->
( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }))
sem_CBound_RelevTy :: ACoreBindAspectKeyS ->
RelevTy ->
T_CBound
sem_CBound_RelevTy aspectKeyS_ relevTy_ =
(\ _lhsImlev ->
(case (100) of
{ _lhsOgathMinMetaLev ->
(case (ppRelevTy Map.empty relevTy_) of
{ __tup1 ->
(case (__tup1) of
{ (_,_lhsOgathVarPPMp) ->
(case ((let sem_CBound_RelevTy_1 :: T_CBound_1
sem_CBound_RelevTy_1 =
(\ _lhsIminMetaLev
_lhsInm
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (__tup1) of
{ (_tyPP,_) ->
(case (ppACBaspKeyS aspectKeyS_ >#< _tyPP) of
{ _ppBound ->
(case (_ppBound) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
(case ("::R") of
{ _sep ->
(case (False) of
{ _mustPar ->
(case ([(_sep,_mustPar,_ppBound)]) of
{ _lhsOppBindInfoL ->
( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }))
in sem_CBound_RelevTy_1)) of
{ ( sem_CBound_1) ->
( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }) }))
sem_CBound_Val :: ACoreBindAspectKeyS ->
MetaLev ->
CLbl ->
T_CExpr ->
T_CBound
sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ =
(\ _lhsImlev ->
(case (_lhsImlev + acbaspkeyMetaLev mlev_ aspectKeyS_) of
{ _mlevHere ->
(case (_mlevHere) of
{ _lhsOgathMinMetaLev ->
(case (Map.empty) of
{ _lhsOgathVarPPMp ->
(case ((let sem_CBound_Val_1 :: T_CBound_1
sem_CBound_Val_1 =
(\ _lhsIminMetaLev
_lhsInm
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _exprOvarPPMp ->
(case (if _mlevHere == _lhsIminMetaLev then _lhsIppHow else howHor) of
{ _ppHow ->
(case (_ppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_mlevHere) of
{ _exprOmlev ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case (let asp | Set.null aspectKeyS_ || ACoreBindAspectKey_Default `Set.member` aspectKeyS_
= id
| otherwise = \x -> ppACBaspKeyS aspectKeyS_ >#< x
lbl | lbl_ == CLbl_None = id
| otherwise = \x -> lbl_ >#< "=" >#< x
in ( asp $ lbl _exprIpp
, "@" ++ show mlev_
, not $ mlev_ == 0 && lbl_ == CLbl_None && Set.null aspectKeyS_
)) of
{ __tup2 ->
(case (__tup2) of
{ (_,_lev,_) ->
(case ((if _mlevHere == _lhsIminMetaLev then "=" else "::") ++ (if _mlevHere > _lhsImlev then _lev else "")) of
{ _sep ->
(case (__tup2) of
{ (_ppBound,_,_) ->
(case (ppBound _lhsIopts True (Just _lev) _sep _ppBound) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
(case (__tup2) of
{ (_,_,_mustPar) ->
(case ([(_sep,_mustPar,_ppBound)]) of
{ _lhsOppBindInfoL ->
( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
in sem_CBound_Val_1)) of
{ ( sem_CBound_1) ->
( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }) }))
sem_CBound_Ty :: ACoreBindAspectKeyS ->
Ty ->
T_CBound
sem_CBound_Ty aspectKeyS_ ty_ =
(\ _lhsImlev ->
(case (_lhsImlev + acbaspkeyMetaLev metaLevTy aspectKeyS_) of
{ _mlevHere ->
(case (_mlevHere) of
{ _lhsOgathMinMetaLev ->
(case (Map.empty) of
{ _lhsOgathVarPPMp ->
(case ((let sem_CBound_Ty_1 :: T_CBound_1
sem_CBound_Ty_1 =
(\ _lhsIminMetaLev
_lhsInm
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (ppTyWithCfg' CfgPP_Core ty_) of
{ _tyPP ->
(case (ppACBaspKeyS aspectKeyS_ >#< _tyPP) of
{ _ppBound ->
(case (_ppBound) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
(case ("::") of
{ _sep ->
(case (False) of
{ _mustPar ->
(case ([(_sep,_mustPar,_ppBound)]) of
{ _lhsOppBindInfoL ->
( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }))
in sem_CBound_Ty_1)) of
{ ( sem_CBound_1) ->
( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }) }))
sem_CBound_FFE :: FFIWay ->
ForeignEnt ->
T_CExpr ->
Ty ->
T_CBound
sem_CBound_FFE callconv_ expEnt_ expr_ ty_ =
(\ _lhsImlev ->
(case (100) of
{ _lhsOgathMinMetaLev ->
(case (Map.empty) of
{ _lhsOgathVarPPMp ->
(case ((let sem_CBound_FFE_1 :: T_CBound_1
sem_CBound_FFE_1 =
(\ _lhsIminMetaLev
_lhsInm
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _exprOvarPPMp ->
(case (_lhsIppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_lhsImlev) of
{ _exprOmlev ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case ("foreignexport" >#< ppCurlysCommasBlock [pp (show callconv_),"\"" >|< expEnt_ >|< "\"",_exprIpp ,ppTyWithCfg' CfgPP_Core ty_]) of
{ _ppBound ->
(case (_ppBound) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
(case ("=") of
{ _sep ->
(case (False) of
{ _mustPar ->
(case ([(_sep,_mustPar,_ppBound)]) of
{ _lhsOppBindInfoL ->
( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }) }) }) }) }))
in sem_CBound_FFE_1)) of
{ ( sem_CBound_1) ->
( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }))
-- CBoundL -----------------------------------------------------
{-
visit 0:
inherited attribute:
mlev : MetaLev
synthesized attributes:
gathMinMetaLev : MetaLev
gathVarPPMp : VarPPMp
visit 1:
inherited attributes:
minMetaLev : MetaLev
nm : HsName
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
pp : PP_Doc
ppBindInfoL : [PPBindInfo]
ppL : [PP_Doc]
alternatives:
alternative Cons:
child hd : CBound
child tl : CBoundL
alternative Nil:
-}
-- cata
sem_CBoundL :: CBoundL ->
T_CBoundL
sem_CBoundL list =
(Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list))
-- semantic domain
type T_CBoundL = MetaLev ->
( MetaLev,VarPPMp,T_CBoundL_1)
type T_CBoundL_1 = MetaLev ->
HsName ->
EHCOpts ->
HowPP ->
VarPPMp ->
( PP_Doc,([PPBindInfo]),([PP_Doc]))
sem_CBoundL_Cons :: T_CBound ->
T_CBoundL ->
T_CBoundL
sem_CBoundL_Cons hd_ tl_ =
(\ _lhsImlev ->
(case (_lhsImlev) of
{ _tlOmlev ->
(case (_lhsImlev) of
{ _hdOmlev ->
(case (tl_ _tlOmlev) of
{ ( _tlIgathMinMetaLev,_tlIgathVarPPMp,tl_1) ->
(case (hd_ _hdOmlev) of
{ ( _hdIgathMinMetaLev,_hdIgathVarPPMp,hd_1) ->
(case (_hdIgathMinMetaLev `min` _tlIgathMinMetaLev) of
{ _lhsOgathMinMetaLev ->
(case (_hdIgathVarPPMp `Map.union` _tlIgathVarPPMp) of
{ _lhsOgathVarPPMp ->
(case ((let sem_CBoundL_Cons_1 :: T_CBoundL_1
sem_CBoundL_Cons_1 =
(\ _lhsIminMetaLev
_lhsInm
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _tlOvarPPMp ->
(case (_lhsIppHow) of
{ _tlOppHow ->
(case (_lhsIopts) of
{ _tlOopts ->
(case (_lhsIminMetaLev) of
{ _tlOminMetaLev ->
(case (_lhsIvarPPMp) of
{ _hdOvarPPMp ->
(case (_lhsIppHow) of
{ _hdOppHow ->
(case (_lhsIopts) of
{ _hdOopts ->
(case (_lhsIminMetaLev) of
{ _hdOminMetaLev ->
(case (_lhsInm) of
{ _tlOnm ->
(case (tl_1 _tlOminMetaLev _tlOnm _tlOopts _tlOppHow _tlOvarPPMp) of
{ ( _tlIpp,_tlIppBindInfoL,_tlIppL) ->
(case (_lhsInm) of
{ _hdOnm ->
(case (hd_1 _hdOminMetaLev _hdOnm _hdOopts _hdOppHow _hdOvarPPMp) of
{ ( _hdIpp,_hdIppBindInfoL) ->
(case (_hdIpp >-< _tlIpp) of
{ _lhsOpp ->
(case (_hdIppBindInfoL ++ _tlIppBindInfoL) of
{ _lhsOppBindInfoL ->
(case (_hdIpp : _tlIppL) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppBindInfoL,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
in sem_CBoundL_Cons_1)) of
{ ( sem_CBoundL_1) ->
( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBoundL_1) }) }) }) }) }) }) }))
sem_CBoundL_Nil :: T_CBoundL
sem_CBoundL_Nil =
(\ _lhsImlev ->
(case (100) of
{ _lhsOgathMinMetaLev ->
(case (Map.empty) of
{ _lhsOgathVarPPMp ->
(case ((let sem_CBoundL_Nil_1 :: T_CBoundL_1
sem_CBoundL_Nil_1 =
(\ _lhsIminMetaLev
_lhsInm
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (empty) of
{ _lhsOpp ->
(case ([]) of
{ _lhsOppBindInfoL ->
(case ([]) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppBindInfoL,_lhsOppL) }) }) }))
in sem_CBoundL_Nil_1)) of
{ ( sem_CBoundL_1) ->
( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBoundL_1) }) }) }))
-- CDataCon ----------------------------------------------------
{-
visit 0:
inherited attributes:
opts : EHCOpts
ppHow : HowPP
synthesized attribute:
pp : PP_Doc
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 = EHCOpts ->
HowPP ->
( PP_Doc)
sem_CDataCon_Con :: HsName ->
Int ->
Int ->
T_CDataCon
sem_CDataCon_Con conNm_ tagNr_ arity_ =
(\ _lhsIopts
_lhsIppHow ->
(case (ppCNm' _lhsIopts conNm_ >#< "=" >#< ppCurlysCommas [pp tagNr_, pp arity_]) of
{ _lhsOpp ->
( _lhsOpp) }))
-- CDataConL ---------------------------------------------------
{-
visit 0:
inherited attributes:
opts : EHCOpts
ppHow : HowPP
synthesized attributes:
pp : PP_Doc
ppL : [PP_Doc]
alternatives:
alternative Cons:
child hd : CDataCon
child tl : CDataConL
alternative Nil:
-}
-- cata
sem_CDataConL :: CDataConL ->
T_CDataConL
sem_CDataConL list =
(Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list))
-- semantic domain
type T_CDataConL = EHCOpts ->
HowPP ->
( PP_Doc,([PP_Doc]))
sem_CDataConL_Cons :: T_CDataCon ->
T_CDataConL ->
T_CDataConL
sem_CDataConL_Cons hd_ tl_ =
(\ _lhsIopts
_lhsIppHow ->
(case (_lhsIopts) of
{ _tlOopts ->
(case (_lhsIopts) of
{ _hdOopts ->
(case (_lhsIppHow) of
{ _tlOppHow ->
(case (tl_ _tlOopts _tlOppHow) of
{ ( _tlIpp,_tlIppL) ->
(case (_lhsIppHow) of
{ _hdOppHow ->
(case (hd_ _hdOopts _hdOppHow) of
{ ( _hdIpp) ->
(case (_hdIpp >-< _tlIpp) of
{ _lhsOpp ->
(case (_hdIpp : _tlIppL) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }))
sem_CDataConL_Nil :: T_CDataConL
sem_CDataConL_Nil =
(\ _lhsIopts
_lhsIppHow ->
(case (empty) of
{ _lhsOpp ->
(case ([]) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }))
-- CDeclMeta ---------------------------------------------------
{-
visit 0:
inherited attributes:
opts : EHCOpts
ppHow : HowPP
synthesized attribute:
pp : PP_Doc
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 = EHCOpts ->
HowPP ->
( PP_Doc)
sem_CDeclMeta_Data :: HsName ->
T_CDataConL ->
T_CDeclMeta
sem_CDeclMeta_Data tyNm_ dataCons_ =
(\ _lhsIopts
_lhsIppHow ->
(case (_lhsIopts) of
{ _dataConsOopts ->
(case (_lhsIppHow) of
{ _dataConsOppHow ->
(case (dataCons_ _dataConsOopts _dataConsOppHow) of
{ ( _dataConsIpp,_dataConsIppL) ->
(case (howDef _lhsIppHow ("data" >#< ppCNm' _lhsIopts tyNm_) ("=" >#< ppBlockWithStrings "" "" ", " _dataConsIppL)) of
{ _lhsOpp ->
( _lhsOpp) }) }) }) }))
-- CDeclMetaL --------------------------------------------------
{-
visit 0:
inherited attributes:
opts : EHCOpts
ppHow : HowPP
synthesized attributes:
pp : PP_Doc
ppL : [PP_Doc]
alternatives:
alternative Cons:
child hd : CDeclMeta
child tl : CDeclMetaL
alternative Nil:
-}
-- cata
sem_CDeclMetaL :: CDeclMetaL ->
T_CDeclMetaL
sem_CDeclMetaL list =
(Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list))
-- semantic domain
type T_CDeclMetaL = EHCOpts ->
HowPP ->
( PP_Doc,([PP_Doc]))
sem_CDeclMetaL_Cons :: T_CDeclMeta ->
T_CDeclMetaL ->
T_CDeclMetaL
sem_CDeclMetaL_Cons hd_ tl_ =
(\ _lhsIopts
_lhsIppHow ->
(case (_lhsIppHow) of
{ _tlOppHow ->
(case (_lhsIopts) of
{ _tlOopts ->
(case (_lhsIppHow) of
{ _hdOppHow ->
(case (_lhsIopts) of
{ _hdOopts ->
(case (tl_ _tlOopts _tlOppHow) of
{ ( _tlIpp,_tlIppL) ->
(case (hd_ _hdOopts _hdOppHow) of
{ ( _hdIpp) ->
(case (_hdIpp >-< _tlIpp) of
{ _lhsOpp ->
(case (_hdIpp : _tlIppL) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }))
sem_CDeclMetaL_Nil :: T_CDeclMetaL
sem_CDeclMetaL_Nil =
(\ _lhsIopts
_lhsIppHow ->
(case (empty) of
{ _lhsOpp ->
(case ([]) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }))
-- CExport -----------------------------------------------------
{-
visit 0:
inherited attribute:
opts : EHCOpts
synthesized attribute:
pp : PP_Doc
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 = EHCOpts ->
( PP_Doc)
sem_CExport_Export :: HsName ->
T_CExport
sem_CExport_Export nm_ =
(\ _lhsIopts ->
(case ("export" >#< ppCNm' _lhsIopts nm_) of
{ _lhsOpp ->
( _lhsOpp) }))
sem_CExport_ExportData :: HsName ->
(Maybe [HsName]) ->
T_CExport
sem_CExport_ExportData nm_ mbConNmL_ =
(\ _lhsIopts ->
(case ("export data" >#< ppMbPost ppParensCommas mbConNmL_ (ppCNm' _lhsIopts nm_)) of
{ _lhsOpp ->
( _lhsOpp) }))
-- CExportL ----------------------------------------------------
{-
visit 0:
inherited attribute:
opts : EHCOpts
synthesized attributes:
pp : PP_Doc
ppL : [PP_Doc]
alternatives:
alternative Cons:
child hd : CExport
child tl : CExportL
alternative Nil:
-}
-- cata
sem_CExportL :: CExportL ->
T_CExportL
sem_CExportL list =
(Prelude.foldr sem_CExportL_Cons sem_CExportL_Nil (Prelude.map sem_CExport list))
-- semantic domain
type T_CExportL = EHCOpts ->
( PP_Doc,([PP_Doc]))
sem_CExportL_Cons :: T_CExport ->
T_CExportL ->
T_CExportL
sem_CExportL_Cons hd_ tl_ =
(\ _lhsIopts ->
(case (_lhsIopts) of
{ _tlOopts ->
(case (_lhsIopts) of
{ _hdOopts ->
(case (tl_ _tlOopts) of
{ ( _tlIpp,_tlIppL) ->
(case (hd_ _hdOopts) of
{ ( _hdIpp) ->
(case (_hdIpp >-< _tlIpp) of
{ _lhsOpp ->
(case (_hdIpp : _tlIppL) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }) }) }) }) }))
sem_CExportL_Nil :: T_CExportL
sem_CExportL_Nil =
(\ _lhsIopts ->
(case (empty) of
{ _lhsOpp ->
(case ([]) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }))
-- CExpr -------------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
appArgPPL : [PP_Doc]
appFunPP : PP_Doc
lamArgPPL : [PP_Doc]
lamBodyPP : PP_Doc
pp : PP_Doc
alternatives:
alternative Var:
child ref : {ACoreBindRef}
visit 0:
local pp : _
alternative Int:
child int : {Int}
visit 0:
local pp : _
alternative Char:
child char : {Char}
visit 0:
local pp : _
alternative String:
child str : {String}
visit 0:
local pp : _
alternative Integer:
child integer : {Integer}
visit 0:
local pp : _
alternative Tup:
child tag : {CTag}
visit 0:
local pp : _
alternative Let:
child categ : {CBindCateg}
child binds : CBindL
child body : CExpr
visit 0:
local ppCateg : _
local pp : _
alternative App:
child func : CExpr
child arg : CBound
visit 0:
local minMetaLev : _
local appArgPPL : _
local appFunPP : _
local pp : _
alternative Lam:
child bind : CBind
child body : CExpr
visit 0:
local minMetaLev : _
local lamArgPPL : _
local lamBodyPP : _
local pp : _
alternative Case:
child expr : CExpr
child alts : CAltL
child dflt : CExpr
visit 0:
local pp : _
alternative CaseAltFail:
child failReason : {CaseAltFailReason}
child errorExpr : CExpr
visit 0:
local pp : _
alternative TupDel:
child expr : CExpr
child tag : {CTag}
child nm : {HsName}
child offset : CExpr
visit 0:
local pp : _
alternative TupIns:
child expr : CExpr
child tag : {CTag}
child nm : {HsName}
child offset : CExpr
child fldExpr : CExpr
visit 0:
local pp : _
alternative TupUpd:
child expr : CExpr
child tag : {CTag}
child nm : {HsName}
child offset : CExpr
child fldExpr : CExpr
visit 0:
local pp : _
alternative FFI:
child callconv : {FFIWay}
child safety : {String}
child impEnt : {ForeignEnt}
child ty : {Ty}
visit 0:
local ppent : _
local pp : _
alternative Dbg:
child info : {String}
visit 0:
local pp : _
alternative Hole:
child uid : {UID}
visit 0:
local pp : _
alternative HoleLet:
child bindsUid : {UID}
child body : CExpr
visit 0:
local pp : _
alternative CoeArg:
visit 0:
local pp : _
alternative ImplsApp:
child func : CExpr
child uid : {ImplsVarId}
visit 0:
local pp : _
alternative ImplsLam:
child uid : {ImplsVarId}
child body : CExpr
visit 0:
local pp : _
alternative Ann:
child ann : CExprAnn
child expr : CExpr
visit 0:
local pp : _
-}
-- 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 = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( ([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc)
data Inh_CExpr = Inh_CExpr {mlev_Inh_CExpr :: !(MetaLev),opts_Inh_CExpr :: !(EHCOpts),ppHow_Inh_CExpr :: !(HowPP),varPPMp_Inh_CExpr :: !(VarPPMp)}
data Syn_CExpr = Syn_CExpr {appArgPPL_Syn_CExpr :: !(([PP_Doc])),appFunPP_Syn_CExpr :: !(PP_Doc),lamArgPPL_Syn_CExpr :: !(([PP_Doc])),lamBodyPP_Syn_CExpr :: !(PP_Doc),pp_Syn_CExpr :: !(PP_Doc)}
wrap_CExpr :: T_CExpr ->
Inh_CExpr ->
Syn_CExpr
wrap_CExpr sem (Inh_CExpr _lhsImlev _lhsIopts _lhsIppHow _lhsIvarPPMp) =
(let ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) = sem _lhsImlev _lhsIopts _lhsIppHow _lhsIvarPPMp
in (Syn_CExpr _lhsOappArgPPL _lhsOappFunPP _lhsOlamArgPPL _lhsOlamBodyPP _lhsOpp))
sem_CExpr_Var :: ACoreBindRef ->
T_CExpr
sem_CExpr_Var ref_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (ppACoreBindRef (ppCNm' _lhsIopts) ref_) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }))
sem_CExpr_Int :: Int ->
T_CExpr
sem_CExpr_Int int_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (ppLit "Int" (show int_)) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }))
sem_CExpr_Char :: Char ->
T_CExpr
sem_CExpr_Char char_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (ppLit "Char" [char_]) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }))
sem_CExpr_String :: String ->
T_CExpr
sem_CExpr_String str_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (ppLit "String" str_) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }))
sem_CExpr_Integer :: Integer ->
T_CExpr
sem_CExpr_Integer integer_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (ppLit "Integer" (show integer_)) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }))
sem_CExpr_Tup :: CTag ->
T_CExpr
sem_CExpr_Tup tag_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case ("#Tag" >#< ppTag tag_) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }))
sem_CExpr_Let :: CBindCateg ->
T_CBindL ->
T_CExpr ->
T_CExpr
sem_CExpr_Let categ_ binds_ body_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _bodyOvarPPMp ->
(case (_lhsIppHow) of
{ _bodyOppHow ->
(case (_lhsIopts) of
{ _bodyOopts ->
(case (_lhsImlev) of
{ _bodyOmlev ->
(case (_lhsIvarPPMp) of
{ _bindsOvarPPMp ->
(case (_lhsIppHow) of
{ _bindsOppHow ->
(case (_lhsIopts) of
{ _bindsOopts ->
(case (_lhsImlev) of
{ _bindsOmlev ->
(case (case categ_ of
CBindCateg_Rec -> pp " rec"
CBindCateg_Strict -> pp " !"
CBindCateg_FFI -> pp " foreign"
CBindCateg_FFE -> pp " foreignexport"
_ -> empty) of
{ _ppCateg ->
(case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of
{ ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) ->
(case (binds_ _bindsOmlev _bindsOopts _bindsOppHow _bindsOvarPPMp) of
{ ( _bindsIpp,_bindsIppL) ->
(case (howDef _lhsIppHow ("let" >|< _ppCateg) (ppSemiTerminated _bindsIppL) >#< "in" >-< _bodyIpp) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_App :: T_CExpr ->
T_CBound ->
T_CExpr
sem_CExpr_App func_ arg_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _argOvarPPMp ->
(case (_lhsIppHow) of
{ _argOppHow ->
(case (_lhsIopts) of
{ _argOopts ->
(case (_lhsImlev) of
{ _argOmlev ->
(case (arg_ _argOmlev) of
{ ( _argIgathMinMetaLev,_argIgathVarPPMp,arg_1) ->
(case (_argIgathMinMetaLev) of
{ _minMetaLev ->
(case (_minMetaLev) of
{ _argOminMetaLev ->
(case (_lhsIvarPPMp) of
{ _funcOvarPPMp ->
(case (_lhsIppHow) of
{ _funcOppHow ->
(case (_lhsIopts) of
{ _funcOopts ->
(case (_lhsImlev) of
{ _funcOmlev ->
(case (hsnUnknown) of
{ _argOnm ->
(case (arg_1 _argOminMetaLev _argOnm _argOopts _argOppHow _argOvarPPMp) of
{ ( _argIpp,_argIppBindInfoL) ->
(case (func_ _funcOmlev _funcOopts _funcOppHow _funcOvarPPMp) of
{ ( _funcIappArgPPL,_funcIappFunPP,_funcIlamArgPPL,_funcIlamBodyPP,_funcIpp) ->
(case ((_argIpp) : _funcIappArgPPL) of
{ _appArgPPL ->
(case (_appArgPPL) of
{ _lhsOappArgPPL ->
(case (_funcIappFunPP) of
{ _appFunPP ->
(case (_appFunPP) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (let args = reverse $ map ppParens $ _appArgPPL
fun = ppParens _appFunPP
in howDef _lhsIppHow fun (foldr1 (howAside _lhsIppHow) args)) of
{ _pp ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_Lam :: T_CBind ->
T_CExpr ->
T_CExpr
sem_CExpr_Lam bind_ body_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _bodyOvarPPMp ->
(case (_lhsIppHow) of
{ _bodyOppHow ->
(case (_lhsIopts) of
{ _bodyOopts ->
(case (_lhsImlev) of
{ _bodyOmlev ->
(case (_lhsIvarPPMp) of
{ _bindOvarPPMp ->
(case (_lhsIopts) of
{ _bindOopts ->
(case (_lhsImlev) of
{ _bindOmlev ->
(case (bind_ _bindOmlev) of
{ ( _bindIgathMinMetaLev,bind_1) ->
(case (_bindIgathMinMetaLev) of
{ _minMetaLev ->
(case (_minMetaLev) of
{ _bindOminMetaLev ->
(case (howHor) of
{ _bindOppHow ->
(case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of
{ ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) ->
(case (bind_1 _bindOminMetaLev _bindOopts _bindOppHow _bindOvarPPMp) of
{ ( _bindInm,_bindIpp) ->
(case (_bindIpp : _bodyIlamArgPPL) of
{ _lamArgPPL ->
(case (_bodyIlamBodyPP) of
{ _lamBodyPP ->
(case (howDef _lhsIppHow ("\\" >|< ppSpaces _lamArgPPL >#< "->") (_lamBodyPP)) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case (_lamArgPPL) of
{ _lhsOlamArgPPL ->
(case (_lamBodyPP) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_Case :: T_CExpr ->
T_CAltL ->
T_CExpr ->
T_CExpr
sem_CExpr_Case expr_ alts_ dflt_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _dfltOvarPPMp ->
(case (_lhsIppHow) of
{ _dfltOppHow ->
(case (_lhsIopts) of
{ _dfltOopts ->
(case (_lhsImlev) of
{ _dfltOmlev ->
(case (_lhsIvarPPMp) of
{ _altsOvarPPMp ->
(case (_lhsIppHow) of
{ _altsOppHow ->
(case (_lhsIopts) of
{ _altsOopts ->
(case (_lhsImlev) of
{ _altsOmlev ->
(case (_lhsIvarPPMp) of
{ _exprOvarPPMp ->
(case (_lhsIppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_lhsImlev) of
{ _exprOmlev ->
(case (dflt_ _dfltOmlev _dfltOopts _dfltOppHow _dfltOvarPPMp) of
{ ( _dfltIappArgPPL,_dfltIappFunPP,_dfltIlamArgPPL,_dfltIlamBodyPP,_dfltIpp) ->
(case (alts_ _altsOmlev _altsOopts _altsOppHow _altsOvarPPMp) of
{ ( _altsIpp,_altsIppL) ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case ("case" >#< _exprIpp >#< "of"
>-< indent 1 (ppSemiTerminated _altsIppL >-< ppSemiTerminated [howDef _lhsIppHow (pp "default") _dfltIpp])) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_CaseAltFail :: CaseAltFailReason ->
T_CExpr ->
T_CExpr
sem_CExpr_CaseAltFail failReason_ errorExpr_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _errorExprOvarPPMp ->
(case (_lhsIppHow) of
{ _errorExprOppHow ->
(case (_lhsIopts) of
{ _errorExprOopts ->
(case (_lhsImlev) of
{ _errorExprOmlev ->
(case (errorExpr_ _errorExprOmlev _errorExprOopts _errorExprOppHow _errorExprOvarPPMp) of
{ ( _errorExprIappArgPPL,_errorExprIappFunPP,_errorExprIlamArgPPL,_errorExprIlamBodyPP,_errorExprIpp) ->
(case (pp "FAIL" >#< failReason_ >-< whenMore _lhsIopts (indent 2 $ ppCurlys _errorExprIpp)) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_TupDel :: T_CExpr ->
CTag ->
HsName ->
T_CExpr ->
T_CExpr
sem_CExpr_TupDel expr_ tag_ nm_ offset_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _offsetOvarPPMp ->
(case (_lhsIppHow) of
{ _offsetOppHow ->
(case (_lhsIopts) of
{ _offsetOopts ->
(case (_lhsImlev) of
{ _offsetOmlev ->
(case (_lhsIvarPPMp) of
{ _exprOvarPPMp ->
(case (_lhsIppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_lhsImlev) of
{ _exprOmlev ->
(case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of
{ ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case (howDef _lhsIppHow (ppParens _exprIpp) ("-=" >|< ppCurlysCommas' [ppTag tag_,_offsetIpp,ppCNm' _lhsIopts nm_])) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_TupIns :: T_CExpr ->
CTag ->
HsName ->
T_CExpr ->
T_CExpr ->
T_CExpr
sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _fldExprOvarPPMp ->
(case (_lhsIppHow) of
{ _fldExprOppHow ->
(case (_lhsIopts) of
{ _fldExprOopts ->
(case (_lhsImlev) of
{ _fldExprOmlev ->
(case (_lhsIvarPPMp) of
{ _offsetOvarPPMp ->
(case (_lhsIppHow) of
{ _offsetOppHow ->
(case (_lhsIopts) of
{ _offsetOopts ->
(case (_lhsImlev) of
{ _offsetOmlev ->
(case (_lhsIvarPPMp) of
{ _exprOvarPPMp ->
(case (_lhsIppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_lhsImlev) of
{ _exprOmlev ->
(case (fldExpr_ _fldExprOmlev _fldExprOopts _fldExprOppHow _fldExprOvarPPMp) of
{ ( _fldExprIappArgPPL,_fldExprIappFunPP,_fldExprIlamArgPPL,_fldExprIlamBodyPP,_fldExprIpp) ->
(case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of
{ ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case (howDef _lhsIppHow (ppParens _exprIpp) (howDef _lhsIppHow ("+=" >|< ppCurlysCommas' [ppTag tag_,_offsetIpp,ppCNm' _lhsIopts nm_]) (ppParens _fldExprIpp))) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_TupUpd :: T_CExpr ->
CTag ->
HsName ->
T_CExpr ->
T_CExpr ->
T_CExpr
sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _fldExprOvarPPMp ->
(case (_lhsIppHow) of
{ _fldExprOppHow ->
(case (_lhsIopts) of
{ _fldExprOopts ->
(case (_lhsImlev) of
{ _fldExprOmlev ->
(case (_lhsIvarPPMp) of
{ _offsetOvarPPMp ->
(case (_lhsIppHow) of
{ _offsetOppHow ->
(case (_lhsIopts) of
{ _offsetOopts ->
(case (_lhsImlev) of
{ _offsetOmlev ->
(case (_lhsIvarPPMp) of
{ _exprOvarPPMp ->
(case (_lhsIppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_lhsImlev) of
{ _exprOmlev ->
(case (fldExpr_ _fldExprOmlev _fldExprOopts _fldExprOppHow _fldExprOvarPPMp) of
{ ( _fldExprIappArgPPL,_fldExprIappFunPP,_fldExprIlamArgPPL,_fldExprIlamBodyPP,_fldExprIpp) ->
(case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of
{ ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case (howDef _lhsIppHow (ppParens _exprIpp) (howDef _lhsIppHow (":=" >|< ppCurlysCommas' [ppTag tag_,_offsetIpp,ppCNm' _lhsIopts nm_]) (ppParens _fldExprIpp))) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_FFI :: FFIWay ->
String ->
ForeignEnt ->
Ty ->
T_CExpr
sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case ("\"" >|< impEnt_ >|< "\"") of
{ _ppent ->
(case (("foreign" >#< ppCurlysCommasBlock [pp (show callconv_),pp (show safety_),_ppent,ppTyWithCfg' CfgPP_Core ty_])) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }))
sem_CExpr_Dbg :: String ->
T_CExpr
sem_CExpr_Dbg info_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (ppParens $ "<<DBG:" >#< info_ >#< ">>") of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }))
sem_CExpr_Hole :: UID ->
T_CExpr
sem_CExpr_Hole uid_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (ppHole uid_) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }))
sem_CExpr_HoleLet :: UID ->
T_CExpr ->
T_CExpr
sem_CExpr_HoleLet bindsUid_ body_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _bodyOvarPPMp ->
(case (_lhsIppHow) of
{ _bodyOppHow ->
(case (_lhsIopts) of
{ _bodyOopts ->
(case (_lhsImlev) of
{ _bodyOmlev ->
(case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of
{ ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) ->
(case ("let --" >#< ppHole bindsUid_ >-< howDef _lhsIppHow (pp "in") _bodyIpp) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_CoeArg :: T_CExpr
sem_CExpr_CoeArg =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (pp "<_>") of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }))
sem_CExpr_ImplsApp :: T_CExpr ->
ImplsVarId ->
T_CExpr
sem_CExpr_ImplsApp func_ uid_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _funcOvarPPMp ->
(case (_lhsIppHow) of
{ _funcOppHow ->
(case (_lhsIopts) of
{ _funcOopts ->
(case (_lhsImlev) of
{ _funcOmlev ->
(case (func_ _funcOmlev _funcOopts _funcOppHow _funcOvarPPMp) of
{ ( _funcIappArgPPL,_funcIappFunPP,_funcIlamArgPPL,_funcIlamBodyPP,_funcIpp) ->
(case (howDef _lhsIppHow (_funcIpp >#< "-- Impl") (ppHole uid_)) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_ImplsLam :: ImplsVarId ->
T_CExpr ->
T_CExpr
sem_CExpr_ImplsLam uid_ body_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _bodyOvarPPMp ->
(case (_lhsIppHow) of
{ _bodyOppHow ->
(case (_lhsIopts) of
{ _bodyOopts ->
(case (_lhsImlev) of
{ _bodyOmlev ->
(case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of
{ ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) ->
(case (howDef _lhsIppHow ("\\" >|< ppHole uid_ >#< "-- Impl") ("->" >#< _bodyIpp)) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }))
sem_CExpr_Ann :: T_CExprAnn ->
T_CExpr ->
T_CExpr
sem_CExpr_Ann ann_ expr_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOappArgPPL ->
(case (_lhsIvarPPMp) of
{ _exprOvarPPMp ->
(case (_lhsIppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_lhsImlev) of
{ _exprOmlev ->
(case (_lhsIvarPPMp) of
{ _annOvarPPMp ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case (_lhsIppHow) of
{ _annOppHow ->
(case (_lhsIopts) of
{ _annOopts ->
(case (_lhsImlev) of
{ _annOmlev ->
(case (ann_ _annOmlev _annOopts _annOppHow _annOvarPPMp) of
{ ( _annIpp) ->
(case (alsoMore _lhsIopts (\x -> ppParens (x >#< _annIpp)) _exprIpp) of
{ _pp ->
(case (_pp) of
{ _lhsOappFunPP ->
(case ([]) of
{ _lhsOlamArgPPL ->
(case (_pp) of
{ _lhsOlamBodyPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
-- CExprAnn ----------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attribute:
pp : PP_Doc
alternatives:
alternative Ty:
child ty : {Ty}
visit 0:
local pp : _
alternative Coe:
child coe : {RelevCoe}
visit 0:
local pp : _
alternative Debug:
child info : {String}
visit 0:
local pp : _
-}
-- 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 = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( PP_Doc)
sem_CExprAnn_Ty :: Ty ->
T_CExprAnn
sem_CExprAnn_Ty ty_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ("::" >#< ppTyWithCfg' CfgPP_Plain ty_) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOpp) }) }))
sem_CExprAnn_Coe :: RelevCoe ->
T_CExprAnn
sem_CExprAnn_Coe coe_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ("~" >#< ppRelevCoe _lhsIvarPPMp coe_) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOpp) }) }))
sem_CExprAnn_Debug :: String ->
T_CExprAnn
sem_CExprAnn_Debug info_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (ppCmt $ pp info_) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOpp) }) }))
-- CImport -----------------------------------------------------
{-
visit 0:
inherited attribute:
opts : EHCOpts
synthesized attribute:
pp : PP_Doc
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 = EHCOpts ->
( PP_Doc)
sem_CImport_Import :: HsName ->
T_CImport
sem_CImport_Import nm_ =
(\ _lhsIopts ->
(case ("import" >#< ppCNm' _lhsIopts nm_) of
{ _lhsOpp ->
( _lhsOpp) }))
-- CImportL ----------------------------------------------------
{-
visit 0:
inherited attribute:
opts : EHCOpts
synthesized attributes:
pp : PP_Doc
ppL : [PP_Doc]
alternatives:
alternative Cons:
child hd : CImport
child tl : CImportL
alternative Nil:
-}
-- cata
sem_CImportL :: CImportL ->
T_CImportL
sem_CImportL list =
(Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list))
-- semantic domain
type T_CImportL = EHCOpts ->
( PP_Doc,([PP_Doc]))
sem_CImportL_Cons :: T_CImport ->
T_CImportL ->
T_CImportL
sem_CImportL_Cons hd_ tl_ =
(\ _lhsIopts ->
(case (_lhsIopts) of
{ _tlOopts ->
(case (_lhsIopts) of
{ _hdOopts ->
(case (tl_ _tlOopts) of
{ ( _tlIpp,_tlIppL) ->
(case (hd_ _hdOopts) of
{ ( _hdIpp) ->
(case (_hdIpp >-< _tlIpp) of
{ _lhsOpp ->
(case (_hdIpp : _tlIppL) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }) }) }) }) }))
sem_CImportL_Nil :: T_CImportL
sem_CImportL_Nil =
(\ _lhsIopts ->
(case (empty) of
{ _lhsOpp ->
(case ([]) of
{ _lhsOppL ->
( _lhsOpp,_lhsOppL) }) }))
-- CMetaBind ---------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
synthesized attribute:
pp : PP_Doc
alternatives:
alternative Plain:
visit 0:
local pp : _
alternative Function0:
visit 0:
local pp : _
alternative Function1:
visit 0:
local pp : _
alternative Apply0:
visit 0:
local pp : _
-}
-- 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 = MetaLev ->
EHCOpts ->
( PP_Doc)
sem_CMetaBind_Plain :: T_CMetaBind
sem_CMetaBind_Plain =
(\ _lhsImlev
_lhsIopts ->
(case (pp "BINDPLAIN") of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOpp) }) }))
sem_CMetaBind_Function0 :: T_CMetaBind
sem_CMetaBind_Function0 =
(\ _lhsImlev
_lhsIopts ->
(case (pp "BINDFUNCTION0") of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOpp) }) }))
sem_CMetaBind_Function1 :: T_CMetaBind
sem_CMetaBind_Function1 =
(\ _lhsImlev
_lhsIopts ->
(case (pp "BINDFUNCTION1") of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOpp) }) }))
sem_CMetaBind_Apply0 :: T_CMetaBind
sem_CMetaBind_Apply0 =
(\ _lhsImlev
_lhsIopts ->
(case (pp "BINDAPPLY0") of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOpp) }) }))
-- CMetaVal ----------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
synthesized attributes:
optPP : PP_Doc
pp : PP_Doc
alternatives:
alternative Val:
visit 0:
local optPP : _
local pp : _
alternative Dict:
visit 0:
local pp : _
local optPP : _
alternative DictClass:
child tracks : {[Track]}
visit 0:
local pp : _
local optPP : _
alternative DictInstance:
child tracks : {[Track]}
visit 0:
local pp : _
local optPP : _
alternative Track:
child track : {Track}
visit 0:
local pp : _
local optPP : _
-}
-- 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 = MetaLev ->
EHCOpts ->
( PP_Doc,PP_Doc)
sem_CMetaVal_Val :: T_CMetaVal
sem_CMetaVal_Val =
(\ _lhsImlev
_lhsIopts ->
(case (empty) of
{ _optPP ->
(case (_optPP) of
{ _lhsOoptPP ->
(case (pp "VAL") of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOoptPP,_lhsOpp) }) }) }) }))
sem_CMetaVal_Dict :: T_CMetaVal
sem_CMetaVal_Dict =
(\ _lhsImlev
_lhsIopts ->
(case (pp "DICT") of
{ _pp ->
(case (" :" >#< _pp) of
{ _optPP ->
(case (_optPP) of
{ _lhsOoptPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOoptPP,_lhsOpp) }) }) }) }))
sem_CMetaVal_DictClass :: ([Track]) ->
T_CMetaVal
sem_CMetaVal_DictClass tracks_ =
(\ _lhsImlev
_lhsIopts ->
(case (pp "DICTCLASS" >|< ppCurlyList ppTrack tracks_) of
{ _pp ->
(case (" :" >#< _pp) of
{ _optPP ->
(case (_optPP) of
{ _lhsOoptPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOoptPP,_lhsOpp) }) }) }) }))
sem_CMetaVal_DictInstance :: ([Track]) ->
T_CMetaVal
sem_CMetaVal_DictInstance tracks_ =
(\ _lhsImlev
_lhsIopts ->
(case (pp "DICTINSTANCE" >|< ppCurlyList ppTrack tracks_) of
{ _pp ->
(case (" :" >#< _pp) of
{ _optPP ->
(case (_optPP) of
{ _lhsOoptPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOoptPP,_lhsOpp) }) }) }) }))
sem_CMetaVal_Track :: Track ->
T_CMetaVal
sem_CMetaVal_Track track_ =
(\ _lhsImlev
_lhsIopts ->
(case (pp "TRACK" >|< ppCurlys (show track_)) of
{ _pp ->
(case (" :" >#< _pp) of
{ _optPP ->
(case (_optPP) of
{ _lhsOoptPP ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOoptPP,_lhsOpp) }) }) }) }))
-- CMetas ------------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
synthesized attribute:
pp : PP_Doc
alternatives:
alternative Tuple:
child x1 : CMetaBind
child x2 : CMetaVal
visit 0:
local pp : _
-}
-- cata
sem_CMetas :: CMetas ->
T_CMetas
sem_CMetas ( x1,x2) =
(sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2))
-- semantic domain
type T_CMetas = MetaLev ->
EHCOpts ->
( PP_Doc)
data Inh_CMetas = Inh_CMetas {mlev_Inh_CMetas :: !(MetaLev),opts_Inh_CMetas :: !(EHCOpts)}
data Syn_CMetas = Syn_CMetas {pp_Syn_CMetas :: !(PP_Doc)}
wrap_CMetas :: T_CMetas ->
Inh_CMetas ->
Syn_CMetas
wrap_CMetas sem (Inh_CMetas _lhsImlev _lhsIopts) =
(let ( _lhsOpp) = sem _lhsImlev _lhsIopts
in (Syn_CMetas _lhsOpp))
sem_CMetas_Tuple :: T_CMetaBind ->
T_CMetaVal ->
T_CMetas
sem_CMetas_Tuple x1_ x2_ =
(\ _lhsImlev
_lhsIopts ->
(case (_lhsIopts) of
{ _x2Oopts ->
(case (_lhsImlev) of
{ _x2Omlev ->
(case (x2_ _x2Omlev _x2Oopts) of
{ ( _x2IoptPP,_x2Ipp) ->
(case (_lhsIopts) of
{ _x1Oopts ->
(case (_lhsImlev) of
{ _x1Omlev ->
(case (x1_ _x1Omlev _x1Oopts) of
{ ( _x1Ipp) ->
(case (ppCurlysCommas [_x1Ipp,_x2Ipp]) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
( _lhsOpp) }) }) }) }) }) }) }) }))
-- CModule -----------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
synthesized attribute:
pp : PP_Doc
alternatives:
alternative Mod:
child moduleNm : {HsName}
child exports : CExportL
child imports : CImportL
child declMetas : CDeclMetaL
child expr : CExpr
-}
-- 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 = MetaLev ->
EHCOpts ->
HowPP ->
( PP_Doc)
sem_CModule_Mod :: HsName ->
T_CExportL ->
T_CImportL ->
T_CDeclMetaL ->
T_CExpr ->
T_CModule
sem_CModule_Mod moduleNm_ exports_ imports_ declMetas_ expr_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow ->
(case (_lhsIppHow) of
{ _exprOppHow ->
(case (_lhsIopts) of
{ _exprOopts ->
(case (_lhsImlev) of
{ _exprOmlev ->
(case (_lhsIppHow) of
{ _declMetasOppHow ->
(case (_lhsIopts) of
{ _declMetasOopts ->
(case (_lhsIopts) of
{ _importsOopts ->
(case (_lhsIopts) of
{ _exportsOopts ->
(case (Map.empty) of
{ _exprOvarPPMp ->
(case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of
{ ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) ->
(case (declMetas_ _declMetasOopts _declMetasOppHow) of
{ ( _declMetasIpp,_declMetasIppL) ->
(case (imports_ _importsOopts) of
{ ( _importsIpp,_importsIppL) ->
(case (exports_ _exportsOopts) of
{ ( _exportsIpp,_exportsIppL) ->
(case (ppSemi ("module" >#< ppCNm' _lhsIopts moduleNm_)
>-< (ppSemiTerminated _exportsIppL)
>-< (ppSemiTerminated _importsIppL)
>-< (ppSemiTerminated _declMetasIppL)
>-< _exprIpp) of
{ _lhsOpp ->
( _lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }))
-- CPat --------------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
fldNmL : [HsName]
pp : PP_Doc
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 = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( ([HsName]),PP_Doc)
sem_CPat_Var :: HsName ->
T_CPat
sem_CPat_Var pnm_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOfldNmL ->
(case (ppCNm' _lhsIopts pnm_) of
{ _lhsOpp ->
( _lhsOfldNmL,_lhsOpp) }) }))
sem_CPat_Con :: CTag ->
T_CPatRest ->
T_CPatFldL ->
T_CPat
sem_CPat_Con tag_ rest_ binds_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _bindsOvarPPMp ->
(case (_lhsIppHow) of
{ _bindsOppHow ->
(case (_lhsIopts) of
{ _bindsOopts ->
(case (_lhsImlev) of
{ _bindsOmlev ->
(case (binds_ _bindsOmlev _bindsOopts _bindsOppHow _bindsOvarPPMp) of
{ ( _bindsIfldNmL,_bindsIpp,_bindsIppL) ->
(case (_bindsIfldNmL) of
{ _lhsOfldNmL ->
(case (_lhsIopts) of
{ _restOopts ->
(case (_lhsIvarPPMp) of
{ _restOvarPPMp ->
(case (_lhsIppHow) of
{ _restOppHow ->
(case (_lhsImlev) of
{ _restOmlev ->
(case (rest_ _restOmlev _restOopts _restOppHow _restOvarPPMp) of
{ ( _restIpp,_restIppMb) ->
(case (howDef _lhsIppHow ("#Tag" >#< ppTag tag_)
(ppCurly (ppMbPre (>#< "|") _restIppMb $ ppCommas' _bindsIppL))) of
{ _lhsOpp ->
( _lhsOfldNmL,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CPat_Int :: Int ->
T_CPat
sem_CPat_Int int_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOfldNmL ->
(case (ppLit "Int" (show int_)) of
{ _lhsOpp ->
( _lhsOfldNmL,_lhsOpp) }) }))
sem_CPat_Char :: Char ->
T_CPat
sem_CPat_Char char_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOfldNmL ->
(case (ppLit "Char" [char_]) of
{ _lhsOpp ->
( _lhsOfldNmL,_lhsOpp) }) }))
sem_CPat_BoolExpr :: CExpr ->
T_CPat
sem_CPat_BoolExpr cexpr_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOfldNmL ->
(case (empty) of
{ _lhsOpp ->
( _lhsOfldNmL,_lhsOpp) }) }))
-- CPatFld -----------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
fldNmL : [HsName]
pp : PP_Doc
alternatives:
alternative Fld:
child lbl : {HsName}
child offset : CExpr
child bind : CBind
child fldAnns : CBindAnnL
visit 0:
local minMetaLev : _
local fldNm : _
-}
-- 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 = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( ([HsName]),PP_Doc)
sem_CPatFld_Fld :: HsName ->
T_CExpr ->
T_CBind ->
T_CBindAnnL ->
T_CPatFld
sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsImlev) of
{ _bindOmlev ->
(case (bind_ _bindOmlev) of
{ ( _bindIgathMinMetaLev,bind_1) ->
(case (_lhsIvarPPMp) of
{ _bindOvarPPMp ->
(case (_lhsIopts) of
{ _bindOopts ->
(case (_bindIgathMinMetaLev) of
{ _minMetaLev ->
(case (_minMetaLev) of
{ _bindOminMetaLev ->
(case (howHor) of
{ _bindOppHow ->
(case (bind_1 _bindOminMetaLev _bindOopts _bindOppHow _bindOvarPPMp) of
{ ( _bindInm,_bindIpp) ->
(case (_bindInm) of
{ _fldNm ->
(case ([_fldNm]) of
{ _lhsOfldNmL ->
(case (_lhsIvarPPMp) of
{ _fldAnnsOvarPPMp ->
(case (_lhsIvarPPMp) of
{ _offsetOvarPPMp ->
(case (_lhsIppHow) of
{ _offsetOppHow ->
(case (_lhsIopts) of
{ _offsetOopts ->
(case (_lhsImlev) of
{ _offsetOmlev ->
(case (_lhsIppHow) of
{ _fldAnnsOppHow ->
(case (_lhsIopts) of
{ _fldAnnsOopts ->
(case (_lhsImlev) of
{ _fldAnnsOmlev ->
(case (fldAnns_ _fldAnnsOmlev _fldAnnsOopts _fldAnnsOppHow _fldAnnsOvarPPMp) of
{ ( _fldAnnsIpp,_fldAnnsIppL) ->
(case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of
{ ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) ->
(case (whenMore _lhsIopts (ppCurlysCommas' [ppCNm' _lhsIopts lbl_,_offsetIpp ] >|< "=") >|< _bindIpp
>|< (if null _fldAnnsIppL then empty else ppParensCommas' _fldAnnsIppL)) of
{ _lhsOpp ->
( _lhsOfldNmL,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))
-- CPatFldL ----------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
fldNmL : [HsName]
pp : PP_Doc
ppL : [PP_Doc]
alternatives:
alternative Cons:
child hd : CPatFld
child tl : CPatFldL
alternative Nil:
-}
-- cata
sem_CPatFldL :: CPatFldL ->
T_CPatFldL
sem_CPatFldL list =
(Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list))
-- semantic domain
type T_CPatFldL = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( ([HsName]),PP_Doc,([PP_Doc]))
sem_CPatFldL_Cons :: T_CPatFld ->
T_CPatFldL ->
T_CPatFldL
sem_CPatFldL_Cons hd_ tl_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (_lhsIvarPPMp) of
{ _tlOvarPPMp ->
(case (_lhsIppHow) of
{ _tlOppHow ->
(case (_lhsIopts) of
{ _tlOopts ->
(case (_lhsImlev) of
{ _tlOmlev ->
(case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of
{ ( _tlIfldNmL,_tlIpp,_tlIppL) ->
(case (_lhsIvarPPMp) of
{ _hdOvarPPMp ->
(case (_lhsIppHow) of
{ _hdOppHow ->
(case (_lhsIopts) of
{ _hdOopts ->
(case (_lhsImlev) of
{ _hdOmlev ->
(case (hd_ _hdOmlev _hdOopts _hdOppHow _hdOvarPPMp) of
{ ( _hdIfldNmL,_hdIpp) ->
(case (_hdIfldNmL ++ _tlIfldNmL) of
{ _lhsOfldNmL ->
(case (_hdIpp >-< _tlIpp) of
{ _lhsOpp ->
(case (_hdIpp : _tlIppL) of
{ _lhsOppL ->
( _lhsOfldNmL,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }))
sem_CPatFldL_Nil :: T_CPatFldL
sem_CPatFldL_Nil =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case ([]) of
{ _lhsOfldNmL ->
(case (empty) of
{ _lhsOpp ->
(case ([]) of
{ _lhsOppL ->
( _lhsOfldNmL,_lhsOpp,_lhsOppL) }) }) }))
-- CPatRest ----------------------------------------------------
{-
visit 0:
inherited attributes:
mlev : MetaLev
opts : EHCOpts
ppHow : HowPP
varPPMp : VarPPMp
synthesized attributes:
pp : PP_Doc
ppMb : Maybe PP_Doc
alternatives:
alternative Var:
child nm : {HsName}
visit 0:
local pp : _
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 = MetaLev ->
EHCOpts ->
HowPP ->
VarPPMp ->
( PP_Doc,(Maybe PP_Doc))
sem_CPatRest_Var :: HsName ->
T_CPatRest
sem_CPatRest_Var nm_ =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (ppCNm' _lhsIopts nm_) of
{ _pp ->
(case (_pp) of
{ _lhsOpp ->
(case (Just _pp) of
{ _lhsOppMb ->
( _lhsOpp,_lhsOppMb) }) }) }))
sem_CPatRest_Empty :: T_CPatRest
sem_CPatRest_Empty =
(\ _lhsImlev
_lhsIopts
_lhsIppHow
_lhsIvarPPMp ->
(case (empty) of
{ _lhsOpp ->
(case (Nothing) of
{ _lhsOppMb ->
( _lhsOpp,_lhsOppMb) }) }))
-- CodeAGItf ---------------------------------------------------
{-
visit 0:
inherited attribute:
opts : EHCOpts
synthesized attribute:
pp : PP_Doc
alternatives:
alternative AGItf:
child module : CModule
visit 0:
local ppHow : _
local mlev : _
-}
-- cata
sem_CodeAGItf :: CodeAGItf ->
T_CodeAGItf
sem_CodeAGItf (CodeAGItf_AGItf _module) =
(sem_CodeAGItf_AGItf (sem_CModule _module))
-- semantic domain
type T_CodeAGItf = EHCOpts ->
( PP_Doc)
data Inh_CodeAGItf = Inh_CodeAGItf {opts_Inh_CodeAGItf :: !(EHCOpts)}
data Syn_CodeAGItf = Syn_CodeAGItf {pp_Syn_CodeAGItf :: !(PP_Doc)}
wrap_CodeAGItf :: T_CodeAGItf ->
Inh_CodeAGItf ->
Syn_CodeAGItf
wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIopts) =
(let ( _lhsOpp) = sem _lhsIopts
in (Syn_CodeAGItf _lhsOpp))
sem_CodeAGItf_AGItf :: T_CModule ->
T_CodeAGItf
sem_CodeAGItf_AGItf module_ =
(\ _lhsIopts ->
(case (howVert) of
{ _ppHow ->
(case (_ppHow) of
{ _moduleOppHow ->
(case (_lhsIopts) of
{ _moduleOopts ->
(case (metaLevVal) of
{ _mlev ->
(case (_mlev) of
{ _moduleOmlev ->
(case (module_ _moduleOmlev _moduleOopts _moduleOppHow) of
{ ( _moduleIpp) ->
(case (_moduleIpp) of
{ _lhsOpp ->
( _lhsOpp) }) }) }) }) }) }) }))