packages feed

uhc-light-1.1.7.2: src/UHC/Light/Compiler/EH/MainAG_TyVar.hs



module UHC.Light.Compiler.EH.MainAG_TyVar 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.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.Base.Debug as Debug
import Debug.Trace
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.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.Light.Compiler.CHR
import UHC.Light.Compiler.CHR.Constraint
import UHC.Light.Compiler.Pred.CHR
import UHC.Light.Compiler.Pred.ToCHR
import UHC.Light.Compiler.Pred.Heuristics
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

-- TyVar -------------------------------------------------------
{-
   visit 0:
      synthesized attribute:
         range                : Range
   visit 1:
      chained attribute:
         gUniq                : UID
   visit 2:
      chained attribute:
         tyGam                : TyGam
   visit 3:
      chained attribute:
         tyKiGam              : TyKiGam
      synthesized attributes:
         gathTyVarPolGam      : PolGam
         intlTyKiGam          : TyKiGam
         ki                   : Ty
         polVarL              : [Polarity]
         ty                   : Ty
   visit 4:
      inherited attributes:
         finKiVarMp           : VarMp
         finTyKiGam           : TyKiGam
         finTyVarMp           : VarMp
         moduleNm             : HsName
         opts                 : EHCOpts
         sysfEnv              : ToSysfEnv
         tyKiGlobFreeTvarS    : TyVarIdS
         tyTyGlobFreeTvarS    : TyVarIdS
         tyTyTySigFreeTvarS   : TyVarIdS
         valTyGlobFreeTvarS   : TyVarIdS
      synthesized attributes:
         allErrSq             : ErrSq
         errSq                : ErrSq
         gathMentrelFilterMp  : ModEntRelFilterMp
         nm                   : HsName
         pp                   : PP_Doc
   alternatives:
      alternative Var:
         child hsrange        : {Range}
         child nm             : {HsName}
         visit 0:
            local range       : {Range}
         visit 1:
            local _tup250     : _
         visit 2:
            local lUniq       : {UID}
            local _tup248     : _
            intra _tup250     : _
         visit 3:
            local lUniq_17_pol : {UID}
            local polVar      : _
            local lUniq_ki    : {UID}
            local tgi_        : {TyGamInfo}
            local _tup249     : _
            local tyKiGamNew  : _
            local tkgi_       : {TyKiGamInfo}
            local ki          : {Ty}
            intra _tup250     : _
            intra _tup248     : _
-}
sem_TyVar_Var :: Range ->
                 HsName ->
                 T_TyVar

