packages feed

uhc-light-1.1.9.2: src/UHC/Light/Compiler/EH/MainAG_FuncDep.hs



module UHC.Light.Compiler.EH.MainAG_FuncDep 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

-- FuncDep -----------------------------------------------------
{-
   visit 0:
      chained attribute:
         gUniq                : UID
   visit 1:
      chained attribute:
         tyGam                : TyGam
   visit 2:
      chained attribute:
         tyKiGam              : TyKiGam
   visit 3:
      inherited attributes:
         clsTyArgs            : TyL
         finKiVarMp           : VarMp
         finTyKiGam           : TyKiGam
         finTyVarMp           : VarMp
         moduleNm             : HsName
         opts                 : EHCOpts
         sysfEnv              : ToSysfEnv
         tr                   : TraceOn -> [PP_Doc] -> TrPP
         tyKiGlobFreeTvarS    : TyVarIdS
         tyTyGlobFreeTvarS    : TyVarIdS
         tyTyTySigFreeTvarS   : TyVarIdS
         valTyGlobFreeTvarS   : TyVarIdS
      synthesized attributes:
         allErrSq             : ErrSq
         errSq                : ErrSq
         funcDeps             : [ClsFuncDep]
         gathMentrelFilterMp  : ModEntRelFilterMp
         pp                   : PP_Doc
         ppAST                : PP_Doc
         range                : Range
         trpp                 : TrPP
   alternatives:
      alternative Dep:
         child hsrange        : {Range}
         child fromTvs        : TyVars 
         child toTvs          : TyVars 
         visit 3:
            local trppHere    : _
            local ppAST       : _
            local range       : {Range}
-}
sem_FuncDep_Dep :: Range ->
                   T_TyVars ->
                   T_TyVars ->
                   T_FuncDep

