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