sem_TyVar_Var hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) =
    (case (hsrange_) of
     { _range | _range `seq` (True) ->
     (case (_range) of
      { _lhsOrange | _lhsOrange `seq` (True) ->
      (case ((let sem_TyVar_Var_1 :: T_TyVar_1
                  sem_TyVar_Var_1 =
                      (\ _lhsIgUniq ->
                           _lhsIgUniq `seq`
                           ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_17_pol) -> case nextUnique __cont of { (__cont, lUniq_ki) -> (__cont,lUniq,lUniq_17_pol,lUniq_ki)}}} )) of
                             { __tup250 | __tup250 `seq` (True) ->
                             (case (__tup250) of
                              { (_lhsOgUniq,_,_,_) | _lhsOgUniq `seq` (True) ->
                              (case ((let sem_TyVar_Var_2 :: T_TyVar_2
                                          sem_TyVar_Var_2 =
                                              (\ _lhsItyGam ->
                                                   _lhsItyGam `seq`
                                                   ((case (__tup250) of
                                                     { (_,_lUniq,_,_) | _lUniq `seq` (True) ->
                                                     (case (tyGamLookupOrAdd _lUniq nm_ (gamTop _lhsItyGam) _lhsItyGam) of
                                                      { __tup248 | __tup248 `seq` (True) ->
                                                      (case (__tup248) of
                                                       { (_,_lhsOtyGam) | _lhsOtyGam `seq` (True) ->
                                                       (case ((let sem_TyVar_Var_3 :: T_TyVar_3
                                                                   sem_TyVar_Var_3 =
                                                                       (\ _lhsItyKiGam ->
                                                                            _lhsItyKiGam `seq`
                                                                            ((case (__tup250) of
                                                                              { (_,_,_lUniq_17_pol,_) | _lUniq_17_pol `seq` (True) ->
                                                                              (case (mkPolVar _lUniq_17_pol) of
                                                                               { _polVar | _polVar `seq` (True) ->
                                                                               (case (gamSingleton nm_ (mkPGI _polVar)) of
                                                                                { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) ->
                                                                                (case (__tup250) of
                                                                                 { (_,_,_,_lUniq_ki) | _lUniq_ki `seq` (True) ->
                                                                                 (case (__tup248) of
                                                                                  { (_tgi_,_) | _tgi_ `seq` (True) ->
                                                                                  (case (tyKiGamLookupOrAdd _lUniq_ki (tgiTy _tgi_) _lhsItyKiGam) of
                                                                                   { __tup249 | __tup249 `seq` (True) ->
                                                                                   (case (__tup249) of
                                                                                    { (_,_,_tyKiGamNew) | _tyKiGamNew `seq` (True) ->
                                                                                    (case (_tyKiGamNew) of
                                                                                     { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) ->
                                                                                     (case (__tup249) of
                                                                                      { (_tkgi_,_,_) | _tkgi_ `seq` (True) ->
                                                                                      (case (tkgiKi _tkgi_) of
                                                                                       { _ki | _ki `seq` (True) ->
                                                                                       (case (_ki) of
                                                                                        { _lhsOki | _lhsOki `seq` (True) ->
                                                                                        (case ([_polVar]) of
                                                                                         { _lhsOpolVarL | _lhsOpolVarL `seq` (True) ->
                                                                                         (case (tgiTy _tgi_) of
                                                                                          { _lhsOty | _lhsOty `seq` (True) ->
                                                                                          (case (__tup249) of
                                                                                           { (_,_lhsOtyKiGam,_) | _lhsOtyKiGam `seq` (True) ->
                                                                                           (case ((let sem_TyVar_Var_4 :: T_TyVar_4
                                                                                                       sem_TyVar_Var_4 =
                                                                                                           (\ _lhsIfinKiVarMp
                                                                                                              _lhsIfinTyKiGam
                                                                                                              _lhsIfinTyVarMp
                                                                                                              _lhsImoduleNm
                                                                                                              _lhsIopts
                                                                                                              _lhsIsysfEnv
                                                                                                              _lhsItyKiGlobFreeTvarS
                                                                                                              _lhsItyTyGlobFreeTvarS
                                                                                                              _lhsItyTyTySigFreeTvarS
                                                                                                              _lhsIvalTyGlobFreeTvarS ->
                                                                                                                _lhsIfinKiVarMp `seq`
                                                                                                                (_lhsIfinTyKiGam `seq`
                                                                                                                 (_lhsIfinTyVarMp `seq`
                                                                                                                  (_lhsImoduleNm `seq`
                                                                                                                   (_lhsIopts `seq`
                                                                                                                    (_lhsIsysfEnv `seq`
                                                                                                                     (_lhsItyKiGlobFreeTvarS `seq`
                                                                                                                      (_lhsItyTyGlobFreeTvarS `seq`
                                                                                                                       (_lhsItyTyTySigFreeTvarS `seq`
                                                                                                                        (_lhsIvalTyGlobFreeTvarS `seq`
                                                                                                                         ((case (Seq.empty) of
                                                                                                                           { _lhsOallErrSq | _lhsOallErrSq `seq` (True) ->
                                                                                                                           (case (Seq.empty) of
                                                                                                                            { _lhsOerrSq | _lhsOerrSq `seq` (True) ->
                                                                                                                            (case (Map.empty) of
                                                                                                                             { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) ->
                                                                                                                             (case (nm_) of
                                                                                                                              { _lhsOnm | _lhsOnm `seq` (True) ->
                                                                                                                              (case (pp nm_) of
                                                                                                                               { _lhsOpp | _lhsOpp `seq` (True) ->
                                                                                                                               ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnm,_lhsOpp) }) }) }) }) }))))))))))))
                                                                                                   in  sem_TyVar_Var_4)) of
                                                                                            { ( sem_TyVar_4) | True ->
                                                                                            ( _lhsOgathTyVarPolGam,_lhsOintlTyKiGam,_lhsOki,_lhsOpolVarL,_lhsOty,_lhsOtyKiGam,sem_TyVar_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
                                                               in  sem_TyVar_Var_3)) of
                                                        { ( sem_TyVar_3) | True ->
                                                        ( _lhsOtyGam,sem_TyVar_3) }) }) }) })))
                                      in  sem_TyVar_Var_2)) of
                               { ( sem_TyVar_2) | True ->
                               ( _lhsOgUniq,sem_TyVar_2) }) }) })))
              in  sem_TyVar_Var_1)) of
       { ( sem_TyVar_1) | True ->
       ( _lhsOrange,sem_TyVar_1) }) }) })