sem_FuncDep_Dep hsrange_ fromTvs_ toTvs_ | hsrange_ `seq` (fromTvs_ `seq` (toTvs_ `seq` (True))) =
    (\ _lhsIgUniq ->
         _lhsIgUniq `seq`
         ((case (_lhsIgUniq) of
           { _fromTvsOgUniq | _fromTvsOgUniq `seq` (True) ->
           (case (fromTvs_) of
            { ( _fromTvsIrange,fromTvs_1) | True ->
                (case (fromTvs_1 _fromTvsOgUniq) of
                 { ( _fromTvsIgUniq,fromTvs_2) | True ->
                     (case (_fromTvsIgUniq) of
                      { _toTvsOgUniq | _toTvsOgUniq `seq` (True) ->
                      (case (toTvs_) of
                       { ( _toTvsIrange,toTvs_1) | True ->
                           (case (toTvs_1 _toTvsOgUniq) of
                            { ( _toTvsIgUniq,toTvs_2) | True ->
                                (case (_toTvsIgUniq) of
                                 { _lhsOgUniq | _lhsOgUniq `seq` (True) ->
                                 (case ((let sem_FuncDep_Dep_1 :: T_FuncDep_1
                                             sem_FuncDep_Dep_1 =
                                                 (\ _lhsItyGam ->
                                                      _lhsItyGam `seq`
                                                      ((case (_lhsItyGam) of
                                                        { _fromTvsOtyGam | _fromTvsOtyGam `seq` (True) ->
                                                        (case (fromTvs_2 _fromTvsOtyGam) of
                                                         { ( _fromTvsItyGam,fromTvs_3) | True ->
                                                             (case (_fromTvsItyGam) of
                                                              { _toTvsOtyGam | _toTvsOtyGam `seq` (True) ->
                                                              (case (toTvs_2 _toTvsOtyGam) of
                                                               { ( _toTvsItyGam,toTvs_3) | True ->
                                                                   (case (_toTvsItyGam) of
                                                                    { _lhsOtyGam | _lhsOtyGam `seq` (True) ->
                                                                    (case ((let sem_FuncDep_Dep_2 :: T_FuncDep_2
                                                                                sem_FuncDep_Dep_2 =
                                                                                    (\ _lhsItyKiGam ->
                                                                                         _lhsItyKiGam `seq`
                                                                                         ((case (_lhsItyKiGam) of
                                                                                           { _fromTvsOtyKiGam | _fromTvsOtyKiGam `seq` (True) ->
                                                                                           (case (fromTvs_3 _fromTvsOtyKiGam) of
                                                                                            { ( _fromTvsIgathTyVarPolGam,_fromTvsIintlTyKiGam,_fromTvsIkiL,_fromTvsIpolVarL,_fromTvsItyKiGam,_fromTvsItyL,fromTvs_4) | True ->
                                                                                                (case (_fromTvsItyKiGam) of
                                                                                                 { _toTvsOtyKiGam | _toTvsOtyKiGam `seq` (True) ->
                                                                                                 (case (toTvs_3 _toTvsOtyKiGam) of
                                                                                                  { ( _toTvsIgathTyVarPolGam,_toTvsIintlTyKiGam,_toTvsIkiL,_toTvsIpolVarL,_toTvsItyKiGam,_toTvsItyL,toTvs_4) | True ->
                                                                                                      (case (_toTvsItyKiGam) of
                                                                                                       { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) ->
                                                                                                       (case ((let sem_FuncDep_Dep_3 :: T_FuncDep_3
                                                                                                                   sem_FuncDep_Dep_3 =
                                                                                                                       (\ _lhsIclsTyArgs
                                                                                                                          _lhsIfinKiVarMp
                                                                                                                          _lhsIfinTyKiGam
                                                                                                                          _lhsIfinTyVarMp
                                                                                                                          _lhsImoduleNm
                                                                                                                          _lhsIopts
                                                                                                                          _lhsIsysfEnv
                                                                                                                          _lhsItr
                                                                                                                          _lhsItyKiGlobFreeTvarS
                                                                                                                          _lhsItyTyGlobFreeTvarS
                                                                                                                          _lhsItyTyTySigFreeTvarS
                                                                                                                          _lhsIvalTyGlobFreeTvarS ->
                                                                                                                            _lhsIclsTyArgs `seq`
                                                                                                                            (_lhsIfinKiVarMp `seq`
                                                                                                                             (_lhsIfinTyKiGam `seq`
                                                                                                                              (_lhsIfinTyVarMp `seq`
                                                                                                                               (_lhsImoduleNm `seq`
                                                                                                                                (_lhsIopts `seq`
                                                                                                                                 (_lhsIsysfEnv `seq`
                                                                                                                                  (_lhsItr `seq`
                                                                                                                                   (_lhsItyKiGlobFreeTvarS `seq`
                                                                                                                                    (_lhsItyTyGlobFreeTvarS `seq`
                                                                                                                                     (_lhsItyTyTySigFreeTvarS `seq`
                                                                                                                                      (_lhsIvalTyGlobFreeTvarS `seq`
                                                                                                                                       ((case (_lhsIvalTyGlobFreeTvarS) of
                                                                                                                                         { _toTvsOvalTyGlobFreeTvarS | _toTvsOvalTyGlobFreeTvarS `seq` (True) ->
                                                                                                                                         (case (_lhsItyTyTySigFreeTvarS) of
                                                                                                                                          { _toTvsOtyTyTySigFreeTvarS | _toTvsOtyTyTySigFreeTvarS `seq` (True) ->
                                                                                                                                          (case (_lhsItyTyGlobFreeTvarS) of
                                                                                                                                           { _toTvsOtyTyGlobFreeTvarS | _toTvsOtyTyGlobFreeTvarS `seq` (True) ->
                                                                                                                                           (case (_lhsItyKiGlobFreeTvarS) of
                                                                                                                                            { _toTvsOtyKiGlobFreeTvarS | _toTvsOtyKiGlobFreeTvarS `seq` (True) ->
                                                                                                                                            (case (_lhsItr) of
                                                                                                                                             { _toTvsOtr | _toTvsOtr `seq` (True) ->
                                                                                                                                             (case (_lhsIsysfEnv) of
                                                                                                                                              { _toTvsOsysfEnv | _toTvsOsysfEnv `seq` (True) ->
                                                                                                                                              (case (_lhsIopts) of
                                                                                                                                               { _toTvsOopts | _toTvsOopts `seq` (True) ->
                                                                                                                                               (case (_lhsImoduleNm) of
                                                                                                                                                { _toTvsOmoduleNm | _toTvsOmoduleNm `seq` (True) ->
                                                                                                                                                (case (_lhsIfinTyVarMp) of
                                                                                                                                                 { _toTvsOfinTyVarMp | _toTvsOfinTyVarMp `seq` (True) ->
                                                                                                                                                 (case (_lhsIfinTyKiGam) of
                                                                                                                                                  { _toTvsOfinTyKiGam | _toTvsOfinTyKiGam `seq` (True) ->
                                                                                                                                                  (case (_lhsIfinKiVarMp) of
                                                                                                                                                   { _toTvsOfinKiVarMp | _toTvsOfinKiVarMp `seq` (True) ->
                                                                                                                                                   (case (toTvs_4 _toTvsOfinKiVarMp _toTvsOfinTyKiGam _toTvsOfinTyVarMp _toTvsOmoduleNm _toTvsOopts _toTvsOsysfEnv _toTvsOtr _toTvsOtyKiGlobFreeTvarS _toTvsOtyTyGlobFreeTvarS _toTvsOtyTyTySigFreeTvarS _toTvsOvalTyGlobFreeTvarS) of
                                                                                                                                                    { ( _toTvsIallErrSq,_toTvsIerrSq,_toTvsIgathMentrelFilterMp,_toTvsInmL,_toTvsIpp,_toTvsIppAST,_toTvsIppL,_toTvsItrpp) | True ->
                                                                                                                                                        (case (_lhsIvalTyGlobFreeTvarS) of
                                                                                                                                                         { _fromTvsOvalTyGlobFreeTvarS | _fromTvsOvalTyGlobFreeTvarS `seq` (True) ->
                                                                                                                                                         (case (_lhsItyTyTySigFreeTvarS) of
                                                                                                                                                          { _fromTvsOtyTyTySigFreeTvarS | _fromTvsOtyTyTySigFreeTvarS `seq` (True) ->
                                                                                                                                                          (case (_lhsItyTyGlobFreeTvarS) of
                                                                                                                                                           { _fromTvsOtyTyGlobFreeTvarS | _fromTvsOtyTyGlobFreeTvarS `seq` (True) ->
                                                                                                                                                           (case (_lhsItyKiGlobFreeTvarS) of
                                                                                                                                                            { _fromTvsOtyKiGlobFreeTvarS | _fromTvsOtyKiGlobFreeTvarS `seq` (True) ->
                                                                                                                                                            (case (_lhsItr) of
                                                                                                                                                             { _fromTvsOtr | _fromTvsOtr `seq` (True) ->
                                                                                                                                                             (case (_lhsIsysfEnv) of
                                                                                                                                                              { _fromTvsOsysfEnv | _fromTvsOsysfEnv `seq` (True) ->
                                                                                                                                                              (case (_lhsIopts) of
                                                                                                                                                               { _fromTvsOopts | _fromTvsOopts `seq` (True) ->
                                                                                                                                                               (case (_lhsImoduleNm) of
                                                                                                                                                                { _fromTvsOmoduleNm | _fromTvsOmoduleNm `seq` (True) ->
                                                                                                                                                                (case (_lhsIfinTyVarMp) of
                                                                                                                                                                 { _fromTvsOfinTyVarMp | _fromTvsOfinTyVarMp `seq` (True) ->
                                                                                                                                                                 (case (_lhsIfinTyKiGam) of
                                                                                                                                                                  { _fromTvsOfinTyKiGam | _fromTvsOfinTyKiGam `seq` (True) ->
                                                                                                                                                                  (case (_lhsIfinKiVarMp) of
                                                                                                                                                                   { _fromTvsOfinKiVarMp | _fromTvsOfinKiVarMp `seq` (True) ->
                                                                                                                                                                   (case (fromTvs_4 _fromTvsOfinKiVarMp _fromTvsOfinTyKiGam _fromTvsOfinTyVarMp _fromTvsOmoduleNm _fromTvsOopts _fromTvsOsysfEnv _fromTvsOtr _fromTvsOtyKiGlobFreeTvarS _fromTvsOtyTyGlobFreeTvarS _fromTvsOtyTyTySigFreeTvarS _fromTvsOvalTyGlobFreeTvarS) of
                                                                                                                                                                    { ( _fromTvsIallErrSq,_fromTvsIerrSq,_fromTvsIgathMentrelFilterMp,_fromTvsInmL,_fromTvsIpp,_fromTvsIppAST,_fromTvsIppL,_fromTvsItrpp) | True ->
                                                                                                                                                                        (case (_fromTvsIallErrSq `Seq.union` _toTvsIallErrSq) of
                                                                                                                                                                         { _lhsOallErrSq | _lhsOallErrSq `seq` (True) ->
                                                                                                                                                                         (case (_fromTvsIerrSq `Seq.union` _toTvsIerrSq) of
                                                                                                                                                                          { _lhsOerrSq | _lhsOerrSq `seq` (True) ->
                                                                                                                                                                          (case (let  l v = maybe (-1) id . elemIndex v $ _lhsIclsTyArgs
                                                                                                                                                                                 in   [ClsFuncDep (map l _fromTvsItyL) (map l _toTvsItyL)]) of
                                                                                                                                                                           { _lhsOfuncDeps | _lhsOfuncDeps `seq` (True) ->
                                                                                                                                                                           (case (_fromTvsIgathMentrelFilterMp `mentrelFilterMpUnion` _toTvsIgathMentrelFilterMp) of
                                                                                                                                                                            { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) ->
                                                                                                                                                                            (case (_fromTvsIpp >#< "->" >#< _toTvsIpp) of
                                                                                                                                                                             { _lhsOpp | _lhsOpp `seq` (True) ->
                                                                                                                                                                             (case (trppEmpty) of
                                                                                                                                                                              { _trppHere | _trppHere `seq` (True) ->
                                                                                                                                                                              (case (ppNestTrPP _lhsIopts ["FuncDep","Dep"] [] [_fromTvsIppAST,_toTvsIppAST] _trppHere) of
                                                                                                                                                                               { _ppAST | _ppAST `seq` (True) ->
                                                                                                                                                                               (case (_ppAST) of
                                                                                                                                                                                { _lhsOppAST | _lhsOppAST `seq` (True) ->
                                                                                                                                                                                (case (rangeUnions [hsrange_, _fromTvsIrange, _toTvsIrange ]) of
                                                                                                                                                                                 { _range | _range `seq` (True) ->
                                                                                                                                                                                 (case (_range) of
                                                                                                                                                                                  { _lhsOrange | _lhsOrange `seq` (True) ->
                                                                                                                                                                                  (case (_fromTvsItrpp >< _toTvsItrpp) of
                                                                                                                                                                                   { _lhsOtrpp | _lhsOtrpp `seq` (True) ->
                                                                                                                                                                                   ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOrange,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))
                                                                                                               in  sem_FuncDep_Dep_3)) of
                                                                                                        { ( sem_FuncDep_3) | True ->
                                                                                                        ( _lhsOtyKiGam,sem_FuncDep_3) }) }) }) }) }) })))
                                                                            in  sem_FuncDep_Dep_2)) of
                                                                     { ( sem_FuncDep_2) | True ->
                                                                     ( _lhsOtyGam,sem_FuncDep_2) }) }) }) }) }) })))
                                         in  sem_FuncDep_Dep_1)) of
                                  { ( sem_FuncDep_1) | True ->
                                  ( _lhsOgUniq,sem_FuncDep_1) }) }) }) }) }) }) }) })))