uhc-light-1.1.9.2: src/UHC/Light/Compiler/EH/MainAG_DataField.hs
module UHC.Light.Compiler.EH.MainAG_DataField where
import Data.Char
import Data.List as List
import UHC.Util.Pretty
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Base.TermLike
import UHC.Light.Compiler.Base.HsName.Builtin
import UHC.Light.Compiler.Opts
import UHC.Light.Compiler.Gam.Full
import UHC.Light.Compiler.Error
import UHC.Light.Compiler.Error.Pretty
import UHC.Light.Compiler.EH
import UHC.Light.Compiler.Ty.Pretty
import UHC.Light.Compiler.Ty.FitsInCommon
import UHC.Light.Compiler.Ty.FitsIn
import qualified UHC.Util.FastSeq as Seq
import UHC.Util.Utils
import UHC.Light.Compiler.Base.Trace
import UHC.Light.Compiler.Base.UnderDev
import UHC.Light.Compiler.VarMp
import UHC.Light.Compiler.Substitutable
import Data.Maybe
import UHC.Light.Compiler.Ty.Utils1
import UHC.Light.Compiler.Ty.Trf.Quantify
import UHC.Light.Compiler.Ty.Trf.Instantiate
import UHC.Light.Compiler.Ty
import UHC.Light.Compiler.Ty.FitsInCommon2
import UHC.Light.Compiler.Ty.FIEnv2
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Set (Set)
import Data.Map (Map)
import UHC.Light.Compiler.Ty.Trf.FreshVar
import UHC.Light.Compiler.Ty.Ftv
import UHC.Util.Utils (groupSortOn)
import Control.Applicative ((<|>))
import UHC.Light.Compiler.AbstractCore
import UHC.Light.Compiler.AbstractCore.Utils
import UHC.Light.Compiler.Core
import UHC.Light.Compiler.Core.FFI
import UHC.Light.Compiler.Core.Utils
import UHC.Light.Compiler.Core.Pretty
import UHC.Light.Compiler.Foreign.Extract
import UHC.Light.Compiler.LamInfo
import UHC.Light.Compiler.CodeGen.RefGenerator
import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF
import UHC.Light.Compiler.FinalEnv
import UHC.Light.Compiler.Core.BindExtract
import UHC.Light.Compiler.Core.Subst
import Control.Monad.State
import UHC.Light.Compiler.Ty.Utils2
import UHC.Light.Compiler.Base.Target
import UHC.Light.Compiler.Core.Coercion
import UHC.Light.Compiler.Ty.Trf.MergePreds
import UHC.Light.Compiler.Ty.Trf.Canonic
import UHC.Light.Compiler.Gam.ClGam
import UHC.Light.Compiler.Pred
import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil)
import UHC.Util.CHR
import UHC.Light.Compiler.CHR.Constraint
import UHC.Light.Compiler.CHR.Guard
import UHC.Light.Compiler.Pred.ToCHR
import UHC.Light.Compiler.Pred.Heuristics
import UHC.Light.Compiler.Pred.Evidence
import UHC.Light.Compiler.CHR.Solve
import UHC.Light.Compiler.Pred.EvidenceToCore
import UHC.Light.Compiler.Gam.ClassDefaultGam
import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull)
import UHC.Light.Compiler.Module.ImportExport
import UHC.Light.Compiler.Ty.UsedNames
import UHC.Light.Compiler.CodeGen.ImportUsedModules
import UHC.Light.Compiler.CodeGen.ModuleImportExportImpl
import UHC.Light.Compiler.CodeGen.BuiltinPrims
import UHC.Light.Compiler.Foreign
import UHC.Light.Compiler.Foreign
import UHC.Light.Compiler.Foreign.Pretty
import UHC.Light.Compiler.Deriving
import UHC.Light.Compiler.Generics
import UHC.Light.Compiler.VarMp.Utils
import UHC.Light.Compiler.EH.MainAG_common
-- DataField ---------------------------------------------------
{-
visit 0:
synthesized attribute:
range : Range
visit 1:
chained attribute:
gUniq : UID
visit 2:
inherited attributes:
knPolCtx : Polarity
polGam : PolGam
chained attributes:
polVarMp : VarMp
tyGam : TyGam
synthesized attributes:
fldAnnL : [DataConFldAnnInfo]
fldTyL : FldTyL
visit 3:
chained attribute:
tyKiGam : TyKiGam
synthesized attribute:
intlTyKiGam : TyKiGam
visit 4:
inherited attribute:
dataTy : Ty
chained attribute:
kiVarMp : VarMp
synthesized attributes:
fldSelGam : ValGam
fldUpdGam : ValGam
gathCnstrMp : ConstraintToInfoMap
gathRangeMp : RangeMp
kiL : TyL
visit 5:
inherited attributes:
chrEvidBindMp : EvidKeyToCBindMap
chrScopeBindMp : PredScopeToCBindMap
chrStore : CHRStore
clDfGam : ClassDefaultGam
clGam : ClGam
finKiVarMp : VarMp
finTyKiGam : TyKiGam
finTyVarMp : VarMp
kiGam : KiGam
lexLev : Int
moduleNm : HsName
opts : EHCOpts
predScope : PredScope
rangeMp : RangeMp
sysfEnv : ToSysfEnv
tr : TraceOn -> [PP_Doc] -> TrPP
tvKiVarMp : VarMp
tyKiGlobFreeTvarS : TyVarIdS
tyTyGlobFreeTvarS : TyVarIdS
tyTyTySigFreeTvarS : TyVarIdS
valTyGlobFreeTvarS : TyVarIdS
chained attribute:
patTyVarMp : VarMp
synthesized attributes:
allErrSq : ErrSq
errSq : ErrSq
gathMentrelFilterMp : ModEntRelFilterMp
gathTvKiVarMp : VarMp
pp : PP_Doc
ppAST : PP_Doc
trpp : TrPP
alternatives:
alternative Field:
child hsrange : {Range}
child mbLabels : {Maybe [HsName]}
child tyExpr : TyExpr
visit 0:
local range : {Range}
visit 2:
local nrFieldsForLabel : {Int}
local fldTyL : {FldTyL}
visit 3:
intra fldTyL : {FldTyL}
intra nrFieldsForLabel : {Int}
visit 4:
local fldSelGam : _
local fldUpdGam : _
intra fldTyL : {FldTyL}
intra nrFieldsForLabel : {Int}
visit 5:
local trppHere : _
local ppAST : _
-}
sem_DataField_Field :: Range ->
(Maybe [HsName]) ->
T_TyExpr ->
T_DataField
sem_DataField_Field hsrange_ mbLabels_ tyExpr_ | hsrange_ `seq` (mbLabels_ `seq` (tyExpr_ `seq` (True))) =
(case (tyExpr_) of
{ ( _tyExprIrange,tyExpr_1) | True ->
(case (rangeUnions [hsrange_, _tyExprIrange , _tyExprIrange]) of
{ _range | _range `seq` (True) ->
(case (_range) of
{ _lhsOrange | _lhsOrange `seq` (True) ->
(case ((let sem_DataField_Field_1 :: T_DataField_1
sem_DataField_Field_1 =
(\ _lhsIgUniq ->
_lhsIgUniq `seq`
((case (_lhsIgUniq) of
{ _tyExprOgUniq | _tyExprOgUniq `seq` (True) ->
(case (tyExpr_1 _tyExprOgUniq) of
{ ( _tyExprIgUniq,tyExpr_2) | True ->
(case (_tyExprIgUniq) of
{ _lhsOgUniq | _lhsOgUniq `seq` (True) ->
(case ((let sem_DataField_Field_2 :: T_DataField_2
sem_DataField_Field_2 =
(\ _lhsIknPolCtx
_lhsIpolGam
_lhsIpolVarMp
_lhsItyGam ->
_lhsIknPolCtx `seq`
(_lhsIpolGam `seq`
(_lhsIpolVarMp `seq`
(_lhsItyGam `seq`
((case (maybe 1 length mbLabels_) of
{ _nrFieldsForLabel | _nrFieldsForLabel `seq` (True) ->
(case (_lhsItyGam) of
{ _tyExprOtyGam | _tyExprOtyGam `seq` (True) ->
(case (tyExpr_2 _tyExprOtyGam) of
{ ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True ->
(case (_lhsIknPolCtx) of
{ _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) ->
(case (tyExpr_3 _tyExprOknPolCtx) of
{ ( _tyExprIpolVarL,tyExpr_4) | True ->
(case (_lhsIpolVarMp) of
{ _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) ->
(case (_lhsIpolGam) of
{ _tyExprOpolGam | _tyExprOpolGam `seq` (True) ->
(case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of
{ ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True ->
(case (replicate _nrFieldsForLabel
( DataConFldAnnInfo
(maybe Strictness_NonStrict id _tyExprImbStrictness)
)) of
{ _lhsOfldAnnL | _lhsOfldAnnL `seq` (True) ->
(case (case mbLabels_ of
Just ls -> zipWith (\l t -> (Just l,t)) ls (repeat _tyExprIty)
_ -> [(Nothing,_tyExprIty)]) of
{ _fldTyL | _fldTyL `seq` (True) ->
(case (_fldTyL) of
{ _lhsOfldTyL | _lhsOfldTyL `seq` (True) ->
(case (_tyExprIpolVarMp) of
{ _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) ->
(case (_tyExprItyGam) of
{ _lhsOtyGam | _lhsOtyGam `seq` (True) ->
(case ((let sem_DataField_Field_3 :: T_DataField_3
sem_DataField_Field_3 =
(\ _lhsItyKiGam ->
_lhsItyKiGam `seq`
((case (_lhsItyKiGam) of
{ _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) ->
(case (tyExpr_5 _tyExprOtyKiGam) of
{ ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True ->
(case (_tyExprIintlTyKiGam) of
{ _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) ->
(case (_tyExprItyKiGam) of
{ _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) ->
(case ((let sem_DataField_Field_4 :: T_DataField_4
sem_DataField_Field_4 =
(\ _lhsIdataTy
_lhsIkiVarMp ->
_lhsIdataTy `seq`
(_lhsIkiVarMp `seq`
((case (assocLToGam [ (l,ValGamInfo $ [_lhsIdataTy] `appArr` t) | (Just l,t) <- _fldTyL ]) of
{ _fldSelGam | _fldSelGam `seq` (True) ->
(case (_fldSelGam) of
{ _lhsOfldSelGam | _lhsOfldSelGam `seq` (True) ->
(case (let mk t = [t,fr _lhsIdataTy] `appArr` _lhsIdataTy
where fv = tyFtvMp t
fr dt = dt
in assocLToGam [ (hsnFldUpd l,ValGamInfo $ mk t) | (Just l,t) <- _fldTyL ]) of
{ _fldUpdGam | _fldUpdGam `seq` (True) ->
(case (_fldUpdGam) of
{ _lhsOfldUpdGam | _lhsOfldUpdGam `seq` (True) ->
(case (Map.empty) of
{ _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) ->
(case (Map.empty) of
{ _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) ->
(case (_lhsIkiVarMp) of
{ _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) ->
(case (tyExpr_6 _tyExprOkiVarMp) of
{ ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True ->
(case (replicate _nrFieldsForLabel _tyExprIki) of
{ _lhsOkiL | _lhsOkiL `seq` (True) ->
(case (_tyExprIkiVarMp) of
{ _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) ->
(case ((let sem_DataField_Field_5 :: T_DataField_5
sem_DataField_Field_5 =
(\ _lhsIchrEvidBindMp
_lhsIchrScopeBindMp
_lhsIchrStore
_lhsIclDfGam
_lhsIclGam
_lhsIfinKiVarMp
_lhsIfinTyKiGam
_lhsIfinTyVarMp
_lhsIkiGam
_lhsIlexLev
_lhsImoduleNm
_lhsIopts
_lhsIpatTyVarMp
_lhsIpredScope
_lhsIrangeMp
_lhsIsysfEnv
_lhsItr
_lhsItvKiVarMp
_lhsItyKiGlobFreeTvarS
_lhsItyTyGlobFreeTvarS
_lhsItyTyTySigFreeTvarS
_lhsIvalTyGlobFreeTvarS ->
_lhsIchrEvidBindMp `seq`
(_lhsIchrScopeBindMp `seq`
(_lhsIchrStore `seq`
(_lhsIclDfGam `seq`
(_lhsIclGam `seq`
(_lhsIfinKiVarMp `seq`
(_lhsIfinTyKiGam `seq`
(_lhsIfinTyVarMp `seq`
(_lhsIkiGam `seq`
(_lhsIlexLev `seq`
(_lhsImoduleNm `seq`
(_lhsIopts `seq`
(_lhsIpatTyVarMp `seq`
(_lhsIpredScope `seq`
(_lhsIrangeMp `seq`
(_lhsIsysfEnv `seq`
(_lhsItr `seq`
(_lhsItvKiVarMp `seq`
(_lhsItyKiGlobFreeTvarS `seq`
(_lhsItyTyGlobFreeTvarS `seq`
(_lhsItyTyTySigFreeTvarS `seq`
(_lhsIvalTyGlobFreeTvarS `seq`
((case (_lhsIclGam) of
{ _tyExprOclGam | _tyExprOclGam `seq` (True) ->
(case (tyExpr_7 _tyExprOclGam) of
{ ( _tyExprIevTy,tyExpr_8) | True ->
(case (_lhsIvalTyGlobFreeTvarS) of
{ _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) ->
(case (_lhsItyTyTySigFreeTvarS) of
{ _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) ->
(case (_lhsItyTyGlobFreeTvarS) of
{ _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) ->
(case (_lhsItyKiGlobFreeTvarS) of
{ _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) ->
(case (_lhsItr) of
{ _tyExprOtr | _tyExprOtr `seq` (True) ->
(case (_lhsIsysfEnv) of
{ _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) ->
(case (_lhsIopts) of
{ _tyExprOopts | _tyExprOopts `seq` (True) ->
(case (_lhsImoduleNm) of
{ _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) ->
(case (_lhsIkiGam) of
{ _tyExprOkiGam | _tyExprOkiGam `seq` (True) ->
(case (_lhsIfinTyVarMp) of
{ _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) ->
(case (_lhsIfinTyKiGam) of
{ _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) ->
(case (_lhsIfinKiVarMp) of
{ _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) ->
(case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of
{ ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True ->
(case (_tyExprIallErrSq) of
{ _lhsOallErrSq | _lhsOallErrSq `seq` (True) ->
(case (_tyExprIerrSq) of
{ _lhsOerrSq | _lhsOerrSq `seq` (True) ->
(case (_tyExprIgathMentrelFilterMp) of
{ _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) ->
(case (emptyVarMp) of
{ _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) ->
(case (_lhsIpatTyVarMp) of
{ _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) ->
(case (case mbLabels_ of
Just l -> ppCommas' l >#< "::" >#< _tyExprIpp
Nothing -> _tyExprIpp) of
{ _lhsOpp | _lhsOpp `seq` (True) ->
(case (trppEmpty) of
{ _trppHere | _trppHere `seq` (True) ->
(case (ppNestTrPP _lhsIopts ["DataField","Field"] [pp (maybe [] (map ppTrNm) mbLabels_)] [_tyExprIppAST] _trppHere) of
{ _ppAST | _ppAST `seq` (True) ->
(case (_ppAST) of
{ _lhsOppAST | _lhsOppAST `seq` (True) ->
(case (_tyExprItrpp) of
{ _lhsOtrpp | _lhsOtrpp `seq` (True) ->
( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp,_lhsOppAST,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))))))
in sem_DataField_Field_5)) of
{ ( sem_DataField_5) | True ->
( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOkiL,_lhsOkiVarMp,sem_DataField_5) }) }) }) }) }) }) }) }) }) }) }))))
in sem_DataField_Field_4)) of
{ ( sem_DataField_4) | True ->
( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_DataField_4) }) }) }) }) })))
in sem_DataField_Field_3)) of
{ ( sem_DataField_3) | True ->
( _lhsOfldAnnL,_lhsOfldTyL,_lhsOpolVarMp,_lhsOtyGam,sem_DataField_3) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))
in sem_DataField_Field_2)) of
{ ( sem_DataField_2) | True ->
( _lhsOgUniq,sem_DataField_2) }) }) }) })))
in sem_DataField_Field_1)) of
{ ( sem_DataField_1) | True ->
( _lhsOrange,sem_DataField_1) }) }) }) })