{-# LANGUAGE IncoherentInstances       #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE UndecidableInstances      #-}
{-# LANGUAGE TupleSections             #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE PatternGuards             #-}
{-# LANGUAGE ConstraintKinds           #-}
{-# LANGUAGE ViewPatterns              #-}
{-# LANGUAGE TypeOperators             #-}

{-# OPTIONS_GHC -Wno-incomplete-patterns #-} -- TODO(#1918): Only needed for GHC <9.0.1.
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

-- | Refinement Types. Mostly mirroring the GHC Type definition, but with
--   room for refinements of various sorts.
-- TODO: Desperately needs re-organization.

module Language.Haskell.Liquid.Types.RefType (

    TyConMap

  -- * Functions for lifting Reft-values to Spec-values
  , uTop, uReft, uRType, uRType', uRTypeGen, uPVar

  -- * Applying a solution to a SpecType
  , applySolution

  -- * Functions for decreasing arguments
  , isDecreasing, makeDecrType, makeNumEnv
  , makeLexRefa

  -- * Functions for manipulating `Predicate`s
  , pdVar
  , findPVar
  , FreeVar, allTyVars, allTyVars', freeTyVars, tyClasses, tyConName

  -- * Quantifying RTypes
  , quantifyRTy
  , quantifyFreeRTy

  -- * RType constructors
  , ofType, toType, bareOfType
  , bTyVar, rTyVar, rVar, rApp, gApp, rEx
  , symbolRTyVar, bareRTyVar
  , tyConBTyCon
  , pdVarReft

  -- * Substitutions
  , subts, subvPredicate, subvUReft
  , subsTyVarMeet, subsTyVarMeet', subsTyVarNoMeet
  , subsTyVarsNoMeet, subsTyVarsMeet

  -- * Destructors
  , addTyConInfo
  , appRTyCon
  , typeUniqueSymbol
  , classBinds
  , isSizeable
  , famInstTyConType
  , famInstArgs

  -- * Manipulating Refinements in RTypes
  , strengthen
  , strengthenWith
  , generalize
  , normalizePds
  , dataConMsReft
  , dataConReft
  , rTypeSortedReft
  , rTypeSort
  , typeSort
  , shiftVV

  -- * TODO: classify these
  -- , mkDataConIdsTy
  , expandProductType
  , mkTyConInfo
  , strengthenRefTypeGen
  , strengthenDataConType
  , isBaseTy
  , updateRTVar, isValKind, kindToRType
  , rTVarInfo

  , tyVarsPosition, Positions(..)

  , isNumeric

  ) where

-- import           GHC.Stack
import Prelude hiding (error)
-- import qualified Prelude
import           Data.Maybe               (fromMaybe, isJust)
import           Data.Monoid              (First(..))
import           Data.Hashable
import qualified Data.HashMap.Strict  as M
import qualified Data.HashSet         as S
import qualified Data.List as L
import           Control.Monad  (void)
import           Text.Printf
import           Text.PrettyPrint.HughesPJ hiding ((<>), first)
import           Language.Fixpoint.Misc
import           Language.Fixpoint.Types hiding (DataDecl (..), DataCtor (..), panic, shiftVV, Predicate, isNumeric, trueReft)
import           Language.Fixpoint.Types.Visitor (trans, Visitable)
import qualified Language.Fixpoint.Types as F
import           Language.Haskell.Liquid.Types.Errors
import           Language.Haskell.Liquid.Types.PrettyPrint

import           Language.Haskell.Liquid.Types.RType
import           Language.Haskell.Liquid.Types.RTypeOp
import           Language.Haskell.Liquid.Types.Types
import           Language.Haskell.Liquid.Types.Variance
import           Language.Haskell.Liquid.Misc
import           Language.Haskell.Liquid.Types.Names
import qualified Language.Haskell.Liquid.GHC.Misc as GM
import           Language.Haskell.Liquid.GHC.Play (mapType, stringClassArg, isRecursivenewTyCon)
import           Liquid.GHC.API        as Ghc hiding ( Expr, get
                                                                      , Located
                                                                      , tyConName
                                                                      , punctuate
                                                                      , hcat
                                                                      , (<+>)
                                                                      , parens
                                                                      , empty
                                                                      , dcolon
                                                                      , vcat
                                                                      , nest
                                                                      , ($+$)
                                                                      , panic
                                                                      , text
                                                                      )
import           Language.Haskell.Liquid.GHC.TypeRep () -- Eq Type instance







strengthenDataConType :: (Var, SpecType) -> (Var, SpecType)
strengthenDataConType :: (Var, SpecType) -> (Var, SpecType)
strengthenDataConType (Var
x, SpecType
t) = (Var
x, RTypeRepBV Symbol Symbol RTyCon RTyVar RReft -> SpecType
forall b v c tv r. RTypeRepBV b v c tv r -> RTypeBV b v c tv r
fromRTypeRep RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
trep {ty_res = tres})
  where
    tres :: SpecType
tres     = [Char] -> SpecType -> SpecType
forall a. PPrint a => [Char] -> a -> a
F.notracepp [Char]
_msg (SpecType -> SpecType) -> SpecType -> SpecType
forall a b. (a -> b) -> a -> b
$ RTypeRepBV Symbol Symbol RTyCon RTyVar RReft -> SpecType
forall b v c tv r. RTypeRepBV b v c tv r -> RTypeBV b v c tv r
ty_res RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
trep SpecType -> RReft -> SpecType
forall r b v c tv.
Meet r =>
RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
`strengthen` ReftBV Symbol Symbol -> PredicateBV Symbol Symbol -> RReft
forall b v r. r -> PredicateBV b v -> UReftBV b v r
MkUReft (Expr -> ReftBV Symbol Symbol
forall a. Expression a => a -> ReftBV Symbol Symbol
exprReft Expr
expr') PredicateBV Symbol Symbol
forall a. Monoid a => a
mempty
    trep :: RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
trep     = SpecType -> RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
forall b v c tv r. RTypeBV b v c tv r -> RTypeRepBV b v c tv r
toRTypeRep SpecType
t
    _msg :: [Char]
_msg     = [Char]
"STRENGTHEN-DATACONTYPE x = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Var, [(Symbol, SpecType)]) -> [Char]
forall a. PPrint a => a -> [Char]
F.showpp (Var
x, [Symbol] -> [SpecType] -> [(Symbol, SpecType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
xs [SpecType]
ts)
    ([Symbol]
xs, [SpecType]
ts) = RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
-> ([Symbol], [SpecType])
dataConArgs RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
trep
    as :: [(RTVar RTyVar (RType RTyCon RTyVar NoReft), RReft)]
as       = RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
-> [(RTVar RTyVar (RType RTyCon RTyVar NoReft), RReft)]
forall b v c tv r.
RTypeRepBV b v c tv r
-> [(RTVar tv (RTypeBV b v c tv (NoReftB b)), r)]
ty_vars  RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
trep
    x' :: Symbol
x'       = Var -> Symbol
forall a. Symbolic a => a -> Symbol
symbol Var
x
    expr' :: Expr
    expr' :: Expr
expr' | [Symbol] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Symbol]
xs Bool -> Bool -> Bool
&& [(RTVar RTyVar (RType RTyCon RTyVar NoReft), RReft)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RTVar RTyVar (RType RTyCon RTyVar NoReft), RReft)]
as = Symbol -> Expr
forall b v. v -> ExprBV b v
EVar Symbol
x'
          | Bool
otherwise          = Located Symbol -> [Expr] -> Expr
forall v b. Located v -> [ExprBV b v] -> ExprBV b v
mkEApp (Symbol -> Located Symbol
forall a. a -> Located a
dummyLoc Symbol
x') (Symbol -> Expr
forall b v. v -> ExprBV b v
EVar (Symbol -> Expr) -> [Symbol] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
xs)


dataConArgs :: SpecRep -> ([Symbol], [SpecType])
dataConArgs :: RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
-> ([Symbol], [SpecType])
dataConArgs RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
trep = [(Symbol, SpecType)] -> ([Symbol], [SpecType])
forall a b. [(a, b)] -> ([a], [b])
unzip [ (Symbol
x, SpecType
t) | (Symbol
x, SpecType
t) <- [Symbol] -> [SpecType] -> [(Symbol, SpecType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
xs [SpecType]
ts, SpecType -> Bool
forall {r}.
(ReftBind r ~ Symbol, ReftVar r ~ Symbol, IsReft r, PPrint r,
 SubsTy RTyVar (RType RTyCon RTyVar NoReft) r) =>
RTypeBV Symbol Symbol RTyCon RTyVar r -> Bool
isValTy SpecType
t]
  where
    xs :: [Symbol]
xs           = RTypeRepBV Symbol Symbol RTyCon RTyVar RReft -> [Symbol]
forall b v c tv r. RTypeRepBV b v c tv r -> [b]
ty_binds RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
trep
    ts :: [SpecType]
ts           = RTypeRepBV Symbol Symbol RTyCon RTyVar RReft -> [SpecType]
forall b v c tv r. RTypeRepBV b v c tv r -> [RTypeBV b v c tv r]
ty_args RTypeRepBV Symbol Symbol RTyCon RTyVar RReft
trep
    isValTy :: RTypeBV Symbol Symbol RTyCon RTyVar r -> Bool
isValTy      = Bool -> Bool
not (Bool -> Bool)
-> (RTypeBV Symbol Symbol RTyCon RTyVar r -> Bool)
-> RTypeBV Symbol Symbol RTyCon RTyVar r
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Type -> Bool
Type -> Bool
Ghc.isSimplePredTy (Type -> Bool)
-> (RTypeBV Symbol Symbol RTyCon RTyVar r -> Type)
-> RTypeBV Symbol Symbol RTyCon RTyVar r
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
False


pdVar :: PVarV v t -> PredicateV v
pdVar :: forall v t. PVarV v t -> PredicateV v
pdVar PVarV v t
v  = [UsedPVarBV Symbol v] -> PredicateBV Symbol v
forall b v. [UsedPVarBV b v] -> PredicateBV b v
Pr [PVarV v t -> UsedPVarBV Symbol v
forall v t. PVarV v t -> UsedPVarV v
uPVar PVarV v t
v]

findPVar :: [PVar (RType c tv NoReft)] -> UsedPVar -> PVar (RType c tv NoReft)
findPVar :: forall c tv.
[PVar (RType c tv NoReft)] -> UsedPVar -> PVar (RType c tv NoReft)
findPVar [PVar (RType c tv NoReft)]
ps UsedPVar
upv = Symbol
-> RType c tv NoReft
-> Symbol
-> [(RType c tv NoReft, Symbol, Expr)]
-> PVar (RType c tv NoReft)
forall b v t. b -> t -> b -> [(t, b, ExprBV b v)] -> PVarBV b v t
PV Symbol
name RType c tv NoReft
ty Symbol
v ((((), Symbol, Expr)
 -> (RType c tv NoReft, Symbol, Expr)
 -> (RType c tv NoReft, Symbol, Expr))
-> [((), Symbol, Expr)]
-> [(RType c tv NoReft, Symbol, Expr)]
-> [(RType c tv NoReft, Symbol, Expr)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(()
_, Symbol
_, Expr
e) (RType c tv NoReft
t, Symbol
s, Expr
_) -> (RType c tv NoReft
t, Symbol
s, Expr
e)) (UsedPVar -> [((), Symbol, Expr)]
forall b v t. PVarBV b v t -> [(t, b, ExprBV b v)]
pargs UsedPVar
upv) [(RType c tv NoReft, Symbol, Expr)]
args)
  where
    PV Symbol
name RType c tv NoReft
ty Symbol
v [(RType c tv NoReft, Symbol, Expr)]
args = PVar (RType c tv NoReft)
-> Maybe (PVar (RType c tv NoReft)) -> PVar (RType c tv NoReft)
forall a. a -> Maybe a -> a
fromMaybe (UsedPVar -> PVar (RType c tv NoReft)
forall {a} {b}. PPrint a => a -> b
msg UsedPVar
upv) (Maybe (PVar (RType c tv NoReft)) -> PVar (RType c tv NoReft))
-> Maybe (PVar (RType c tv NoReft)) -> PVar (RType c tv NoReft)
forall a b. (a -> b) -> a -> b
$ (PVar (RType c tv NoReft) -> Bool)
-> [PVar (RType c tv NoReft)] -> Maybe (PVar (RType c tv NoReft))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== UsedPVar -> Symbol
forall b v t. PVarBV b v t -> b
pname UsedPVar
upv) (Symbol -> Bool)
-> (PVar (RType c tv NoReft) -> Symbol)
-> PVar (RType c tv NoReft)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVar (RType c tv NoReft) -> Symbol
forall b v t. PVarBV b v t -> b
pname) [PVar (RType c tv NoReft)]
ps
    msg :: a -> b
msg a
p = Maybe SrcSpan -> [Char] -> b
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [Char]
"RefType.findPVar" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. PPrint a => a -> [Char]
showpp a
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"not found"

-- | Various functions for converting vanilla `Reft` to `Spec`

uRType          ::  RType c tv a -> RType c tv (UReft a)
uRType :: forall c tv a. RType c tv a -> RType c tv (UReft a)
uRType          = (a -> UReft a)
-> RTypeBV Symbol Symbol c tv a
-> RTypeBV Symbol Symbol c tv (UReft a)
forall a b.
(a -> b)
-> RTypeBV Symbol Symbol c tv a -> RTypeBV Symbol Symbol c tv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> UReft a
forall r v. r -> UReftV v r
uTop

uRType'         ::  RType c tv (UReft a) -> RType c tv a
uRType' :: forall c tv a. RType c tv (UReft a) -> RType c tv a
uRType'         = (UReft a -> a)
-> RTypeBV Symbol Symbol c tv (UReft a)
-> RTypeBV Symbol Symbol c tv a
forall a b.
(a -> b)
-> RTypeBV Symbol Symbol c tv a -> RTypeBV Symbol Symbol c tv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UReft a -> a
forall b v r. UReftBV b v r -> r
ur_reft

uRTypeGen       :: IsReft b => RType c tv a -> RType c tv b
uRTypeGen :: forall b c tv a. IsReft b => RType c tv a -> RType c tv b
uRTypeGen       = (a -> b)
-> RTypeBV Symbol Symbol c tv a -> RTypeBV Symbol Symbol c tv b
forall a b.
(a -> b)
-> RTypeBV Symbol Symbol c tv a -> RTypeBV Symbol Symbol c tv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
 -> RTypeBV Symbol Symbol c tv a -> RTypeBV Symbol Symbol c tv b)
-> (a -> b)
-> RTypeBV Symbol Symbol c tv a
-> RTypeBV Symbol Symbol c tv b
forall a b. (a -> b) -> a -> b
$ b -> a -> b
forall a b. a -> b -> a
const b
forall r. IsReft r => r
trueReft

uPVar           :: PVarV v t -> UsedPVarV v
uPVar :: forall v t. PVarV v t -> UsedPVarV v
uPVar           = PVarBV Symbol v t -> PVarBV Symbol v ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

uReft           :: (Symbol, Expr) -> UReft Reft
uReft :: (Symbol, Expr) -> RReft
uReft           = ReftBV Symbol Symbol -> RReft
forall r v. r -> UReftV v r
uTop (ReftBV Symbol Symbol -> RReft)
-> ((Symbol, Expr) -> ReftBV Symbol Symbol)
-> (Symbol, Expr)
-> RReft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol, Expr) -> ReftBV Symbol Symbol
forall b v. (b, ExprBV b v) -> ReftBV b v
Reft

uTop            ::  r -> UReftV v r
uTop :: forall r v. r -> UReftV v r
uTop r
r          = r -> PredicateBV Symbol v -> UReftBV Symbol v r
forall b v r. r -> PredicateBV b v -> UReftBV b v r
MkUReft r
r ([UsedPVarBV Symbol v] -> PredicateBV Symbol v
forall b v. [UsedPVarBV b v] -> PredicateBV b v
Pr [])

--------------------------------------------------------------------
-------------- (Class) Predicates for Valid Refinement Types -------
--------------------------------------------------------------------


-- Monoid Instances ---------------------------------------------------------

instance ( SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v))
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) c
         , OkRTBV v v c tv r
         , FreeVar c tv
         , Subable r
         , F.Variable r ~ v
         , ReftBind r ~ v
         , IsReft r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTVar tv (RTypeBV v v c tv (NoReftB v)))
         )
        => Semigroup (RTypeBV v v c tv r)  where
  <> :: RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
(<>) = RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v)))) =>
RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType

-- TODO: remove, use only Semigroup?
instance ( SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v))
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) c
         , OkRTBV v v c tv r
         , FreeVar c tv
         , Subable r
         , F.Variable r ~ v
         , ReftBind r ~ v
         , IsReft r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTVar tv (RTypeBV v v c tv (NoReftB v)))
         )
        => Monoid (RTypeBV v v c tv r)  where
  mempty :: RTypeBV v v c tv r
mempty  = Maybe SrcSpan -> [Char] -> RTypeBV v v c tv r
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"mempty: RType"

-- MOVE TO TYPES
instance ( SubsTy tv (RTypeBV v v c tv (NoReftB v)) c
         , OkRTBV v v c tv r
         , Variable r ~ v
         , ReftBind r ~ v
         , IsReft r
         , FreeVar c tv
         , Subable r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v))
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTVar tv (RTypeBV v v c tv (NoReftB v)))
         )
         => Semigroup (RTPropBV v v c tv r) where
  <> :: RTPropBV v v c tv r -> RTPropBV v v c tv r -> RTPropBV v v c tv r
(<>) (RProp [(v, RTypeBV v v c tv (NoReftB v))]
s1 (RHole r
r1)) (RProp [(v, RTypeBV v v c tv (NoReftB v))]
s2 (RHole r
r2))
    | r -> Bool
forall r. ToReft r => r -> Bool
isTauto r
r1 = [(v, RTypeBV v v c tv (NoReftB v))]
-> RTypeBV v v c tv r -> RTPropBV v v c tv r
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp [(v, RTypeBV v v c tv (NoReftB v))]
s2 (r -> RTypeBV v v c tv r
forall b v c tv r. r -> RTypeBV b v c tv r
RHole r
r2)
    | r -> Bool
forall r. ToReft r => r -> Bool
isTauto r
r2 = [(v, RTypeBV v v c tv (NoReftB v))]
-> RTypeBV v v c tv r -> RTPropBV v v c tv r
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp [(v, RTypeBV v v c tv (NoReftB v))]
s1 (r -> RTypeBV v v c tv r
forall b v c tv r. r -> RTypeBV b v c tv r
RHole r
r1)
    | Bool
otherwise  = [(v, RTypeBV v v c tv (NoReftB v))]
-> RTypeBV v v c tv r -> RTPropBV v v c tv r
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp [(v, RTypeBV v v c tv (NoReftB v))]
s1 (RTypeBV v v c tv r -> RTPropBV v v c tv r)
-> RTypeBV v v c tv r -> RTPropBV v v c tv r
forall a b. (a -> b) -> a -> b
$ r -> RTypeBV v v c tv r
forall b v c tv r. r -> RTypeBV b v c tv r
RHole (r -> RTypeBV v v c tv r) -> r -> RTypeBV v v c tv r
forall a b. (a -> b) -> a -> b
$ r
r1 r -> r -> r
forall r. Meet r => r -> r -> r
`meet`
                               SubstV (Variable r) -> r -> r
forall a.
(Subable a, HasCallStack) =>
SubstV (Variable a) -> a -> a
subst ([(Variable r, ExprBV (Variable r) (Variable r))]
-> SubstV (Variable r)
forall v. Hashable v => [(v, ExprBV v v)] -> SubstV v
mkSubst ([(Variable r, ExprBV (Variable r) (Variable r))]
 -> SubstV (Variable r))
-> [(Variable r, ExprBV (Variable r) (Variable r))]
-> SubstV (Variable r)
forall a b. (a -> b) -> a -> b
$ [Variable r]
-> [ExprBV (Variable r) (Variable r)]
-> [(Variable r, ExprBV (Variable r) (Variable r))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((v, RTypeBV v v c tv (NoReftB v)) -> v
forall a b. (a, b) -> a
fst ((v, RTypeBV v v c tv (NoReftB v)) -> v)
-> [(v, RTypeBV v v c tv (NoReftB v))] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, RTypeBV v v c tv (NoReftB v))]
s2) (v -> ExprBV v v
forall b v. v -> ExprBV b v
EVar (v -> ExprBV v v)
-> ((v, RTypeBV v v c tv (NoReftB v)) -> v)
-> (v, RTypeBV v v c tv (NoReftB v))
-> ExprBV v v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, RTypeBV v v c tv (NoReftB v)) -> v
forall a b. (a, b) -> a
fst ((v, RTypeBV v v c tv (NoReftB v)) -> ExprBV v v)
-> [(v, RTypeBV v v c tv (NoReftB v))] -> [ExprBV v v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, RTypeBV v v c tv (NoReftB v))]
s1)) r
r2

  (<>) (RProp [(v, RTypeBV v v c tv (NoReftB v))]
s1 RTypeBV v v c tv r
t1) (RProp [(v, RTypeBV v v c tv (NoReftB v))]
s2 RTypeBV v v c tv r
t2)
    | RTypeBV v v c tv r -> Bool
forall r c b v tv.
(ToReft r, TyConable c, Binder b, ReftBind r ~ b) =>
RTypeBV b v c tv r -> Bool
isTrivial RTypeBV v v c tv r
t1 = [(v, RTypeBV v v c tv (NoReftB v))]
-> RTypeBV v v c tv r -> RTPropBV v v c tv r
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp [(v, RTypeBV v v c tv (NoReftB v))]
s2 RTypeBV v v c tv r
t2
    | RTypeBV v v c tv r -> Bool
forall r c b v tv.
(ToReft r, TyConable c, Binder b, ReftBind r ~ b) =>
RTypeBV b v c tv r -> Bool
isTrivial RTypeBV v v c tv r
t2 = [(v, RTypeBV v v c tv (NoReftB v))]
-> RTypeBV v v c tv r -> RTPropBV v v c tv r
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp [(v, RTypeBV v v c tv (NoReftB v))]
s1 RTypeBV v v c tv r
t1
    | Bool
otherwise    = [(v, RTypeBV v v c tv (NoReftB v))]
-> RTypeBV v v c tv r -> RTPropBV v v c tv r
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp [(v, RTypeBV v v c tv (NoReftB v))]
s1 (RTypeBV v v c tv r -> RTPropBV v v c tv r)
-> RTypeBV v v c tv r -> RTPropBV v v c tv r
forall a b. (a -> b) -> a -> b
$ RTypeBV v v c tv r
t1  RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v)))) =>
RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
`strengthenRefType`
                                SubstV (Variable (RTypeBV v v c tv r))
-> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall a.
(Subable a, HasCallStack) =>
SubstV (Variable a) -> a -> a
subst ([(Variable (RTypeBV v v c tv r),
  ExprBV
    (Variable (RTypeBV v v c tv r)) (Variable (RTypeBV v v c tv r)))]
-> SubstV (Variable (RTypeBV v v c tv r))
forall v. Hashable v => [(v, ExprBV v v)] -> SubstV v
mkSubst ([(Variable (RTypeBV v v c tv r),
   ExprBV
     (Variable (RTypeBV v v c tv r)) (Variable (RTypeBV v v c tv r)))]
 -> SubstV (Variable (RTypeBV v v c tv r)))
-> [(Variable (RTypeBV v v c tv r),
     ExprBV
       (Variable (RTypeBV v v c tv r)) (Variable (RTypeBV v v c tv r)))]
-> SubstV (Variable (RTypeBV v v c tv r))
forall a b. (a -> b) -> a -> b
$ [Variable (RTypeBV v v c tv r)]
-> [ExprBV
      (Variable (RTypeBV v v c tv r)) (Variable (RTypeBV v v c tv r))]
-> [(Variable (RTypeBV v v c tv r),
     ExprBV
       (Variable (RTypeBV v v c tv r)) (Variable (RTypeBV v v c tv r)))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((v, RTypeBV v v c tv (NoReftB v)) -> v
forall a b. (a, b) -> a
fst ((v, RTypeBV v v c tv (NoReftB v)) -> v)
-> [(v, RTypeBV v v c tv (NoReftB v))] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, RTypeBV v v c tv (NoReftB v))]
s2) (v -> ExprBV v v
forall b v. v -> ExprBV b v
EVar (v -> ExprBV v v)
-> ((v, RTypeBV v v c tv (NoReftB v)) -> v)
-> (v, RTypeBV v v c tv (NoReftB v))
-> ExprBV v v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, RTypeBV v v c tv (NoReftB v)) -> v
forall a b. (a, b) -> a
fst ((v, RTypeBV v v c tv (NoReftB v)) -> ExprBV v v)
-> [(v, RTypeBV v v c tv (NoReftB v))] -> [ExprBV v v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, RTypeBV v v c tv (NoReftB v))]
s1)) RTypeBV v v c tv r
t2

instance ( SubsTy tv (RTypeBV v v c tv (NoReftB v)) c
         , OkRTBV v v c tv r
         , Variable r ~ v
         , ReftBind r ~ v
         , IsReft r
         , FreeVar c tv
         , Subable r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v))
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTVar tv (RTypeBV v v c tv (NoReftB v)))
         )
         => Meet (RTPropBV v v c tv r) where

-- TODO: remove and use only Semigroup?
instance ( SubsTy tv (RTypeBV v v c tv (NoReftB v)) c
         , OkRTBV v v c tv r
         , Variable r ~ v
         , ReftBind r ~ v
         , IsReft r
         , FreeVar c tv
         , Subable r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v))
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTVar tv (RTypeBV v v c tv (NoReftB v)))
         )
         => Monoid (RTPropBV v v c tv r) where
  mempty :: RTPropBV v v c tv r
mempty  = Maybe SrcSpan -> [Char] -> RTPropBV v v c tv r
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"mempty: RTProp"
  mappend :: RTPropBV v v c tv r -> RTPropBV v v c tv r -> RTPropBV v v c tv r
mappend = RTPropBV v v c tv r -> RTPropBV v v c tv r -> RTPropBV v v c tv r
forall a. Semigroup a => a -> a -> a
(<>)

instance Meet (RTProp RTyCon RTyVar (UReft Reft))
instance Meet (RTProp RTyCon RTyVar NoReft)
instance Meet (RTProp BTyCon BTyVar (UReft Reft))
instance Meet (RTProp BTyCon BTyVar NoReft)
instance Meet (RTProp RTyCon RTyVar Reft)

instance Semigroup (RType RTyCon RTyVar r) => Meet (RType RTyCon RTyVar r) where
instance Meet (RType BTyCon BTyVar (UReft Reft))

----------------------------------------------------------------------------
-- | Subable Instances -----------------------------------------------------
----------------------------------------------------------------------------

instance Subable (RRProp Reft) where
  syms :: RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
-> [Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))]
syms (RProp [(Symbol, RType RTyCon RTyVar NoReft)]
ss (RHole ReftBV Symbol Symbol
r)) = ((Symbol, RType RTyCon RTyVar NoReft) -> Symbol
forall a b. (a, b) -> a
fst ((Symbol, RType RTyCon RTyVar NoReft) -> Symbol)
-> [(Symbol, RType RTyCon RTyVar NoReft)] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar NoReft)]
ss) [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++ ReftBV Symbol Symbol -> [Variable (ReftBV Symbol Symbol)]
forall a. Subable a => a -> [Variable a]
syms ReftBV Symbol Symbol
r
  syms (RProp [(Symbol, RType RTyCon RTyVar NoReft)]
ss RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
t)      = ((Symbol, RType RTyCon RTyVar NoReft) -> Symbol
forall a b. (a, b) -> a
fst ((Symbol, RType RTyCon RTyVar NoReft) -> Symbol)
-> [(Symbol, RType RTyCon RTyVar NoReft)] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar NoReft)]
ss) [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++ RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> [Variable
      (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))]
forall a. Subable a => a -> [Variable a]
syms RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
t


  subst :: HasCallStack =>
SubstV (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
subst SubstV (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
su (RProp [(Symbol, RType RTyCon RTyVar NoReft)]
ss (RHole ReftBV Symbol Symbol
r)) = [(Symbol, RType RTyCon RTyVar NoReft)]
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp ((RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SubstV (Variable (RType RTyCon RTyVar NoReft))
-> RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft
forall a.
(Subable a, HasCallStack) =>
SubstV (Variable a) -> a -> a
subst SubstV (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
SubstV (Variable (RType RTyCon RTyVar NoReft))
su) ((Symbol, RType RTyCon RTyVar NoReft)
 -> (Symbol, RType RTyCon RTyVar NoReft))
-> [(Symbol, RType RTyCon RTyVar NoReft)]
-> [(Symbol, RType RTyCon RTyVar NoReft)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar NoReft)]
ss) (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
 -> RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall a b. (a -> b) -> a -> b
$ ReftBV Symbol Symbol
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
forall b v c tv r. r -> RTypeBV b v c tv r
RHole (ReftBV Symbol Symbol
 -> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))
-> ReftBV Symbol Symbol
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
forall a b. (a -> b) -> a -> b
$ SubstV (Variable (ReftBV Symbol Symbol))
-> ReftBV Symbol Symbol -> ReftBV Symbol Symbol
forall a.
(Subable a, HasCallStack) =>
SubstV (Variable a) -> a -> a
subst SubstV (Variable (ReftBV Symbol Symbol))
SubstV (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
su ReftBV Symbol Symbol
r
  subst SubstV (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
su (RProp [(Symbol, RType RTyCon RTyVar NoReft)]
ss RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
r)  = [(Symbol, RType RTyCon RTyVar NoReft)]
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp  ((RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SubstV (Variable (RType RTyCon RTyVar NoReft))
-> RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft
forall a.
(Subable a, HasCallStack) =>
SubstV (Variable a) -> a -> a
subst SubstV (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
SubstV (Variable (RType RTyCon RTyVar NoReft))
su) ((Symbol, RType RTyCon RTyVar NoReft)
 -> (Symbol, RType RTyCon RTyVar NoReft))
-> [(Symbol, RType RTyCon RTyVar NoReft)]
-> [(Symbol, RType RTyCon RTyVar NoReft)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar NoReft)]
ss) (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
 -> RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall a b. (a -> b) -> a -> b
$ SubstV
  (Variable
     (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)))
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
forall a.
(Subable a, HasCallStack) =>
SubstV (Variable a) -> a -> a
subst SubstV (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
SubstV
  (Variable
     (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)))
su RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
r


  substf :: (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
 -> ExprBV
      (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
      (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))))
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
substf Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> ExprBV
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
f (RProp [(Symbol, RType RTyCon RTyVar NoReft)]
ss (RHole ReftBV Symbol Symbol
r)) = [(Symbol, RType RTyCon RTyVar NoReft)]
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp ((RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Variable (RType RTyCon RTyVar NoReft)
 -> ExprBV
      (Variable (RType RTyCon RTyVar NoReft))
      (Variable (RType RTyCon RTyVar NoReft)))
-> RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft
forall a.
Subable a =>
(Variable a -> ExprBV (Variable a) (Variable a)) -> a -> a
substf Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> ExprBV
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
Variable (RType RTyCon RTyVar NoReft)
-> ExprBV
     (Variable (RType RTyCon RTyVar NoReft))
     (Variable (RType RTyCon RTyVar NoReft))
f) ((Symbol, RType RTyCon RTyVar NoReft)
 -> (Symbol, RType RTyCon RTyVar NoReft))
-> [(Symbol, RType RTyCon RTyVar NoReft)]
-> [(Symbol, RType RTyCon RTyVar NoReft)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar NoReft)]
ss) (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
 -> RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall a b. (a -> b) -> a -> b
$ ReftBV Symbol Symbol
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
forall b v c tv r. r -> RTypeBV b v c tv r
RHole (ReftBV Symbol Symbol
 -> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))
-> ReftBV Symbol Symbol
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
forall a b. (a -> b) -> a -> b
$ (Variable (ReftBV Symbol Symbol)
 -> ExprBV
      (Variable (ReftBV Symbol Symbol))
      (Variable (ReftBV Symbol Symbol)))
-> ReftBV Symbol Symbol -> ReftBV Symbol Symbol
forall a.
Subable a =>
(Variable a -> ExprBV (Variable a) (Variable a)) -> a -> a
substf Variable (ReftBV Symbol Symbol)
-> ExprBV
     (Variable (ReftBV Symbol Symbol)) (Variable (ReftBV Symbol Symbol))
Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> ExprBV
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
f ReftBV Symbol Symbol
r
  substf Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> ExprBV
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
f (RProp [(Symbol, RType RTyCon RTyVar NoReft)]
ss RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
r) = [(Symbol, RType RTyCon RTyVar NoReft)]
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp  ((RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Variable (RType RTyCon RTyVar NoReft)
 -> ExprBV
      (Variable (RType RTyCon RTyVar NoReft))
      (Variable (RType RTyCon RTyVar NoReft)))
-> RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft
forall a.
Subable a =>
(Variable a -> ExprBV (Variable a) (Variable a)) -> a -> a
substf Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> ExprBV
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
Variable (RType RTyCon RTyVar NoReft)
-> ExprBV
     (Variable (RType RTyCon RTyVar NoReft))
     (Variable (RType RTyCon RTyVar NoReft))
f) ((Symbol, RType RTyCon RTyVar NoReft)
 -> (Symbol, RType RTyCon RTyVar NoReft))
-> [(Symbol, RType RTyCon RTyVar NoReft)]
-> [(Symbol, RType RTyCon RTyVar NoReft)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar NoReft)]
ss) (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
 -> RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall a b. (a -> b) -> a -> b
$ (Variable
   (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))
 -> ExprBV
      (Variable
         (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)))
      (Variable
         (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))))
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
forall a.
Subable a =>
(Variable a -> ExprBV (Variable a) (Variable a)) -> a -> a
substf Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> ExprBV
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
     (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
Variable
  (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))
-> ExprBV
     (Variable
        (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)))
     (Variable
        (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)))
f RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
r

  substa :: (Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
 -> Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol)))
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
substa Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
f (RProp [(Symbol, RType RTyCon RTyVar NoReft)]
ss (RHole ReftBV Symbol Symbol
r)) = [(Symbol, RType RTyCon RTyVar NoReft)]
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp ((RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Variable (RType RTyCon RTyVar NoReft)
 -> Variable (RType RTyCon RTyVar NoReft))
-> RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft
forall a. Subable a => (Variable a -> Variable a) -> a -> a
substa Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
Variable (RType RTyCon RTyVar NoReft)
-> Variable (RType RTyCon RTyVar NoReft)
f) ((Symbol, RType RTyCon RTyVar NoReft)
 -> (Symbol, RType RTyCon RTyVar NoReft))
-> [(Symbol, RType RTyCon RTyVar NoReft)]
-> [(Symbol, RType RTyCon RTyVar NoReft)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar NoReft)]
ss) (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
 -> RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall a b. (a -> b) -> a -> b
$ ReftBV Symbol Symbol
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
forall b v c tv r. r -> RTypeBV b v c tv r
RHole (ReftBV Symbol Symbol
 -> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))
-> ReftBV Symbol Symbol
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
forall a b. (a -> b) -> a -> b
$ (Variable (ReftBV Symbol Symbol)
 -> Variable (ReftBV Symbol Symbol))
-> ReftBV Symbol Symbol -> ReftBV Symbol Symbol
forall a. Subable a => (Variable a -> Variable a) -> a -> a
substa Variable (ReftBV Symbol Symbol) -> Variable (ReftBV Symbol Symbol)
Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
f ReftBV Symbol Symbol
r
  substa Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
f (RProp [(Symbol, RType RTyCon RTyVar NoReft)]
ss RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
r) = [(Symbol, RType RTyCon RTyVar NoReft)]
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp  ((RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
-> (Symbol, RType RTyCon RTyVar NoReft)
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Variable (RType RTyCon RTyVar NoReft)
 -> Variable (RType RTyCon RTyVar NoReft))
-> RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft
forall a. Subable a => (Variable a -> Variable a) -> a -> a
substa Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
Variable (RType RTyCon RTyVar NoReft)
-> Variable (RType RTyCon RTyVar NoReft)
f) ((Symbol, RType RTyCon RTyVar NoReft)
 -> (Symbol, RType RTyCon RTyVar NoReft))
-> [(Symbol, RType RTyCon RTyVar NoReft)]
-> [(Symbol, RType RTyCon RTyVar NoReft)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar NoReft)]
ss) (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
 -> RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTProp RTyCon RTyVar (ReftBV Symbol Symbol)
forall a b. (a -> b) -> a -> b
$ (Variable
   (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))
 -> Variable
      (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)))
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
-> RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
forall a. Subable a => (Variable a -> Variable a) -> a -> a
substa Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
-> Variable (RTProp RTyCon RTyVar (ReftBV Symbol Symbol))
Variable
  (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))
-> Variable
     (RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol))
f RTypeBV Symbol Symbol RTyCon RTyVar (ReftBV Symbol Symbol)
r

-- MOVE TO TYPES
instance Fixpoint String where
  toFix :: [Char] -> Doc
toFix = [Char] -> Doc
text

-- MOVE TO TYPES
instance Fixpoint Class where
  toFix :: Class -> Doc
toFix = [Char] -> Doc
text ([Char] -> Doc) -> (Class -> [Char]) -> Class -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Char]
forall a. Outputable a => a -> [Char]
GM.showPpr

-- MOVE TO TYPES
class FreeVar a v where
  freeVars :: a -> [v]

-- MOVE TO TYPES
instance FreeVar RTyCon RTyVar where
  freeVars :: RTyCon -> [RTyVar]
freeVars = (Var -> RTyVar
RTV (Var -> RTyVar) -> [Var] -> [RTyVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Var] -> [RTyVar]) -> (RTyCon -> [Var]) -> RTyCon -> [RTyVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> [Var]
GM.tyConTyVarsDef (TyCon -> [Var]) -> (RTyCon -> TyCon) -> RTyCon -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTyCon -> TyCon
rtc_tc

-- MOVE TO TYPES
instance FreeVar BTyCon BTyVar where
  freeVars :: BTyCon -> [BTyVar]
freeVars BTyCon
_ = []

-- Eq Instances ------------------------------------------------------

-- MOVE TO TYPES
instance (Eq c, Eq tv, Hashable tv, PPrint tv, TyConable c, PPrint c)
      => Eq (RType c tv NoReft) where
  == :: RType c tv NoReft -> RType c tv NoReft -> Bool
(==) = HashMap tv tv -> RType c tv NoReft -> RType c tv NoReft -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap tv tv
forall k v. HashMap k v
M.empty

eqRSort :: (Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k)
        => M.HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort :: forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m (RAllP PVUBV Symbol Symbol a k
_ RTypeBV Symbol Symbol a k NoReft
t) (RAllP PVUBV Symbol Symbol a k
_ RTypeBV Symbol Symbol a k NoReft
t')
  = HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t RTypeBV Symbol Symbol a k NoReft
t'
eqRSort HashMap k k
m (RAllP PVUBV Symbol Symbol a k
_ RTypeBV Symbol Symbol a k NoReft
t) RTypeBV Symbol Symbol a k NoReft
t'
  = HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t RTypeBV Symbol Symbol a k NoReft
t'
eqRSort HashMap k k
m (RAllT RTVar k (RTypeBV Symbol Symbol a k NoReft)
a RTypeBV Symbol Symbol a k NoReft
t NoReft
_) (RAllT RTVar k (RTypeBV Symbol Symbol a k NoReft)
a' RTypeBV Symbol Symbol a k NoReft
t' NoReft
_)
  | RTVar k (RTypeBV Symbol Symbol a k NoReft)
a RTVar k (RTypeBV Symbol Symbol a k NoReft)
-> RTVar k (RTypeBV Symbol Symbol a k NoReft) -> Bool
forall a. Eq a => a -> a -> Bool
== RTVar k (RTypeBV Symbol Symbol a k NoReft)
a'
  = HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t RTypeBV Symbol Symbol a k NoReft
t'
  | Bool
otherwise
  = HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort (k -> k -> HashMap k k -> HashMap k k
forall k v. Hashable k => k -> v -> HashMap k v -> HashMap k v
M.insert (RTVar k (RTypeBV Symbol Symbol a k NoReft) -> k
forall tv s. RTVar tv s -> tv
ty_var_value RTVar k (RTypeBV Symbol Symbol a k NoReft)
a') (RTVar k (RTypeBV Symbol Symbol a k NoReft) -> k
forall tv s. RTVar tv s -> tv
ty_var_value RTVar k (RTypeBV Symbol Symbol a k NoReft)
a) HashMap k k
m) RTypeBV Symbol Symbol a k NoReft
t RTypeBV Symbol Symbol a k NoReft
t'
eqRSort HashMap k k
m (RAllT RTVar k (RTypeBV Symbol Symbol a k NoReft)
_ RTypeBV Symbol Symbol a k NoReft
t NoReft
_) RTypeBV Symbol Symbol a k NoReft
t'
  = HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t RTypeBV Symbol Symbol a k NoReft
t'
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t (RAllT RTVar k (RTypeBV Symbol Symbol a k NoReft)
_ RTypeBV Symbol Symbol a k NoReft
t' NoReft
_)
  = HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t RTypeBV Symbol Symbol a k NoReft
t'
eqRSort HashMap k k
m (RFun Symbol
_ RFInfo
_ RTypeBV Symbol Symbol a k NoReft
t1 RTypeBV Symbol Symbol a k NoReft
t2 NoReft
_) (RFun Symbol
_ RFInfo
_ RTypeBV Symbol Symbol a k NoReft
t1' RTypeBV Symbol Symbol a k NoReft
t2' NoReft
_)
  = HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t1 RTypeBV Symbol Symbol a k NoReft
t1' Bool -> Bool -> Bool
&& HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t2 RTypeBV Symbol Symbol a k NoReft
t2'
eqRSort HashMap k k
m (RAppTy RTypeBV Symbol Symbol a k NoReft
t1 RTypeBV Symbol Symbol a k NoReft
t2 NoReft
_) (RAppTy RTypeBV Symbol Symbol a k NoReft
t1' RTypeBV Symbol Symbol a k NoReft
t2' NoReft
_)
  = HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t1 RTypeBV Symbol Symbol a k NoReft
t1' Bool -> Bool -> Bool
&& HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m RTypeBV Symbol Symbol a k NoReft
t2 RTypeBV Symbol Symbol a k NoReft
t2'
eqRSort HashMap k k
m (RApp a
c [RTypeBV Symbol Symbol a k NoReft]
ts [RTPropBV Symbol Symbol a k NoReft]
_ NoReft
_) (RApp a
c' [RTypeBV Symbol Symbol a k NoReft]
ts' [RTPropBV Symbol Symbol a k NoReft]
_ NoReft
_)
  = a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c' Bool -> Bool -> Bool
&& [RTypeBV Symbol Symbol a k NoReft] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RTypeBV Symbol Symbol a k NoReft]
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [RTypeBV Symbol Symbol a k NoReft] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RTypeBV Symbol Symbol a k NoReft]
ts' Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((RTypeBV Symbol Symbol a k NoReft
 -> RTypeBV Symbol Symbol a k NoReft -> Bool)
-> [RTypeBV Symbol Symbol a k NoReft]
-> [RTypeBV Symbol Symbol a k NoReft]
-> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (HashMap k k
-> RTypeBV Symbol Symbol a k NoReft
-> RTypeBV Symbol Symbol a k NoReft
-> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k) =>
HashMap k k -> RType a k NoReft -> RType a k NoReft -> Bool
eqRSort HashMap k k
m) [RTypeBV Symbol Symbol a k NoReft]
ts [RTypeBV Symbol Symbol a k NoReft]
ts')
eqRSort HashMap k k
m (RVar k
a NoReft
_) (RVar k
a' NoReft
_)
  = k
a k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k -> k -> HashMap k k -> k
forall k v. Hashable k => v -> k -> HashMap k v -> v
M.lookupDefault k
a' k
a' HashMap k k
m
eqRSort HashMap k k
_ (RHole NoReft
_) RTypeBV Symbol Symbol a k NoReft
_
  = Bool
True
eqRSort HashMap k k
_ RTypeBV Symbol Symbol a k NoReft
_         (RHole NoReft
_)
  = Bool
True
eqRSort HashMap k k
_ RTypeBV Symbol Symbol a k NoReft
_ RTypeBV Symbol Symbol a k NoReft
_
  = Bool
False

--------------------------------------------------------------------------------
-- | Wrappers for GHC Type Elements --------------------------------------------
--------------------------------------------------------------------------------

instance Eq RTyVar where
  -- FIXME: need to compare unique and string because we reuse
  -- uniques in stringTyVar and co.
  RTV Var
α == :: RTyVar -> RTyVar -> Bool
== RTV Var
α' = Var
α Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
α' Bool -> Bool -> Bool
&& Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
α OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
α'

instance Ord RTyVar where
  compare :: RTyVar -> RTyVar -> Ordering
compare (RTV Var
α) (RTV Var
α') = case Var -> Var -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Var
α Var
α' of
    Ordering
EQ -> OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
α) (Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
α')
    Ordering
o  -> Ordering
o

instance Hashable RTyVar where
  hashWithSalt :: Int -> RTyVar -> Int
hashWithSalt Int
i (RTV Var
α) = Int -> Var -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i Var
α

-- TyCon isn't comparable
--instance Ord RTyCon where
--  compare x y = compare (rtc_tc x) (rtc_tc y)

instance Hashable RTyCon where
  hashWithSalt :: Int -> RTyCon -> Int
hashWithSalt Int
i = Int -> TyCon -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i (TyCon -> Int) -> (RTyCon -> TyCon) -> RTyCon -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTyCon -> TyCon
rtc_tc

--------------------------------------------------------------------------------
-- | Helper Functions (RJ: Helping to do what?) --------------------------------
--------------------------------------------------------------------------------

rVar :: IsReft r => TyVar -> RType c RTyVar r
rVar :: forall r c. IsReft r => Var -> RType c RTyVar r
rVar   = (RTyVar -> r -> RTypeBV Symbol Symbol c RTyVar r
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
`RVar` r
forall r. IsReft r => r
trueReft) (RTyVar -> RTypeBV Symbol Symbol c RTyVar r)
-> (Var -> RTyVar) -> Var -> RTypeBV Symbol Symbol c RTyVar r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> RTyVar
RTV

rTyVar :: TyVar -> RTyVar
rTyVar :: Var -> RTyVar
rTyVar = Var -> RTyVar
RTV

updateRTVar :: IsReft r => RTVar RTyVar i -> RTVar RTyVar (RType RTyCon RTyVar r)
updateRTVar :: forall r i.
IsReft r =>
RTVar RTyVar i -> RTVar RTyVar (RType RTyCon RTyVar r)
updateRTVar (RTVar (RTV Var
a) RTVInfo i
_) = RTyVar
-> RTVInfo (RType RTyCon RTyVar r)
-> RTVar RTyVar (RType RTyCon RTyVar r)
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar (Var -> RTyVar
RTV Var
a) (Var -> RTVInfo (RType RTyCon RTyVar r)
forall r. IsReft r => Var -> RTVInfo (RRType r)
rTVarInfo Var
a)

rTVar :: IsReft r => TyVar -> RTVar RTyVar (RRType r)
rTVar :: forall r. IsReft r => Var -> RTVar RTyVar (RRType r)
rTVar Var
a = RTyVar -> RTVInfo (RRType r) -> RTVar RTyVar (RRType r)
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar (Var -> RTyVar
RTV Var
a) (Var -> RTVInfo (RRType r)
forall r. IsReft r => Var -> RTVInfo (RRType r)
rTVarInfo Var
a)

bTVar :: IsReft r => TyVar -> RTVar BTyVar (BRType r)
bTVar :: forall r. IsReft r => Var -> RTVar BTyVar (BRType r)
bTVar Var
a = BTyVar -> RTVInfo (BRType r) -> RTVar BTyVar (BRType r)
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar (Located Symbol -> BTyVar
BTV (Var -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Var -> Symbol) -> Located Var -> Located Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Var -> Located Var
forall a. NamedThing a => a -> Located a
GM.locNamedThing Var
a)) (Var -> RTVInfo (BRType r)
forall r. IsReft r => Var -> RTVInfo (BRType r)
bTVarInfo Var
a)

bTVarInfo :: IsReft r => TyVar -> RTVInfo (BRType r)
bTVarInfo :: forall r. IsReft r => Var -> RTVInfo (BRType r)
bTVarInfo = (Type -> BRType r) -> Var -> RTVInfo (BRType r)
forall s. (Type -> s) -> Var -> RTVInfo s
mkTVarInfo Type -> BRType r
forall r. IsReft r => Type -> BRType r
kindToBRType

rTVarInfo :: IsReft r => TyVar -> RTVInfo (RRType r)
rTVarInfo :: forall r. IsReft r => Var -> RTVInfo (RRType r)
rTVarInfo = (Type -> RRType r) -> Var -> RTVInfo (RRType r)
forall s. (Type -> s) -> Var -> RTVInfo s
mkTVarInfo Type -> RRType r
forall r. IsReft r => Type -> RRType r
kindToRType

mkTVarInfo :: (Kind -> s) -> TyVar -> RTVInfo s
mkTVarInfo :: forall s. (Type -> s) -> Var -> RTVInfo s
mkTVarInfo Type -> s
k2t Var
a = RTVInfo
  { rtv_name :: Symbol
rtv_name   = Name -> Symbol
forall a. Symbolic a => a -> Symbol
symbol    (Name -> Symbol) -> Name -> Symbol
forall a b. (a -> b) -> a -> b
$ Var -> Name
varName Var
a
  , rtv_kind :: s
rtv_kind   = Type -> s
k2t       (Type -> s) -> Type -> s
forall a b. (a -> b) -> a -> b
$ Var -> Type
tyVarKind Var
a
  , rtv_is_val :: Bool
rtv_is_val = Type -> Bool
isValKind (Type -> Bool) -> Type -> Bool
forall a b. (a -> b) -> a -> b
$ Var -> Type
tyVarKind Var
a
  , rtv_is_pol :: Bool
rtv_is_pol = Bool
True
  }

kindToRType :: IsReft r => Type -> RRType r
kindToRType :: forall r. IsReft r => Type -> RRType r
kindToRType = (Type -> RTypeBV Symbol Symbol RTyCon RTyVar r)
-> Type -> RTypeBV Symbol Symbol RTyCon RTyVar r
forall z. (Type -> z) -> Type -> z
kindToRType_ Type -> RTypeBV Symbol Symbol RTyCon RTyVar r
forall r. IsReft r => Type -> RRType r
ofType

kindToBRType :: IsReft r => Type -> BRType r
kindToBRType :: forall r. IsReft r => Type -> BRType r
kindToBRType = (Type -> RTypeBV Symbol Symbol BTyCon BTyVar r)
-> Type -> RTypeBV Symbol Symbol BTyCon BTyVar r
forall z. (Type -> z) -> Type -> z
kindToRType_ Type -> RTypeBV Symbol Symbol BTyCon BTyVar r
forall r. IsReft r => Type -> BRType r
bareOfType

kindToRType_ :: (Type -> z) -> Type -> z
kindToRType_ :: forall z. (Type -> z) -> Type -> z
kindToRType_ Type -> z
ofType'       = Type -> z
ofType' (Type -> z) -> (Type -> Type) -> Type -> z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
go
  where
    go :: Type -> Type
go Type
t
     | Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
typeSymbolKind = Type
stringTy
     | Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
naturalTy      = Type
intTy
     | Bool
otherwise           = Type
t

isValKind :: Kind -> Bool
isValKind :: Type -> Bool
isValKind Type
x0 =
    let x :: Type
x = Type -> Type
expandTypeSynonyms Type
x0
     in Type
x Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
naturalTy Bool -> Bool -> Bool
|| Type
x Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
typeSymbolKind

bTyVar :: LocSymbol -> BTyVar
bTyVar :: Located Symbol -> BTyVar
bTyVar      = Located Symbol -> BTyVar
BTV

symbolRTyVar :: Symbol -> RTyVar
symbolRTyVar :: Symbol -> RTyVar
symbolRTyVar = Var -> RTyVar
rTyVar (Var -> RTyVar) -> (Symbol -> Var) -> Symbol -> RTyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Var
GM.symbolTyVar

bareRTyVar :: BTyVar -> RTyVar
bareRTyVar :: BTyVar -> RTyVar
bareRTyVar (BTV Located Symbol
tv) = Symbol -> RTyVar
symbolRTyVar (Symbol -> RTyVar) -> Symbol -> RTyVar
forall a b. (a -> b) -> a -> b
$ Located Symbol -> Symbol
forall a. Located a -> a
val Located Symbol
tv

normalizePds :: (OkRT c tv r) => RType c tv r -> RType c tv r
normalizePds :: forall c tv r. OkRT c tv r => RType c tv r -> RType c tv r
normalizePds RType c tv r
t = [PVar (RType c tv NoReft)] -> RType c tv r -> RType c tv r
forall (t :: * -> *) c tv r.
Foldable t =>
t (PVar (RType c tv NoReft)) -> RType c tv r -> RType c tv r
addPds [PVar (RType c tv NoReft)]
ps RType c tv r
t'
  where
    (RType c tv r
t', [PVar (RType c tv NoReft)]
ps)   = [PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
forall c tv r.
OkRT c tv r =>
[PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP [] RType c tv r
t

rPred :: PVar (RType c tv NoReft) -> RType c tv r -> RType c tv r
rPred :: forall c tv r.
PVar (RType c tv NoReft) -> RType c tv r -> RType c tv r
rPred     = PVUBV Symbol Symbol c tv
-> RTypeBV Symbol Symbol c tv r -> RTypeBV Symbol Symbol c tv r
forall b v c tv r.
PVUBV b v c tv -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllP

rEx :: Foldable t
    => t (Symbol, RType c tv r) -> RType c tv r -> RType c tv r
rEx :: forall (t :: * -> *) c tv r.
Foldable t =>
t (Symbol, RType c tv r) -> RType c tv r -> RType c tv r
rEx t (Symbol, RType c tv r)
xts RType c tv r
rt = ((Symbol, RType c tv r) -> RType c tv r -> RType c tv r)
-> RType c tv r -> t (Symbol, RType c tv r) -> RType c tv r
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Symbol
x, RType c tv r
tx) RType c tv r
t -> Symbol -> RType c tv r -> RType c tv r -> RType c tv r
forall b v c tv r.
b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
REx Symbol
x RType c tv r
tx RType c tv r
t) RType c tv r
rt t (Symbol, RType c tv r)
xts

rApp :: TyCon
     -> [RType RTyCon tv r]
     -> [RTProp RTyCon tv r]
     -> r
     -> RType RTyCon tv r
rApp :: forall tv r.
TyCon
-> [RType RTyCon tv r]
-> [RTProp RTyCon tv r]
-> r
-> RType RTyCon tv r
rApp TyCon
c = RTyCon
-> [RTypeBV Symbol Symbol RTyCon tv r]
-> [RTPropBV Symbol Symbol RTyCon tv r]
-> r
-> RTypeBV Symbol Symbol RTyCon tv r
forall b v c tv r.
c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
RApp (TyCon -> RTyCon
tyConRTyCon TyCon
c)

gApp :: TyCon -> [RTyVar] -> [PVar a] -> SpecType
gApp :: forall a. TyCon -> [RTyVar] -> [PVar a] -> SpecType
gApp TyCon
tc [RTyVar]
αs [PVar a]
πs = TyCon
-> [SpecType] -> [RTProp RTyCon RTyVar RReft] -> RReft -> SpecType
forall tv r.
TyCon
-> [RType RTyCon tv r]
-> [RTProp RTyCon tv r]
-> r
-> RType RTyCon tv r
rApp TyCon
tc
                  [Var -> SpecType
forall r c. IsReft r => Var -> RType c RTyVar r
rVar Var
α | RTV Var
α <- [RTyVar]
αs]
                  ([(Symbol, RType RTyCon RTyVar NoReft)]
-> RReft -> RTProp RTyCon RTyVar RReft
forall b τ r v c tv. [(b, τ)] -> r -> RefB b τ (RTypeV v c tv r)
rPropP [] (RReft -> RTProp RTyCon RTyVar RReft)
-> (PVar a -> RReft) -> PVar a -> RTProp RTyCon RTyVar RReft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVar a -> RReft
forall t. PVar t -> RReft
pdVarReft (PVar a -> RTProp RTyCon RTyVar RReft)
-> [PVar a] -> [RTProp RTyCon RTyVar RReft]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PVar a]
πs)
                  RReft
forall a. Monoid a => a
mempty

pdVarReft :: PVar t -> UReft Reft
pdVarReft :: forall t. PVar t -> RReft
pdVarReft = (\PredicateBV Symbol Symbol
p -> ReftBV Symbol Symbol -> PredicateBV Symbol Symbol -> RReft
forall b v r. r -> PredicateBV b v -> UReftBV b v r
MkUReft ReftBV Symbol Symbol
forall a. Monoid a => a
mempty PredicateBV Symbol Symbol
p) (PredicateBV Symbol Symbol -> RReft)
-> (PVarBV Symbol Symbol t -> PredicateBV Symbol Symbol)
-> PVarBV Symbol Symbol t
-> RReft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVarBV Symbol Symbol t -> PredicateBV Symbol Symbol
forall v t. PVarV v t -> PredicateV v
pdVar

tyConRTyCon :: TyCon -> RTyCon
tyConRTyCon :: TyCon -> RTyCon
tyConRTyCon TyCon
c = TyCon -> [RPVar] -> TyConInfo -> RTyCon
RTyCon TyCon
c [] (TyCon -> VarianceInfo -> VarianceInfo -> Maybe SizeFun -> TyConInfo
mkTyConInfo TyCon
c [] [] Maybe SizeFun
forall a. Maybe a
Nothing)

-- bApp :: (Monoid r) => TyCon -> [BRType r] -> BRType r
bApp :: TyCon -> [BRType r] -> [BRProp r] -> r -> BRType r
bApp :: forall r. TyCon -> [BRType r] -> [BRProp r] -> r -> BRType r
bApp TyCon
c = BTyCon
-> [RTypeBV Symbol Symbol BTyCon BTyVar r]
-> [RTPropBV Symbol Symbol BTyCon BTyVar r]
-> r
-> RTypeBV Symbol Symbol BTyCon BTyVar r
forall b v c tv r.
c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
RApp (TyCon -> BTyCon
tyConBTyCon TyCon
c)

tyConBTyCon :: TyCon -> BTyCon
tyConBTyCon :: TyCon -> BTyCon
tyConBTyCon TyCon
tc =
  Located LHName -> BTyCon
mkBTyCon (Located LHName -> BTyCon) -> Located LHName -> BTyCon
forall a b. (a -> b) -> a -> b
$
    LHResolvedName -> Symbol -> LHName
makeResolvedLHName (Name -> LHResolvedName
LHRGHC (TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tc)) (Symbol -> LHName) -> (TyCon -> Symbol) -> TyCon -> LHName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Symbol
tyConName (TyCon -> LHName) -> Located TyCon -> Located LHName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyCon -> Located TyCon
forall a. NamedThing a => a -> Located a
GM.locNamedThing TyCon
tc


--- NV TODO : remove this code!!!

addPds :: Foldable t
       => t (PVar (RType c tv NoReft)) -> RType c tv r -> RType c tv r
addPds :: forall (t :: * -> *) c tv r.
Foldable t =>
t (PVar (RType c tv NoReft)) -> RType c tv r -> RType c tv r
addPds t (PVar (RType c tv NoReft))
ps (RAllT RTVUBV Symbol Symbol c tv
v RTypeBV Symbol Symbol c tv r
t r
r) = RTVUBV Symbol Symbol c tv
-> RTypeBV Symbol Symbol c tv r
-> r
-> RTypeBV Symbol Symbol c tv r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT RTVUBV Symbol Symbol c tv
v (t (PVar (RType c tv NoReft))
-> RTypeBV Symbol Symbol c tv r -> RTypeBV Symbol Symbol c tv r
forall (t :: * -> *) c tv r.
Foldable t =>
t (PVar (RType c tv NoReft)) -> RType c tv r -> RType c tv r
addPds t (PVar (RType c tv NoReft))
ps RTypeBV Symbol Symbol c tv r
t) r
r
addPds t (PVar (RType c tv NoReft))
ps RTypeBV Symbol Symbol c tv r
t             = (RTypeBV Symbol Symbol c tv r
 -> PVar (RType c tv NoReft) -> RTypeBV Symbol Symbol c tv r)
-> RTypeBV Symbol Symbol c tv r
-> t (PVar (RType c tv NoReft))
-> RTypeBV Symbol Symbol c tv r
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((PVar (RType c tv NoReft)
 -> RTypeBV Symbol Symbol c tv r -> RTypeBV Symbol Symbol c tv r)
-> RTypeBV Symbol Symbol c tv r
-> PVar (RType c tv NoReft)
-> RTypeBV Symbol Symbol c tv r
forall a b c. (a -> b -> c) -> b -> a -> c
flip PVar (RType c tv NoReft)
-> RTypeBV Symbol Symbol c tv r -> RTypeBV Symbol Symbol c tv r
forall c tv r.
PVar (RType c tv NoReft) -> RType c tv r -> RType c tv r
rPred) RTypeBV Symbol Symbol c tv r
t t (PVar (RType c tv NoReft))
ps

nlzP :: (OkRT c tv r) => [PVar (RType c tv NoReft)] -> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP :: forall c tv r.
OkRT c tv r =>
[PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP [PVar (RType c tv NoReft)]
ps t :: RTypeBV Symbol Symbol c tv r
t@(RVar tv
_ r
_ )
 = (RTypeBV Symbol Symbol c tv r
t, [PVar (RType c tv NoReft)]
ps)
nlzP [PVar (RType c tv NoReft)]
ps (RFun Symbol
b RFInfo
i RTypeBV Symbol Symbol c tv r
t1 RTypeBV Symbol Symbol c tv r
t2 r
r)
 = (Symbol
-> RFInfo
-> RTypeBV Symbol Symbol c tv r
-> RTypeBV Symbol Symbol c tv r
-> r
-> RTypeBV Symbol Symbol c tv r
forall b v c tv r.
b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
RFun Symbol
b RFInfo
i RTypeBV Symbol Symbol c tv r
t1' RTypeBV Symbol Symbol c tv r
t2' r
r, [PVar (RType c tv NoReft)]
ps [PVar (RType c tv NoReft)]
-> [PVar (RType c tv NoReft)] -> [PVar (RType c tv NoReft)]
forall a. [a] -> [a] -> [a]
++ [PVar (RType c tv NoReft)]
ps1 [PVar (RType c tv NoReft)]
-> [PVar (RType c tv NoReft)] -> [PVar (RType c tv NoReft)]
forall a. [a] -> [a] -> [a]
++ [PVar (RType c tv NoReft)]
ps2)
  where (RTypeBV Symbol Symbol c tv r
t1', [PVar (RType c tv NoReft)]
ps1) = [PVar (RType c tv NoReft)]
-> RTypeBV Symbol Symbol c tv r
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
forall c tv r.
OkRT c tv r =>
[PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP [] RTypeBV Symbol Symbol c tv r
t1
        (RTypeBV Symbol Symbol c tv r
t2', [PVar (RType c tv NoReft)]
ps2) = [PVar (RType c tv NoReft)]
-> RTypeBV Symbol Symbol c tv r
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
forall c tv r.
OkRT c tv r =>
[PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP [] RTypeBV Symbol Symbol c tv r
t2
nlzP [PVar (RType c tv NoReft)]
ps (RAppTy RTypeBV Symbol Symbol c tv r
t1 RTypeBV Symbol Symbol c tv r
t2 r
r)
 = (RTypeBV Symbol Symbol c tv r
-> RTypeBV Symbol Symbol c tv r
-> r
-> RTypeBV Symbol Symbol c tv r
forall b v c tv r.
RTypeBV b v c tv r -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAppTy RTypeBV Symbol Symbol c tv r
t1' RTypeBV Symbol Symbol c tv r
t2' r
r, [PVar (RType c tv NoReft)]
ps [PVar (RType c tv NoReft)]
-> [PVar (RType c tv NoReft)] -> [PVar (RType c tv NoReft)]
forall a. [a] -> [a] -> [a]
++ [PVar (RType c tv NoReft)]
ps1 [PVar (RType c tv NoReft)]
-> [PVar (RType c tv NoReft)] -> [PVar (RType c tv NoReft)]
forall a. [a] -> [a] -> [a]
++ [PVar (RType c tv NoReft)]
ps2)
  where (RTypeBV Symbol Symbol c tv r
t1', [PVar (RType c tv NoReft)]
ps1) = [PVar (RType c tv NoReft)]
-> RTypeBV Symbol Symbol c tv r
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
forall c tv r.
OkRT c tv r =>
[PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP [] RTypeBV Symbol Symbol c tv r
t1
        (RTypeBV Symbol Symbol c tv r
t2', [PVar (RType c tv NoReft)]
ps2) = [PVar (RType c tv NoReft)]
-> RTypeBV Symbol Symbol c tv r
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
forall c tv r.
OkRT c tv r =>
[PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP [] RTypeBV Symbol Symbol c tv r
t2
nlzP [PVar (RType c tv NoReft)]
ps (RAllT RTVUBV Symbol Symbol c tv
v RTypeBV Symbol Symbol c tv r
t r
r)
 = (RTVUBV Symbol Symbol c tv
-> RTypeBV Symbol Symbol c tv r
-> r
-> RTypeBV Symbol Symbol c tv r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT RTVUBV Symbol Symbol c tv
v RTypeBV Symbol Symbol c tv r
t' r
r, [PVar (RType c tv NoReft)]
ps [PVar (RType c tv NoReft)]
-> [PVar (RType c tv NoReft)] -> [PVar (RType c tv NoReft)]
forall a. [a] -> [a] -> [a]
++ [PVar (RType c tv NoReft)]
ps')
  where (RTypeBV Symbol Symbol c tv r
t', [PVar (RType c tv NoReft)]
ps') = [PVar (RType c tv NoReft)]
-> RTypeBV Symbol Symbol c tv r
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
forall c tv r.
OkRT c tv r =>
[PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP [] RTypeBV Symbol Symbol c tv r
t
nlzP [PVar (RType c tv NoReft)]
ps t :: RTypeBV Symbol Symbol c tv r
t@RApp{}
 = (RTypeBV Symbol Symbol c tv r
t, [PVar (RType c tv NoReft)]
ps)
nlzP [PVar (RType c tv NoReft)]
ps (RAllP PVar (RType c tv NoReft)
p RTypeBV Symbol Symbol c tv r
t)
 = (RTypeBV Symbol Symbol c tv r
t', [PVar (RType c tv NoReft)
p] [PVar (RType c tv NoReft)]
-> [PVar (RType c tv NoReft)] -> [PVar (RType c tv NoReft)]
forall a. [a] -> [a] -> [a]
++ [PVar (RType c tv NoReft)]
ps [PVar (RType c tv NoReft)]
-> [PVar (RType c tv NoReft)] -> [PVar (RType c tv NoReft)]
forall a. [a] -> [a] -> [a]
++ [PVar (RType c tv NoReft)]
ps')
  where (RTypeBV Symbol Symbol c tv r
t', [PVar (RType c tv NoReft)]
ps') = [PVar (RType c tv NoReft)]
-> RTypeBV Symbol Symbol c tv r
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
forall c tv r.
OkRT c tv r =>
[PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP [] RTypeBV Symbol Symbol c tv r
t
nlzP [PVar (RType c tv NoReft)]
ps t :: RTypeBV Symbol Symbol c tv r
t@REx{}
 = (RTypeBV Symbol Symbol c tv r
t, [PVar (RType c tv NoReft)]
ps)
nlzP [PVar (RType c tv NoReft)]
ps t :: RTypeBV Symbol Symbol c tv r
t@(RRTy [(Symbol, RTypeBV Symbol Symbol c tv r)]
_ r
_ Oblig
_ RTypeBV Symbol Symbol c tv r
t')
 = (RTypeBV Symbol Symbol c tv r
t, [PVar (RType c tv NoReft)]
ps [PVar (RType c tv NoReft)]
-> [PVar (RType c tv NoReft)] -> [PVar (RType c tv NoReft)]
forall a. [a] -> [a] -> [a]
++ [PVar (RType c tv NoReft)]
ps')
 where ps' :: [PVar (RType c tv NoReft)]
ps' = (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
-> [PVar (RType c tv NoReft)]
forall a b. (a, b) -> b
snd ((RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
 -> [PVar (RType c tv NoReft)])
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
-> [PVar (RType c tv NoReft)]
forall a b. (a -> b) -> a -> b
$ [PVar (RType c tv NoReft)]
-> RTypeBV Symbol Symbol c tv r
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
forall c tv r.
OkRT c tv r =>
[PVar (RType c tv NoReft)]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv NoReft)])
nlzP [] RTypeBV Symbol Symbol c tv r
t'
nlzP [PVar (RType c tv NoReft)]
ps t :: RTypeBV Symbol Symbol c tv r
t@RAllE{}
 = (RTypeBV Symbol Symbol c tv r
t, [PVar (RType c tv NoReft)]
ps)
nlzP [PVar (RType c tv NoReft)]
_ RTypeBV Symbol Symbol c tv r
t
 = Maybe SrcSpan
-> [Char]
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing ([Char]
 -> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)]))
-> [Char]
-> (RTypeBV Symbol Symbol c tv r, [PVar (RType c tv NoReft)])
forall a b. (a -> b) -> a -> b
$ [Char]
"RefType.nlzP: cannot handle " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ RTypeBV Symbol Symbol c tv r -> [Char]
forall a. Show a => a -> [Char]
show RTypeBV Symbol Symbol c tv r
t

strengthenRefTypeGen, strengthenRefType ::
         ( OkRTBV v v c tv r
         , Subable r
         , F.Variable r ~ v
         , ReftBind r ~ v
         , IsReft r
         , FreeVar c tv
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v))
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) c
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTVar tv (RTypeBV v v c tv (NoReftB v)))
         ) => RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r

strengthenRefType_ ::
         ( OkRTBV v v c tv r
         , Subable r
         , F.Variable r ~ v
         , ReftBind r ~ v
         , IsReft r
         , FreeVar c tv
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v))
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) c
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) r
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) (RTVar tv (RTypeBV v v c tv (NoReftB v)))
         , SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv
         ) => (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
           ->  RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r

strengthenRefTypeGen :: forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v)))) =>
RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefTypeGen = (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, IsReft r) =>
RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f
  where
    f :: (OkRTBV v v c tv r, IsReft r) => RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
    f :: forall v c tv r.
(OkRTBV v v c tv r, IsReft r) =>
RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RVar tv
v1 r
r1) RTypeBV v v c tv r
t  = tv -> r -> RTypeBV v v c tv r
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
RVar tv
v1 (r
r1 r -> r -> r
forall r. Meet r => r -> r -> r
`meet` r -> Maybe r -> r
forall a. a -> Maybe a -> a
fromMaybe r
forall r. IsReft r => r
trueReft (RTypeBV v v c tv r -> Maybe r
forall b v c tv r. RTypeBV b v c tv r -> Maybe r
stripRTypeBase RTypeBV v v c tv r
t))
    f RTypeBV v v c tv r
t (RVar tv
_ r
r1)  = RTypeBV v v c tv r
t RTypeBV v v c tv r -> r -> RTypeBV v v c tv r
forall r b v c tv.
Meet r =>
RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
`strengthen` r
r1
    f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2           = Maybe SrcSpan -> [Char] -> RTypeBV v v c tv r
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing ([Char] -> RTypeBV v v c tv r) -> [Char] -> RTypeBV v v c tv r
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char] -> [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"strengthenRefTypeGen on differently shaped types \nt1 = %s [shape = %s]\nt2 = %s [shape = %s]"
                         (RTypeBV v v c tv r -> [Char]
forall b v c tv r.
OkRTBV b v c tv r =>
RTypeBV b v c tv r -> [Char]
pprRaw RTypeBV v v c tv r
t1) (RTypeBV v v c tv (NoReftB v) -> [Char]
forall a. PPrint a => a -> [Char]
showpp (RTypeBV v v c tv r -> RTypeBV v v c tv (NoReftB v)
forall b v c tv r.
Binder b =>
RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
toRSort RTypeBV v v c tv r
t1)) (RTypeBV v v c tv r -> [Char]
forall b v c tv r.
OkRTBV b v c tv r =>
RTypeBV b v c tv r -> [Char]
pprRaw RTypeBV v v c tv r
t2) (RTypeBV v v c tv (NoReftB v) -> [Char]
forall a. PPrint a => a -> [Char]
showpp (RTypeBV v v c tv r -> RTypeBV v v c tv (NoReftB v)
forall b v c tv r.
Binder b =>
RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
toRSort RTypeBV v v c tv r
t2))

pprRaw :: (OkRTBV b v c tv r) => RTypeBV b v c tv r -> String
pprRaw :: forall b v c tv r.
OkRTBV b v c tv r =>
RTypeBV b v c tv r -> [Char]
pprRaw = Doc -> [Char]
render (Doc -> [Char])
-> (RTypeBV b v c tv r -> Doc) -> RTypeBV b v c tv r -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tidy -> RTypeBV b v c tv r -> Doc
forall b v c tv r.
OkRTBV b v c tv r =>
Tidy -> RTypeBV b v c tv r -> Doc
rtypeDoc Tidy
Full

{- [NOTE:StrengthenRefType] disabling the `meetable` check because

      (1) It requires the 'TCEmb TyCon' to deal with the fact that sometimes,
          GHC uses the "Family Instance" TyCon e.g. 'R:UniquePerson' and sometimes
          the vanilla TyCon App form, e.g. 'Unique Person'
      (2) We could pass in the TCEmb but that would break the 'Monoid' instance for
          RType. The 'Monoid' instance was was probably a bad idea to begin with,
          and we probably ought to do away with it entirely, but thats a battle I'll
          leave for another day.

    Consequently, its up to users of `strengthenRefType` (and associated functions)
    to make sure that the two types are compatible. For an example, see 'meetVarTypes'.
 -}

strengthenRefType :: forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v)))) =>
RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2
  -- | _meetable t1 t2
  = (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall a b. a -> b -> a
const RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2
  -- | otherwise
  -- = panic Nothing msg
  -- where
  --   msg = printf "strengthen on differently shaped reftypes \nt1 = %s [shape = %s]\nt2 = %s [shape = %s]"
  --           (showpp t1) (showpp (toRSort t1)) (showpp t2) (showpp (toRSort t2))

_meetable :: (OkRTBV b v c tv r) => RTypeBV b v c tv r -> RTypeBV b v c tv r -> Bool
_meetable :: forall b v c tv r.
OkRTBV b v c tv r =>
RTypeBV b v c tv r -> RTypeBV b v c tv r -> Bool
_meetable RTypeBV b v c tv r
t1 RTypeBV b v c tv r
t2 = RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
forall b v c tv r.
Binder b =>
RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
toRSort RTypeBV b v c tv r
t1 RTypeBV b v c tv (NoReftB b)
-> RTypeBV b v c tv (NoReftB b) -> Bool
forall a. Eq a => a -> a -> Bool
== RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
forall b v c tv r.
Binder b =>
RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
toRSort RTypeBV b v c tv r
t2

strengthenRefType_ :: forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RAllT RTVar tv (RTypeBV v v c tv (NoReftB v))
a1 RTypeBV v v c tv r
t1 r
r1) (RAllT RTVar tv (RTypeBV v v c tv (NoReftB v))
a2 RTypeBV v v c tv r
t2 r
r2)
  = RTVar tv (RTypeBV v v c tv (NoReftB v))
-> RTypeBV v v c tv r -> r -> RTypeBV v v c tv r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT RTVar tv (RTypeBV v v c tv (NoReftB v))
a1 ((RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 ((tv, RTypeBV v v c tv (NoReftB v), RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet (RTVar tv (RTypeBV v v c tv (NoReftB v)) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value RTVar tv (RTypeBV v v c tv (NoReftB v))
a2, RTypeBV v v c tv r -> RTypeBV v v c tv (NoReftB v)
forall b v c tv r.
Binder b =>
RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
toRSort RTypeBV v v c tv r
t, RTypeBV v v c tv r
t) RTypeBV v v c tv r
t2)) (r
r1 r -> r -> r
forall r. Meet r => r -> r -> r
`meet` r
r2)
  where t :: RTypeBV v v c tv r
t = tv -> r -> RTypeBV v v c tv r
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
RVar (RTVar tv (RTypeBV v v c tv (NoReftB v)) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value RTVar tv (RTypeBV v v c tv (NoReftB v))
a1) r
forall r. IsReft r => r
trueReft

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RAllT RTVar tv (RTypeBV v v c tv (NoReftB v))
a RTypeBV v v c tv r
t1 r
r1) RTypeBV v v c tv r
t2
  = RTVar tv (RTypeBV v v c tv (NoReftB v))
-> RTypeBV v v c tv r -> r -> RTypeBV v v c tv r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT RTVar tv (RTypeBV v v c tv (NoReftB v))
a ((RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2) r
r1

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 (RAllT RTVar tv (RTypeBV v v c tv (NoReftB v))
a RTypeBV v v c tv r
t2 r
r2)
  = RTVar tv (RTypeBV v v c tv (NoReftB v))
-> RTypeBV v v c tv r -> r -> RTypeBV v v c tv r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT RTVar tv (RTypeBV v v c tv (NoReftB v))
a ((RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2) r
r2

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RAllP PVUBV v v c tv
p1 RTypeBV v v c tv r
t1) (RAllP PVUBV v v c tv
_ RTypeBV v v c tv r
t2)
  = PVUBV v v c tv -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall b v c tv r.
PVUBV b v c tv -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllP PVUBV v v c tv
p1 (RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall a b. (a -> b) -> a -> b
$ (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RAllP PVUBV v v c tv
p RTypeBV v v c tv r
t1) RTypeBV v v c tv r
t2
  = PVUBV v v c tv -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall b v c tv r.
PVUBV b v c tv -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllP PVUBV v v c tv
p (RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall a b. (a -> b) -> a -> b
$ (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 (RAllP PVUBV v v c tv
p RTypeBV v v c tv r
t2)
  = PVUBV v v c tv -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall b v c tv r.
PVUBV b v c tv -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllP PVUBV v v c tv
p (RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall a b. (a -> b) -> a -> b
$ (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RAllE v
x RTypeBV v v c tv r
tx RTypeBV v v c tv r
t1) (RAllE v
y RTypeBV v v c tv r
ty RTypeBV v v c tv r
t2) | v
x v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
y
  = v -> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall b v c tv r.
b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllE v
x ((RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
tx RTypeBV v v c tv r
ty) (RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall a b. (a -> b) -> a -> b
$ (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RAllE v
x RTypeBV v v c tv r
tx RTypeBV v v c tv r
t1) RTypeBV v v c tv r
t2
  = v -> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall b v c tv r.
b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllE v
x RTypeBV v v c tv r
tx (RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall a b. (a -> b) -> a -> b
$ (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 (RAllE v
x RTypeBV v v c tv r
tx RTypeBV v v c tv r
t2)
  = v -> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall b v c tv r.
b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllE v
x RTypeBV v v c tv r
tx (RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall a b. (a -> b) -> a -> b
$ (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RAppTy RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t1' r
r1) (RAppTy RTypeBV v v c tv r
t2 RTypeBV v v c tv r
t2' r
r2)
  = RTypeBV v v c tv r -> RTypeBV v v c tv r -> r -> RTypeBV v v c tv r
forall b v c tv r.
RTypeBV b v c tv r -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAppTy RTypeBV v v c tv r
t RTypeBV v v c tv r
t' (r
r1 r -> r -> r
forall r. Meet r => r -> r -> r
`meet` r
r2)
    where t :: RTypeBV v v c tv r
t  = (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2
          t' :: RTypeBV v v c tv r
t' = (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1' RTypeBV v v c tv r
t2'

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RFun v
x1 RFInfo
i1 RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t1' r
r1) (RFun v
x2 RFInfo
i2 RTypeBV v v c tv r
t2 RTypeBV v v c tv r
t2' r
r2) =
  -- YL: Evidence that we need a Monoid instance for RFInfo?
  if v
x2 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
/= v
forall b. Binder b => b
F.wildcard
    then v
-> RFInfo
-> RTypeBV v v c tv r
-> RTypeBV v v c tv r
-> r
-> RTypeBV v v c tv r
forall b v c tv r.
b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
RFun v
x2 RFInfo
i1{permitTC = getFirst b} RTypeBV v v c tv r
t RTypeBV v v c tv r
t1'' (r
r1 r -> r -> r
forall r. Meet r => r -> r -> r
`meet` r
r2)
    else v
-> RFInfo
-> RTypeBV v v c tv r
-> RTypeBV v v c tv r
-> r
-> RTypeBV v v c tv r
forall b v c tv r.
b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
RFun v
x1 RFInfo
i1{permitTC = getFirst b} RTypeBV v v c tv r
t RTypeBV v v c tv r
t2'' (r
r1 r -> r -> r
forall r. Meet r => r -> r -> r
`meet` r
r2)
    where t :: RTypeBV v v c tv r
t  = (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2
          t1'' :: RTypeBV v v c tv r
t1'' = (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RTypeBV v v c tv r
-> (Variable (RTypeBV v v c tv r),
    ExprBV
      (Variable (RTypeBV v v c tv r)) (Variable (RTypeBV v v c tv r)))
-> RTypeBV v v c tv r
forall a.
Subable a =>
a -> (Variable a, ExprBV (Variable a) (Variable a)) -> a
subst1 RTypeBV v v c tv r
t1' (v
Variable (RTypeBV v v c tv r)
x1, v -> ExprBV v v
forall b v. v -> ExprBV b v
EVar v
x2)) RTypeBV v v c tv r
t2'
          t2'' :: RTypeBV v v c tv r
t2'' = (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1' (RTypeBV v v c tv r
-> (Variable (RTypeBV v v c tv r),
    ExprBV
      (Variable (RTypeBV v v c tv r)) (Variable (RTypeBV v v c tv r)))
-> RTypeBV v v c tv r
forall a.
Subable a =>
a -> (Variable a, ExprBV (Variable a) (Variable a)) -> a
subst1 RTypeBV v v c tv r
t2' (v
Variable (RTypeBV v v c tv r)
x2, v -> ExprBV v v
forall b v. v -> ExprBV b v
EVar v
x1))
          b :: First Bool
b  = Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (RFInfo -> Maybe Bool
permitTC RFInfo
i1) First Bool -> First Bool -> First Bool
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> First Bool
forall a. Maybe a -> First a
First (RFInfo -> Maybe Bool
permitTC RFInfo
i2)

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f (RApp c
tid [RTypeBV v v c tv r]
t1s [RTPropBV v v c tv r]
rs1 r
r1) (RApp c
_ [RTypeBV v v c tv r]
t2s [RTPropBV v v c tv r]
rs2 r
r2)
  = c
-> [RTypeBV v v c tv r]
-> [RTPropBV v v c tv r]
-> r
-> RTypeBV v v c tv r
forall b v c tv r.
c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
RApp c
tid [RTypeBV v v c tv r]
ts [RTPropBV v v c tv r]
rs (r
r1 r -> r -> r
forall r. Meet r => r -> r -> r
`meet` r
r2)
    where ts :: [RTypeBV v v c tv r]
ts  = (RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> [RTypeBV v v c tv r]
-> [RTypeBV v v c tv r]
-> [RTypeBV v v c tv r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall v c tv r.
(OkRTBV v v c tv r, Subable r, Variable r ~ v, ReftBind r ~ v,
 IsReft r, FreeVar c tv,
 SubsTy
   tv (RTypeBV v v c tv (NoReftB v)) (RTypeBV v v c tv (NoReftB v)),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) c,
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) r,
 SubsTy
   tv
   (RTypeBV v v c tv (NoReftB v))
   (RTVar tv (RTypeBV v v c tv (NoReftB v))),
 SubsTy tv (RTypeBV v v c tv (NoReftB v)) tv) =>
(RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f) [RTypeBV v v c tv r]
t1s [RTypeBV v v c tv r]
t2s
          rs :: [RTPropBV v v c tv r]
rs  = [RTPropBV v v c tv r]
-> [RTPropBV v v c tv r] -> [RTPropBV v v c tv r]
forall r. Meet r => [r] -> [r] -> [r]
meets [RTPropBV v v c tv r]
rs1 [RTPropBV v v c tv r]
rs2

strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
_ (RVar tv
v1 r
r1)  (RVar tv
v2 r
r2) | tv
v1 tv -> tv -> Bool
forall a. Eq a => a -> a -> Bool
== tv
v2
  = tv -> r -> RTypeBV v v c tv r
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
RVar tv
v1 (r
r1 r -> r -> r
forall r. Meet r => r -> r -> r
`meet` r
r2)
strengthenRefType_ RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2
  = RTypeBV v v c tv r -> RTypeBV v v c tv r -> RTypeBV v v c tv r
f RTypeBV v v c tv r
t1 RTypeBV v v c tv r
t2

meets :: (Meet r) => [r] -> [r] -> [r]
meets :: forall r. Meet r => [r] -> [r] -> [r]
meets [] [r]
rs                 = [r]
rs
meets [r]
rs []                 = [r]
rs
meets [r]
rs [r]
rs'
  | [r] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [r]
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [r] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [r]
rs' = (r -> r -> r) -> [r] -> [r] -> [r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith r -> r -> r
forall r. Meet r => r -> r -> r
meet [r]
rs [r]
rs'
  | Bool
otherwise               = Maybe SrcSpan -> [Char] -> [r]
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"meets: unbalanced rs"

strengthen :: Meet r => RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
strengthen :: forall r b v c tv.
Meet r =>
RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
strengthen = (r -> r -> r) -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
forall r b v c tv.
(r -> r -> r) -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
strengthenWith r -> r -> r
forall r. Meet r => r -> r -> r
meet

strengthenWith :: (r -> r -> r) -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
strengthenWith :: forall r b v c tv.
(r -> r -> r) -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
strengthenWith r -> r -> r
mt = RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
go
  where
    go :: RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
go (RApp c
c [RTypeBV b v c tv r]
ts [RTPropBV b v c tv r]
rs r
r)   r
r' = c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
forall b v c tv r.
c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
RApp c
c [RTypeBV b v c tv r]
ts [RTPropBV b v c tv r]
rs   (r
r r -> r -> r
`mt` r
r')
    go (RVar tv
a r
r)         r
r' = tv -> r -> RTypeBV b v c tv r
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
RVar tv
a         (r
r r -> r -> r
`mt` r
r')
    go (RFun b
b RFInfo
i RTypeBV b v c tv r
t1 RTypeBV b v c tv r
t2 r
r) r
r' = b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
forall b v c tv r.
b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
RFun b
b RFInfo
i RTypeBV b v c tv r
t1 RTypeBV b v c tv r
t2 (r
r r -> r -> r
`mt` r
r')
    go (RAppTy RTypeBV b v c tv r
t1 RTypeBV b v c tv r
t2 r
r)   r
r' = RTypeBV b v c tv r -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
forall b v c tv r.
RTypeBV b v c tv r -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAppTy RTypeBV b v c tv r
t1 RTypeBV b v c tv r
t2   (r
r r -> r -> r
`mt` r
r')
    go (RAllT RTVUBV b v c tv
a RTypeBV b v c tv r
t r
r)      r
r' = RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT RTVUBV b v c tv
a RTypeBV b v c tv r
t      (r
r r -> r -> r
`mt` r
r')
    go (RHole r
r)          r
r' = r -> RTypeBV b v c tv r
forall b v c tv r. r -> RTypeBV b v c tv r
RHole          (r
r r -> r -> r
`mt` r
r')
    go RTypeBV b v c tv r
t                  r
_  = RTypeBV b v c tv r
t


quantifyRTy :: (Monoid r, Eq tv) => [RTVar tv (RTypeV v c tv NoReft)] -> RTypeV v c tv r -> RTypeV v c tv r
quantifyRTy :: forall r tv v c.
(Monoid r, Eq tv) =>
[RTVar tv (RTypeV v c tv NoReft)]
-> RTypeV v c tv r -> RTypeV v c tv r
quantifyRTy [RTVar tv (RTypeV v c tv NoReft)]
tvs RTypeV v c tv r
ty = (RTVar tv (RTypeV v c tv NoReft)
 -> RTypeV v c tv r -> RTypeV v c tv r)
-> RTypeV v c tv r
-> [RTVar tv (RTypeV v c tv NoReft)]
-> RTypeV v c tv r
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RTVar tv (RTypeV v c tv NoReft)
-> RTypeV v c tv r -> RTypeV v c tv r
forall {r} {tv} {b} {v} {c}.
Monoid r =>
RTVar tv (RTypeBV b v c tv (NoReftB b))
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
rAllT RTypeV v c tv r
ty [RTVar tv (RTypeV v c tv NoReft)]
tvs
  where rAllT :: RTVar tv (RTypeBV b v c tv (NoReftB b))
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
rAllT RTVar tv (RTypeBV b v c tv (NoReftB b))
a RTypeBV b v c tv r
t = RTVar tv (RTypeBV b v c tv (NoReftB b))
-> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT RTVar tv (RTypeBV b v c tv (NoReftB b))
a RTypeBV b v c tv r
t r
forall a. Monoid a => a
mempty

quantifyFreeRTy :: (Monoid r, Eq tv) => RTypeV v c tv r -> RTypeV v c tv r
quantifyFreeRTy :: forall r tv v c.
(Monoid r, Eq tv) =>
RTypeV v c tv r -> RTypeV v c tv r
quantifyFreeRTy RTypeV v c tv r
ty = [RTVar tv (RTypeV v c tv NoReft)]
-> RTypeV v c tv r -> RTypeV v c tv r
forall r tv v c.
(Monoid r, Eq tv) =>
[RTVar tv (RTypeV v c tv NoReft)]
-> RTypeV v c tv r -> RTypeV v c tv r
quantifyRTy (RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeV v c tv r
ty) RTypeV v c tv r
ty


-------------------------------------------------------------------------
addTyConInfo :: (PPrint r, ToReft r, SubsTy RTyVar RSort r, Variable r ~ Symbol, ReftBind r ~ Symbol, ReftVar r ~ Symbol, IsReft r)
             => TCEmb TyCon
             -> TyConMap
             -> RRType r
             -> RRType r
-------------------------------------------------------------------------
addTyConInfo :: forall r.
(PPrint r, ToReft r, SubsTy RTyVar (RType RTyCon RTyVar NoReft) r,
 Variable r ~ Symbol, ReftBind r ~ Symbol, ReftVar r ~ Symbol,
 IsReft r) =>
TCEmb TyCon -> TyConMap -> RRType r -> RRType r
addTyConInfo TCEmb TyCon
tce TyConMap
tyi = (RType RTyCon RTyVar r -> RType RTyCon RTyVar r)
-> RType RTyCon RTyVar r -> RType RTyCon RTyVar r
forall c tv r.
(RType c tv r -> RType c tv r) -> RType c tv r -> RType c tv r
mapBot (TCEmb TyCon
-> TyConMap -> RType RTyCon RTyVar r -> RType RTyCon RTyVar r
forall r.
(PPrint r, ToReft r, SubsTy RTyVar (RType RTyCon RTyVar NoReft) r,
 Variable r ~ Symbol, ReftBind r ~ Symbol, ReftVar r ~ Symbol,
 IsReft r) =>
TCEmb TyCon -> TyConMap -> RRType r -> RRType r
expandRApp TCEmb TyCon
tce TyConMap
tyi)

-------------------------------------------------------------------------
expandRApp :: (PPrint r, ToReft r, SubsTy RTyVar RSort r, Variable r ~ Symbol, ReftBind r ~ Symbol, ReftVar r ~ Symbol, IsReft r)
           => TCEmb TyCon -> TyConMap -> RRType r -> RRType r
-------------------------------------------------------------------------
expandRApp :: forall r.
(PPrint r, ToReft r, SubsTy RTyVar (RType RTyCon RTyVar NoReft) r,
 Variable r ~ Symbol, ReftBind r ~ Symbol, ReftVar r ~ Symbol,
 IsReft r) =>
TCEmb TyCon -> TyConMap -> RRType r -> RRType r
expandRApp TCEmb TyCon
tce TyConMap
tyi t :: RType RTyCon RTyVar r
t@RApp{} = RTyCon
-> [RType RTyCon RTyVar r]
-> [RTProp RTyCon RTyVar r]
-> r
-> RType RTyCon RTyVar r
forall b v c tv r.
c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
RApp RTyCon
rc' [RType RTyCon RTyVar r]
ts [RTProp RTyCon RTyVar r]
rs' r
r
  where
    RApp RTyCon
rc [RType RTyCon RTyVar r]
ts [RTProp RTyCon RTyVar r]
rs r
r            = RType RTyCon RTyVar r
t
    (RTyCon
rc', [RPVar]
_)                   = TCEmb TyCon
-> TyConMap
-> RTyCon
-> [RType RTyCon RTyVar r]
-> (RTyCon, [RPVar])
forall r.
ToTypeable r =>
TCEmb TyCon
-> TyConMap -> RTyCon -> [RRType r] -> (RTyCon, [RPVar])
appRTyCon TCEmb TyCon
tce TyConMap
tyi RTyCon
rc [RType RTyCon RTyVar r]
as
    pvs :: [RPVar]
pvs                        = RTyCon -> [RPVar]
rTyConPVs RTyCon
rc'
    rs' :: [RTProp RTyCon RTyVar r]
rs'                        = [RTProp RTyCon RTyVar r]
-> ([RTProp RTyCon RTyVar r] -> [RTProp RTyCon RTyVar r])
-> [RTProp RTyCon RTyVar r]
-> [RTProp RTyCon RTyVar r]
forall b a. b -> ([a] -> b) -> [a] -> b
applyNonNull [RTProp RTyCon RTyVar r]
rs0 (RTyCon
-> [RPVar] -> [RTProp RTyCon RTyVar r] -> [RTProp RTyCon RTyVar r]
forall a r c tv.
(Fixpoint a, IsReft r) =>
a
-> [PVar (RType c tv NoReft)]
-> [Ref (RType c tv NoReft) (RType c tv r)]
-> [Ref (RType c tv NoReft) (RType c tv r)]
rtPropPV RTyCon
rc [RPVar]
pvs) [RTProp RTyCon RTyVar r]
rs
    rs0 :: [RTProp RTyCon RTyVar r]
rs0                        = RPVar -> RTProp RTyCon RTyVar r
forall c tv r.
(OkRT c tv r, IsReft r, SubsTy tv (RType c tv NoReft) c,
 SubsTy tv (RType c tv NoReft) r,
 SubsTy tv (RType c tv NoReft) (RType c tv NoReft), FreeVar c tv,
 SubsTy tv (RType c tv NoReft) tv,
 SubsTy tv (RType c tv NoReft) (RTVar tv (RType c tv NoReft))) =>
PVar (RType c tv NoReft) -> Ref (RType c tv NoReft) (RType c tv r)
rtPropTop (RPVar -> RTProp RTyCon RTyVar r)
-> [RPVar] -> [RTProp RTyCon RTyVar r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPVar]
pvs
    n :: Int
n                          = [Var] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Var]
fVs
    fVs :: [Var]
fVs                        = TyCon -> [Var]
GM.tyConTyVarsDef (TyCon -> [Var]) -> TyCon -> [Var]
forall a b. (a -> b) -> a -> b
$ RTyCon -> TyCon
rtc_tc RTyCon
rc
    as :: [RType RTyCon RTyVar r]
as                         = Int
-> [RType RTyCon RTyVar r]
-> [RType RTyCon RTyVar r]
-> [RType RTyCon RTyVar r]
forall a. Int -> [a] -> [a] -> [a]
choosen Int
n [RType RTyCon RTyVar r]
ts (Var -> RType RTyCon RTyVar r
forall r c. IsReft r => Var -> RType c RTyVar r
rVar (Var -> RType RTyCon RTyVar r) -> [Var] -> [RType RTyCon RTyVar r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
fVs)
expandRApp TCEmb TyCon
_ TyConMap
_ RType RTyCon RTyVar r
t               = RType RTyCon RTyVar r
t

choosen :: Int -> [a] -> [a] -> [a]
choosen :: forall a. Int -> [a] -> [a] -> [a]
choosen Int
0 [a]
_ [a]
_           = []
choosen Int
i (a
x:[a]
xs) (a
_:[a]
ys) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:Int -> [a] -> [a] -> [a]
forall a. Int -> [a] -> [a] -> [a]
choosen (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs [a]
ys
choosen Int
i []     (a
y:[a]
ys) = a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:Int -> [a] -> [a] -> [a]
forall a. Int -> [a] -> [a] -> [a]
choosen (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [] [a]
ys
choosen Int
_ [a]
_ [a]
_           = Maybe SrcSpan -> [Char] -> [a]
forall a. Maybe SrcSpan -> [Char] -> a
impossible Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"choosen: this cannot happen"


rtPropTop
  :: (OkRT c tv r,
      IsReft r,
      SubsTy tv (RType c tv NoReft) c, SubsTy tv (RType c tv NoReft) r,
      SubsTy tv (RType c tv NoReft) (RType c tv NoReft), FreeVar c tv,
      SubsTy tv (RType c tv NoReft) tv,
      SubsTy tv (RType c tv NoReft) (RTVar tv (RType c tv NoReft)))
   => PVar (RType c tv NoReft) -> Ref (RType c tv NoReft) (RType c tv r)
rtPropTop :: forall c tv r.
(OkRT c tv r, IsReft r, SubsTy tv (RType c tv NoReft) c,
 SubsTy tv (RType c tv NoReft) r,
 SubsTy tv (RType c tv NoReft) (RType c tv NoReft), FreeVar c tv,
 SubsTy tv (RType c tv NoReft) tv,
 SubsTy tv (RType c tv NoReft) (RTVar tv (RType c tv NoReft))) =>
PVar (RType c tv NoReft) -> Ref (RType c tv NoReft) (RType c tv r)
rtPropTop PVar (RType c tv NoReft)
pv = [(Symbol, RType c tv NoReft)]
-> RType c tv r -> RefB Symbol (RType c tv NoReft) (RType c tv r)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp (PVar (RType c tv NoReft) -> [(Symbol, RType c tv NoReft)]
forall t. PVar t -> [(Symbol, t)]
pvArgs PVar (RType c tv NoReft)
pv) (RType c tv r -> RefB Symbol (RType c tv NoReft) (RType c tv r))
-> RType c tv r -> RefB Symbol (RType c tv NoReft) (RType c tv r)
forall a b. (a -> b) -> a -> b
$ RType c tv NoReft -> RType c tv r
forall r b v c tv.
IsReft r =>
RTypeBV b v c tv (NoReftB b) -> RTypeBV b v c tv r
ofRSort (RType c tv NoReft -> RType c tv r)
-> RType c tv NoReft -> RType c tv r
forall a b. (a -> b) -> a -> b
$ PVar (RType c tv NoReft) -> RType c tv NoReft
forall b v t. PVarBV b v t -> t
ptype PVar (RType c tv NoReft)
pv

rtPropPV :: (Fixpoint a, IsReft r)
         => a
         -> [PVar (RType c tv NoReft)]
         -> [Ref (RType c tv NoReft) (RType c tv r)]
         -> [Ref (RType c tv NoReft) (RType c tv r)]
rtPropPV :: forall a r c tv.
(Fixpoint a, IsReft r) =>
a
-> [PVar (RType c tv NoReft)]
-> [Ref (RType c tv NoReft) (RType c tv r)]
-> [Ref (RType c tv NoReft) (RType c tv r)]
rtPropPV a
_rc = (PVar (RType c tv NoReft)
 -> Ref (RType c tv NoReft) (RType c tv r)
 -> Ref (RType c tv NoReft) (RType c tv r))
-> [PVar (RType c tv NoReft)]
-> [Ref (RType c tv NoReft) (RType c tv r)]
-> [Ref (RType c tv NoReft) (RType c tv r)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PVar (RType c tv NoReft)
-> Ref (RType c tv NoReft) (RType c tv r)
-> Ref (RType c tv NoReft) (RType c tv r)
forall r c tv.
IsReft r =>
PVar (RType c tv NoReft)
-> Ref (RType c tv NoReft) (RType c tv r)
-> Ref (RType c tv NoReft) (RType c tv r)
mkRTProp

mkRTProp :: IsReft r
         => PVar (RType c tv NoReft)
         -> Ref (RType c tv NoReft) (RType c tv r)
         -> Ref (RType c tv NoReft) (RType c tv r)
mkRTProp :: forall r c tv.
IsReft r =>
PVar (RType c tv NoReft)
-> Ref (RType c tv NoReft) (RType c tv r)
-> Ref (RType c tv NoReft) (RType c tv r)
mkRTProp PVar (RType c tv NoReft)
pv (RProp [(Symbol, RType c tv NoReft)]
ss (RHole r
r))
  = [(Symbol, RType c tv NoReft)]
-> RType c tv r -> RefB Symbol (RType c tv NoReft) (RType c tv r)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp [(Symbol, RType c tv NoReft)]
ss (RType c tv r -> RefB Symbol (RType c tv NoReft) (RType c tv r))
-> RType c tv r -> RefB Symbol (RType c tv NoReft) (RType c tv r)
forall a b. (a -> b) -> a -> b
$ RType c tv NoReft -> RType c tv r
forall r b v c tv.
IsReft r =>
RTypeBV b v c tv (NoReftB b) -> RTypeBV b v c tv r
ofRSort (PVar (RType c tv NoReft) -> RType c tv NoReft
forall b v t. PVarBV b v t -> t
pvType PVar (RType c tv NoReft)
pv) RType c tv r -> r -> RType c tv r
forall r b v c tv.
Meet r =>
RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
`strengthen` r
r

mkRTProp PVar (RType c tv NoReft)
pv (RProp [(Symbol, RType c tv NoReft)]
ss RType c tv r
t)
  | [(RType c tv NoReft, Symbol, Expr)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PVar (RType c tv NoReft) -> [(RType c tv NoReft, Symbol, Expr)]
forall b v t. PVarBV b v t -> [(t, b, ExprBV b v)]
pargs PVar (RType c tv NoReft)
pv) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Symbol, RType c tv NoReft)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Symbol, RType c tv NoReft)]
ss
  = [(Symbol, RType c tv NoReft)]
-> RType c tv r -> RefB Symbol (RType c tv NoReft) (RType c tv r)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp [(Symbol, RType c tv NoReft)]
ss RType c tv r
t
  | Bool
otherwise
  = [(Symbol, RType c tv NoReft)]
-> RType c tv r -> RefB Symbol (RType c tv NoReft) (RType c tv r)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp (PVar (RType c tv NoReft) -> [(Symbol, RType c tv NoReft)]
forall t. PVar t -> [(Symbol, t)]
pvArgs PVar (RType c tv NoReft)
pv) RType c tv r
t

pvArgs :: PVar t -> [(Symbol, t)]
pvArgs :: forall t. PVar t -> [(Symbol, t)]
pvArgs PVar t
pv = [(Symbol
s, t
t) | (t
t, Symbol
s, Expr
_) <- PVar t -> [(t, Symbol, Expr)]
forall b v t. PVarBV b v t -> [(t, b, ExprBV b v)]
pargs PVar t
pv]

{- | [NOTE:FamInstPredVars] related to [NOTE:FamInstEmbeds]
     See tests/datacon/pos/T1446.hs
     The function txRefSort converts

        Int<p>              ===> {v:Int | p v}

     which is fine, but also converts

        Field<q> Blob a     ===> {v:Field Blob a | q v}

     which is NOT ok, because q expects a different arg.

     The above happens because, thanks to instance-family stuff,
     LH doesn't realize that q is actually an ARG of Field Blob
     Note that Field itself has no args, but Field Blob does...

     That is, it is not enough to store the refined `TyCon` info,
     solely in the `RTyCon` as with family instances, you need BOTH
     the `TyCon` and the args to determine the extra info.

     We do so in `TyConMap`, and by crucially extending

     @RefType.appRTyCon@ whose job is to use the Refined @TyCon@
     that is, the @RTyCon@ generated from the @TyConP@ to strengthen
     individual occurrences of the TyCon applied to various arguments.

 -}

appRTyCon :: (ToTypeable r) => TCEmb TyCon -> TyConMap -> RTyCon -> [RRType r] -> (RTyCon, [RPVar])
appRTyCon :: forall r.
ToTypeable r =>
TCEmb TyCon
-> TyConMap -> RTyCon -> [RRType r] -> (RTyCon, [RPVar])
appRTyCon TCEmb TyCon
tce TyConMap
tyi RTyCon
rc [RRType r]
ts = [Char] -> (RTyCon, [RPVar]) -> (RTyCon, [RPVar])
forall a. PPrint a => [Char] -> a -> a
F.notracepp [Char]
_msg (RTyCon
resTc, [RPVar]
ps'')
  where
    _msg :: [Char]
_msg  = [Char]
"appRTyCon-family: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Bool, Int, [Type]) -> [Char]
forall a. PPrint a => a -> [Char]
showpp (TyCon -> Bool
Ghc.isFamilyTyCon TyCon
c, TyCon -> Int
Ghc.tyConRealArity TyCon
c, Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
False (RRType r -> Type) -> [RRType r] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RRType r]
ts)
    resTc :: RTyCon
resTc = TyCon -> [RPVar] -> TyConInfo -> RTyCon
RTyCon TyCon
c [RPVar]
ps'' (RTyCon -> TyConInfo
rtc_info RTyCon
rc'')
    c :: TyCon
c     = RTyCon -> TyCon
rtc_tc RTyCon
rc

    (RTyCon
rc', [RPVar]
ps') = TyConMap -> RTyCon -> [Sort] -> (RTyCon, [RPVar])
rTyConWithPVars TyConMap
tyi RTyCon
rc (TCEmb TyCon -> RRType r -> Sort
forall r.
(PPrint r, IsReft r, ReftBind r ~ Symbol, ReftVar r ~ Symbol,
 SubsTy RTyVar (RType RTyCon RTyVar NoReft) r) =>
TCEmb TyCon -> RRType r -> Sort
rTypeSort TCEmb TyCon
tce (RRType r -> Sort) -> [RRType r] -> [Sort]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RRType r]
ts)
    -- TODO:faminst-preds rc'   = M.lookupDefault rc c (tcmTyRTy tyi)
    -- TODO:faminst-preds ps'   = rTyConPVs rc'

    -- TODO:faminst-preds: these substitutions may be WRONG if we are using FAMINST.
    ps'' :: [RPVar]
ps''  = [(RTyVar, RType RTyCon RTyVar NoReft)] -> RPVar -> RPVar
forall tv ty c. SubsTy tv ty c => [(tv, ty)] -> c -> c
subts ([RTyVar]
-> [RType RTyCon RTyVar NoReft]
-> [(RTyVar, RType RTyCon RTyVar NoReft)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Var -> RTyVar
RTV (Var -> RTyVar) -> [Var] -> [RTyVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
αs) [RType RTyCon RTyVar NoReft]
ts') (RPVar -> RPVar) -> [RPVar] -> [RPVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPVar]
ps'
      where
        ts' :: [RType RTyCon RTyVar NoReft]
ts' = if [RRType r] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RRType r]
ts then Var -> RType RTyCon RTyVar NoReft
forall r c. IsReft r => Var -> RType c RTyVar r
rVar (Var -> RType RTyCon RTyVar NoReft)
-> [Var] -> [RType RTyCon RTyVar NoReft]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
βs else RRType r -> RType RTyCon RTyVar NoReft
forall b v c tv r.
Binder b =>
RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
toRSort (RRType r -> RType RTyCon RTyVar NoReft)
-> [RRType r] -> [RType RTyCon RTyVar NoReft]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RRType r]
ts
        αs :: [Var]
αs  = TyCon -> [Var]
GM.tyConTyVarsDef (RTyCon -> TyCon
rtc_tc RTyCon
rc')
        βs :: [Var]
βs  = TyCon -> [Var]
GM.tyConTyVarsDef TyCon
c

    rc'' :: RTyCon
rc''  = if TCEmb TyCon -> RTyCon -> Bool
isNumeric TCEmb TyCon
tce RTyCon
rc' then RTyCon -> RTyCon
addNumSizeFun RTyCon
rc' else RTyCon
rc'

rTyConWithPVars :: TyConMap -> RTyCon -> [F.Sort] -> (RTyCon, [RPVar])
rTyConWithPVars :: TyConMap -> RTyCon -> [Sort] -> (RTyCon, [RPVar])
rTyConWithPVars TyConMap
tyi RTyCon
rc [Sort]
ts = case TyConMap -> RTyCon -> [Sort] -> Maybe RTyCon
famInstTyConMb TyConMap
tyi RTyCon
rc [Sort]
ts of
  Just RTyCon
fiRc    -> (RTyCon
rc', RTyCon -> [RPVar]
rTyConPVs RTyCon
fiRc)       -- use the PVars from the family-instance TyCon
  Maybe RTyCon
Nothing      -> (RTyCon
rc', [RPVar]
ps')                  -- use the PVars from the origin          TyCon
  where
    (RTyCon
rc', [RPVar]
ps') = TyConMap -> RTyCon -> (RTyCon, [RPVar])
plainRTyConPVars TyConMap
tyi RTyCon
rc

-- | @famInstTyConMb rc args@ uses the @RTyCon@ AND @args@ to see if
--   this is a family instance @RTyCon@, and if so, returns it.
--   see [NOTE:FamInstPredVars]
--   eg: 'famInstTyConMb tyi Field [Blob, a]' should give 'Just R:FieldBlob'

famInstTyConMb :: TyConMap -> RTyCon -> [F.Sort] -> Maybe RTyCon
famInstTyConMb :: TyConMap -> RTyCon -> [Sort] -> Maybe RTyCon
famInstTyConMb TyConMap
tyi RTyCon
rc [Sort]
ts = do
  let c :: TyCon
c = RTyCon -> TyCon
rtc_tc RTyCon
rc
  n    <- TyCon -> HashMap TyCon Int -> Maybe Int
forall k v. Hashable k => k -> HashMap k v -> Maybe v
M.lookup TyCon
c      (TyConMap -> HashMap TyCon Int
tcmFtcArity TyConMap
tyi)
  M.lookup (c, take n ts) (tcmFIRTy    tyi)

famInstTyConType :: Ghc.TyCon -> Maybe Ghc.Type
famInstTyConType :: TyCon -> Maybe Type
famInstTyConType TyCon
c = (TyCon -> [Type] -> Type) -> (TyCon, [Type]) -> Type
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TyCon -> [Type] -> Type
Ghc.mkTyConApp ((TyCon, [Type]) -> Type) -> Maybe (TyCon, [Type]) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyCon -> Maybe (TyCon, [Type])
famInstArgs TyCon
c

-- | @famInstArgs c@ destructs a family-instance @TyCon@ into its components, e.g.
--   e.g. 'famInstArgs R:FieldBlob' is @(Field, [Blob])@

famInstArgs :: Ghc.TyCon -> Maybe (Ghc.TyCon, [Ghc.Type])
famInstArgs :: TyCon -> Maybe (TyCon, [Type])
famInstArgs TyCon
c = case TyCon -> Maybe (TyCon, [Type])
Ghc.tyConFamInst_maybe TyCon
c of
    Just (TyCon
c', [Type]
ts) -> [Char] -> Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type])
forall a. PPrint a => [Char] -> a -> a
F.notracepp ([Char]
"famInstArgs: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (TyCon, Int, [Type]) -> [Char]
forall a. PPrint a => a -> [Char]
F.showpp (TyCon
c, Int
cArity, [Type]
ts))
                     (Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type]))
-> Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type])
forall a b. (a -> b) -> a -> b
$ (TyCon, [Type]) -> Maybe (TyCon, [Type])
forall a. a -> Maybe a
Just (TyCon
c', Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
take ([Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cArity) [Type]
ts)
    Maybe (TyCon, [Type])
Nothing       -> Maybe (TyCon, [Type])
forall a. Maybe a
Nothing
    where
      cArity :: Int
cArity      = TyCon -> Int
Ghc.tyConRealArity TyCon
c

-- TODO:faminst-preds: case Ghc.tyConFamInst_maybe c of
-- TODO:faminst-preds:   Just (c', ts) -> F.tracepp ("famInstTyConType: " ++ F.showpp (c, Ghc.tyConArity c, ts))
-- TODO:faminst-preds:                    $ Just (famInstType (Ghc.tyConArity c) c' ts)
-- TODO:faminst-preds:   Nothing       -> Nothing

-- TODO:faminst-preds: famInstType :: Int -> Ghc.TyCon -> [Ghc.Type] -> Ghc.Type
-- TODO:faminst-preds: famInstType n c ts = Ghc.mkTyConApp c (take (length ts - n) ts)




-- | @plainTyConPVars@ uses the @TyCon@ to return the
--   "refined" @RTyCon@ and @RPVars@ from the refined
--   'data' definition for the @TyCon@, e.g. will use
--   'List Int' to return 'List<p> Int' (if List has an abs-ref).
plainRTyConPVars :: TyConMap -> RTyCon -> (RTyCon, [RPVar])
plainRTyConPVars :: TyConMap -> RTyCon -> (RTyCon, [RPVar])
plainRTyConPVars TyConMap
tyi RTyCon
rc = (RTyCon
rc', RTyCon -> [RPVar]
rTyConPVs RTyCon
rc')
  where
    rc' :: RTyCon
rc'                   = RTyCon -> TyCon -> HashMap TyCon RTyCon -> RTyCon
forall k v. Hashable k => v -> k -> HashMap k v -> v
M.lookupDefault RTyCon
rc (RTyCon -> TyCon
rtc_tc RTyCon
rc) (TyConMap -> HashMap TyCon RTyCon
tcmTyRTy TyConMap
tyi)



-- RJ: The code of `isNumeric` is incomprehensible.
-- Please fix it to use intSort instead of intFTyCon
isNumeric :: TCEmb TyCon -> RTyCon -> Bool
isNumeric :: TCEmb TyCon -> RTyCon -> Bool
isNumeric TCEmb TyCon
tce RTyCon
c = Sort -> Bool
F.isNumeric Sort
mySort
  where
    -- mySort      = M.lookupDefault def rc tce
    mySort :: Sort
mySort      = Sort -> ((Sort, TCArgs) -> Sort) -> Maybe (Sort, TCArgs) -> Sort
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sort
def (Sort, TCArgs) -> Sort
forall a b. (a, b) -> a
fst (TyCon -> TCEmb TyCon -> Maybe (Sort, TCArgs)
forall a.
(Eq a, Hashable a) =>
a -> TCEmb a -> Maybe (Sort, TCArgs)
F.tceLookup TyCon
rc TCEmb TyCon
tce)
    def :: Sort
def         = FTycon -> Sort
FTC (FTycon -> Sort) -> (TyCon -> FTycon) -> TyCon -> Sort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Symbol -> FTycon
symbolFTycon (Located Symbol -> FTycon)
-> (TyCon -> Located Symbol) -> TyCon -> FTycon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Located Symbol
forall a. a -> Located a
dummyLoc (Symbol -> Located Symbol)
-> (TyCon -> Symbol) -> TyCon -> Located Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Symbol
tyConName (TyCon -> Sort) -> TyCon -> Sort
forall a b. (a -> b) -> a -> b
$ TyCon
rc
    rc :: TyCon
rc          = RTyCon -> TyCon
rtc_tc RTyCon
c

addNumSizeFun :: RTyCon -> RTyCon
addNumSizeFun :: RTyCon -> RTyCon
addNumSizeFun RTyCon
c
  = RTyCon
c {rtc_info = (rtc_info c) {sizeFunction = Just IdSizeFun } }


generalize :: (Eq tv, Monoid r) => RType c tv r -> RType c tv r
generalize :: forall tv r c. (Eq tv, Monoid r) => RType c tv r -> RType c tv r
generalize RType c tv r
t = [(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)]
-> [PVarBV Symbol Symbol (RTypeBV Symbol Symbol c tv NoReft)]
-> RType c tv r
-> RType c tv r
forall (t :: * -> *) (t1 :: * -> *) tv b v c r.
(Foldable t, Foldable t1) =>
t (RTVar tv (RTypeBV b v c tv (NoReftB b)), r)
-> t1 (PVarBV b v (RTypeBV b v c tv (NoReftB b)))
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
mkUnivs ((RTVar tv (RTypeBV Symbol Symbol c tv NoReft)
 -> (RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r))
-> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
-> [(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)]
forall a b. (a -> b) -> [a] -> [b]
map (, r
forall a. Monoid a => a
mempty) (RType c tv r -> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RType c tv r
t)) [] RType c tv r
t

allTyVars :: (Ord tv) => RType c tv r -> [tv]
allTyVars :: forall tv c r. Ord tv => RType c tv r -> [tv]
allTyVars = [tv] -> [tv]
forall a. Ord a => [a] -> [a]
sortNub ([tv] -> [tv])
-> (RTypeBV Symbol Symbol c tv r -> [tv])
-> RTypeBV Symbol Symbol c tv r
-> [tv]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTypeBV Symbol Symbol c tv r -> [tv]
forall tv c r. Eq tv => RType c tv r -> [tv]
allTyVars'

allTyVars' :: (Eq tv) => RType c tv r -> [tv]
allTyVars' :: forall tv c r. Eq tv => RType c tv r -> [tv]
allTyVars' RType c tv r
t = (RTVar tv (RTypeBV Symbol Symbol c tv NoReft) -> tv)
-> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)] -> [tv]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RTVar tv (RTypeBV Symbol Symbol c tv NoReft) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value ([RTVar tv (RTypeBV Symbol Symbol c tv NoReft)] -> [tv])
-> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)] -> [tv]
forall a b. (a -> b) -> a -> b
$ [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
vs [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
-> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
-> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
forall a. [a] -> [a] -> [a]
++ [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
vs'
  where
    vs :: [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
vs      = ((RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)
 -> RTVar tv (RTypeBV Symbol Symbol c tv NoReft))
-> [(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)]
-> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
forall a b. (a -> b) -> [a] -> [b]
map (RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)
-> RTVar tv (RTypeBV Symbol Symbol c tv NoReft)
forall a b. (a, b) -> a
fst ([(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)]
 -> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)])
-> (RType c tv r
    -> [(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)])
-> RType c tv r
-> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)],
 [PVarBV Symbol Symbol (RTypeBV Symbol Symbol c tv NoReft)],
 RType c tv r)
-> [(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)]
forall a b c. (a, b, c) -> a
fst3 (([(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)],
  [PVarBV Symbol Symbol (RTypeBV Symbol Symbol c tv NoReft)],
  RType c tv r)
 -> [(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)])
-> (RType c tv r
    -> ([(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)],
        [PVarBV Symbol Symbol (RTypeBV Symbol Symbol c tv NoReft)],
        RType c tv r))
-> RType c tv r
-> [(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RType c tv r
-> ([(RTVar tv (RTypeBV Symbol Symbol c tv NoReft), r)],
    [PVarBV Symbol Symbol (RTypeBV Symbol Symbol c tv NoReft)],
    RType c tv r)
forall b v tv c r.
RTypeBV b v tv c r
-> ([(RTVar c (RTypeBV b v tv c (NoReftB b)), r)],
    [PVarBV b v (RTypeBV b v tv c (NoReftB b))], RTypeBV b v tv c r)
bkUniv (RType c tv r -> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)])
-> RType c tv r -> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
forall a b. (a -> b) -> a -> b
$ RType c tv r
t
    vs' :: [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
vs'     = RType c tv r -> [RTVar tv (RTypeBV Symbol Symbol c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RType c tv r
t


freeTyVars :: Eq tv => RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars :: forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars (RAllP PVUBV Symbol v c tv
_ RTypeBV Symbol v c tv r
t)       = RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
t
freeTyVars (RAllT RTVar tv (RTypeV v c tv NoReft)
α RTypeBV Symbol v c tv r
t r
_)     = RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
t [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [RTVar tv (RTypeV v c tv NoReft)
α]
freeTyVars (RFun Symbol
_ RFInfo
_ RTypeBV Symbol v c tv r
t RTypeBV Symbol v c tv r
t' r
_) = RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
t [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
t'
freeTyVars (RApp c
_ [RTypeBV Symbol v c tv r]
ts [RTPropBV Symbol v c tv r]
_ r
_)   = [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
forall a. Eq a => [a] -> [a]
L.nub ([RTVar tv (RTypeV v c tv NoReft)]
 -> [RTVar tv (RTypeV v c tv NoReft)])
-> [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
forall a b. (a -> b) -> a -> b
$ (RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)])
-> [RTypeBV Symbol v c tv r] -> [RTVar tv (RTypeV v c tv NoReft)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars [RTypeBV Symbol v c tv r]
ts
freeTyVars (RVar tv
α r
_)        = [tv -> RTVar tv (RTypeV v c tv NoReft)
forall tv s. tv -> RTVar tv s
makeRTVar tv
α]
freeTyVars (RAllE Symbol
_ RTypeBV Symbol v c tv r
tx RTypeBV Symbol v c tv r
t)    = RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
tx [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
t
freeTyVars (REx Symbol
_ RTypeBV Symbol v c tv r
tx RTypeBV Symbol v c tv r
t)      = RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
tx [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
t
freeTyVars (RExprArg Located (ExprBV Symbol v)
_)      = []
freeTyVars (RAppTy RTypeBV Symbol v c tv r
t RTypeBV Symbol v c tv r
t' r
_)   = RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
t [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars RTypeBV Symbol v c tv r
t'
freeTyVars (RHole r
_)         = []
freeTyVars (RRTy [(Symbol, RTypeBV Symbol v c tv r)]
e r
_ Oblig
_ RTypeBV Symbol v c tv r
t)    = [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
forall a. Eq a => [a] -> [a]
L.nub ([RTVar tv (RTypeV v c tv NoReft)]
 -> [RTVar tv (RTypeV v c tv NoReft)])
-> [RTVar tv (RTypeV v c tv NoReft)]
-> [RTVar tv (RTypeV v c tv NoReft)]
forall a b. (a -> b) -> a -> b
$ (RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)])
-> [RTypeBV Symbol v c tv r] -> [RTVar tv (RTypeV v c tv NoReft)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RTypeBV Symbol v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv NoReft)]
freeTyVars (RTypeBV Symbol v c tv r
tRTypeBV Symbol v c tv r
-> [RTypeBV Symbol v c tv r] -> [RTypeBV Symbol v c tv r]
forall a. a -> [a] -> [a]
:((Symbol, RTypeBV Symbol v c tv r) -> RTypeBV Symbol v c tv r
forall a b. (a, b) -> b
snd ((Symbol, RTypeBV Symbol v c tv r) -> RTypeBV Symbol v c tv r)
-> [(Symbol, RTypeBV Symbol v c tv r)] -> [RTypeBV Symbol v c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RTypeBV Symbol v c tv r)]
e))


tyClasses :: (OkRT RTyCon tv r) => RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses :: forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses (RAllP PVUBV Symbol Symbol RTyCon tv
_ RTypeBV Symbol Symbol RTyCon tv r
t)     = RTypeBV Symbol Symbol RTyCon tv r
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t
tyClasses (RAllT RTVUBV Symbol Symbol RTyCon tv
_ RTypeBV Symbol Symbol RTyCon tv r
t r
_)   = RTypeBV Symbol Symbol RTyCon tv r
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t
tyClasses (RAllE Symbol
_ RTypeBV Symbol Symbol RTyCon tv r
_ RTypeBV Symbol Symbol RTyCon tv r
t)   = RTypeBV Symbol Symbol RTyCon tv r
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t
tyClasses (REx Symbol
_ RTypeBV Symbol Symbol RTyCon tv r
_ RTypeBV Symbol Symbol RTyCon tv r
t)     = RTypeBV Symbol Symbol RTyCon tv r
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t
tyClasses (RFun Symbol
_ RFInfo
_ RTypeBV Symbol Symbol RTyCon tv r
t RTypeBV Symbol Symbol RTyCon tv r
t' r
_) = RTypeBV Symbol Symbol RTyCon tv r
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall a. [a] -> [a] -> [a]
++ RTypeBV Symbol Symbol RTyCon tv r
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t'
tyClasses (RAppTy RTypeBV Symbol Symbol RTyCon tv r
t RTypeBV Symbol Symbol RTyCon tv r
t' r
_) = RTypeBV Symbol Symbol RTyCon tv r
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall a. [a] -> [a] -> [a]
++ RTypeBV Symbol Symbol RTyCon tv r
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t'
tyClasses (RApp RTyCon
c [RTypeBV Symbol Symbol RTyCon tv r]
ts [RTPropBV Symbol Symbol RTyCon tv r]
_ r
_)
  | Just Class
cl <- TyCon -> Maybe Class
tyConClass_maybe (TyCon -> Maybe Class) -> TyCon -> Maybe Class
forall a b. (a -> b) -> a -> b
$ RTyCon -> TyCon
rtc_tc RTyCon
c
  = [(Class
cl, [RTypeBV Symbol Symbol RTyCon tv r]
ts)]
  | Bool
otherwise
  = []
tyClasses (RVar tv
_ r
_)      = []
tyClasses (RRTy [(Symbol, RTypeBV Symbol Symbol RTyCon tv r)]
_ r
_ Oblig
_ RTypeBV Symbol Symbol RTyCon tv r
t)  = RTypeBV Symbol Symbol RTyCon tv r
-> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t
tyClasses (RHole r
_)       = []
tyClasses RTypeBV Symbol Symbol RTyCon tv r
t               = Maybe SrcSpan
-> [Char] -> [(Class, [RTypeBV Symbol Symbol RTyCon tv r])]
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing ([Char]
"RefType.tyClasses cannot handle" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ RTypeBV Symbol Symbol RTyCon tv r -> [Char]
forall a. Show a => a -> [Char]
show RTypeBV Symbol Symbol RTyCon tv r
t)


--------------------------------------------------------------------------------
-- TODO: Rewrite subsTyvars with Traversable
--------------------------------------------------------------------------------

subsTyVarsMeet
  :: (Eq tv, Foldable t, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r) -> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarsMeet :: forall tv (t :: * -> *) r c b v.
(Eq tv, Foldable t, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarsMeet        = Bool
-> t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv (t :: * -> *) r c b v.
(Eq tv, Foldable t, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsTyVars Bool
True

subsTyVarsNoMeet
  :: (Eq tv, Foldable t, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r) -> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarsNoMeet :: forall tv (t :: * -> *) r c b v.
(Eq tv, Foldable t, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarsNoMeet      = Bool
-> t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv (t :: * -> *) r c b v.
(Eq tv, Foldable t, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsTyVars Bool
False

subsTyVarNoMeet
  :: (Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r) -> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarNoMeet :: forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarNoMeet       = Bool
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsTyVar Bool
False

subsTyVarMeet
  :: (Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r) -> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet :: forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet         = Bool
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsTyVar Bool
True

subsTyVarMeet'
  :: (Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => (tv, RTypeBV b v c tv r) -> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet' :: forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
(tv, RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet' (tv
α, RTypeBV b v c tv r
t) = (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet (tv
α, RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
forall b v c tv r.
Binder b =>
RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
toRSort RTypeBV b v c tv r
t, RTypeBV b v c tv r
t)

subsTyVars
  :: (Eq tv, Foldable t, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => Bool
  -> t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
  -> RTypeBV b v c tv r
  -> RTypeBV b v c tv r
subsTyVars :: forall tv (t :: * -> *) r c b v.
(Eq tv, Foldable t, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsTyVars Bool
meet' t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
ats RTypeBV b v c tv r
t = (RTypeBV b v c tv r
 -> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
 -> RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
 -> RTypeBV b v c tv r -> RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsTyVar Bool
meet')) RTypeBV b v c tv r
t t (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
ats

subsTyVar
  :: (Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => Bool
  -> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
  -> RTypeBV b v c tv r
  -> RTypeBV b v c tv r
subsTyVar :: forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsTyVar Bool
meet'        = Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
meet' HashSet tv
forall a. HashSet a
S.empty

subsFree
  :: (Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b)))
     )
  => Bool
  -> S.HashSet tv
  -> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
  -> RTypeBV b v c tv r
  -> RTypeBV b v c tv r
subsFree :: forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s z :: (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z@(tv
α, RTypeBV b v c tv (NoReftB b)
τ,RTypeBV b v c tv r
_) (RAllP PVarBV b v (RTypeBV b v c tv (NoReftB b))
π RTypeBV b v c tv r
t)
  = PVarBV b v (RTypeBV b v c tv (NoReftB b))
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
forall b v c tv r.
PVUBV b v c tv -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllP ((tv, RTypeBV b v c tv (NoReftB b))
-> PVarBV b v (RTypeBV b v c tv (NoReftB b))
-> PVarBV b v (RTypeBV b v c tv (NoReftB b))
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RTypeBV b v c tv (NoReftB b)
τ) PVarBV b v (RTypeBV b v c tv (NoReftB b))
π) (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t)
subsFree Bool
m HashSet tv
s z :: (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z@(tv
a, RTypeBV b v c tv (NoReftB b)
τ, RTypeBV b v c tv r
_) (RAllT RTVar tv (RTypeBV b v c tv (NoReftB b))
α RTypeBV b v c tv r
t r
r)
  -- subt inside the type variable instantiates the kind of the variable
  = RTVar tv (RTypeBV b v c tv (NoReftB b))
-> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT ((tv, RTypeBV b v c tv (NoReftB b))
-> RTVar tv (RTypeBV b v c tv (NoReftB b))
-> RTVar tv (RTypeBV b v c tv (NoReftB b))
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
a, RTypeBV b v c tv (NoReftB b)
τ) RTVar tv (RTypeBV b v c tv (NoReftB b))
α) (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m (RTVar tv (RTypeBV b v c tv (NoReftB b)) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value RTVar tv (RTypeBV b v c tv (NoReftB b))
α tv -> HashSet tv -> HashSet tv
forall a. Hashable a => a -> HashSet a -> HashSet a
`S.insert` HashSet tv
s) (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t) ((tv, RTypeBV b v c tv (NoReftB b)) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
a, RTypeBV b v c tv (NoReftB b)
τ) r
r)
subsFree Bool
m HashSet tv
s z :: (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z@(tv
α, RTypeBV b v c tv (NoReftB b)
τ, RTypeBV b v c tv r
_) (RFun b
x RFInfo
i RTypeBV b v c tv r
t RTypeBV b v c tv r
t' r
r)
  = b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
forall b v c tv r.
b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
RFun b
x RFInfo
i (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t) (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t') ((tv, RTypeBV b v c tv (NoReftB b)) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RTypeBV b v c tv (NoReftB b)
τ) r
r)
subsFree Bool
m HashSet tv
s z :: (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z@(tv
α, RTypeBV b v c tv (NoReftB b)
τ, RTypeBV b v c tv r
_) (RApp c
c [RTypeBV b v c tv r]
ts [RTPropBV b v c tv r]
rs r
r)
  = c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
forall b v c tv r.
c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
RApp c
c' (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z (RTypeBV b v c tv r -> RTypeBV b v c tv r)
-> [RTypeBV b v c tv r] -> [RTypeBV b v c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RTypeBV b v c tv r]
ts) (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTPropBV b v c tv r
-> RTPropBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTPropBV b v c tv r
-> RTPropBV b v c tv r
subsFreeRef Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z (RTPropBV b v c tv r -> RTPropBV b v c tv r)
-> [RTPropBV b v c tv r] -> [RTPropBV b v c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RTPropBV b v c tv r]
rs) ((tv, RTypeBV b v c tv (NoReftB b)) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RTypeBV b v c tv (NoReftB b)
τ) r
r)
    where z' :: (tv, RTypeBV b v c tv (NoReftB b))
z' = (tv
α, RTypeBV b v c tv (NoReftB b)
τ) -- UNIFY: why instantiating INSIDE parameters?
          c' :: c
c' = if tv
α tv -> HashSet tv -> Bool
forall a. Hashable a => a -> HashSet a -> Bool
`S.member` HashSet tv
s then c
c else (tv, RTypeBV b v c tv (NoReftB b)) -> c -> c
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, RTypeBV b v c tv (NoReftB b))
z' c
c
subsFree Bool
meet' HashSet tv
s (tv
α', RTypeBV b v c tv (NoReftB b)
τ, RTypeBV b v c tv r
t') (RVar tv
α r
r)
  | tv
α tv -> tv -> Bool
forall a. Eq a => a -> a -> Bool
== tv
α' Bool -> Bool -> Bool
&& Bool -> Bool
not (tv
α tv -> HashSet tv -> Bool
forall a. Hashable a => a -> HashSet a -> Bool
`S.member` HashSet tv
s)
  = if Bool
meet' then RTypeBV b v c tv r
t' RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
forall r b v c tv.
Meet r =>
RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
`strengthen` (tv, RTypeBV b v c tv (NoReftB b)) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RTypeBV b v c tv (NoReftB b)
τ) r
r else RTypeBV b v c tv r
t'
  | Bool
otherwise
  = tv -> r -> RTypeBV b v c tv r
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
RVar ((tv, RTypeBV b v c tv (NoReftB b)) -> tv -> tv
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α', RTypeBV b v c tv (NoReftB b)
τ) tv
α) r
r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z (RAllE b
x RTypeBV b v c tv r
t RTypeBV b v c tv r
t')
  = b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
forall b v c tv r.
b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllE b
x (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t) (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t')
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z (REx b
x RTypeBV b v c tv r
t RTypeBV b v c tv r
t')
  = b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
forall b v c tv r.
b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
REx b
x (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t) (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t')
subsFree Bool
m HashSet tv
s z :: (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z@(tv
α, RTypeBV b v c tv (NoReftB b)
τ, RTypeBV b v c tv r
_) (RAppTy RTypeBV b v c tv r
t RTypeBV b v c tv r
t' r
r)
  = Bool
-> HashSet tv
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
subsFreeRAppTy Bool
m HashSet tv
s (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t) (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t') ((tv, RTypeBV b v c tv (NoReftB b)) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RTypeBV b v c tv (NoReftB b)
τ) r
r)
subsFree Bool
_ HashSet tv
_ (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
_ t :: RTypeBV b v c tv r
t@(RExprArg Located (ExprBV b v)
_)
  = RTypeBV b v c tv r
t
subsFree Bool
m HashSet tv
s z :: (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z@(tv
α, RTypeBV b v c tv (NoReftB b)
τ, RTypeBV b v c tv r
_) (RRTy [(b, RTypeBV b v c tv r)]
e r
r Oblig
o RTypeBV b v c tv r
t)
  = [(b, RTypeBV b v c tv r)]
-> r -> Oblig -> RTypeBV b v c tv r -> RTypeBV b v c tv r
forall b v c tv r.
[(b, RTypeBV b v c tv r)]
-> r -> Oblig -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RRTy ((RTypeBV b v c tv r -> RTypeBV b v c tv r)
-> (b, RTypeBV b v c tv r) -> (b, RTypeBV b v c tv r)
forall a b. (a -> b) -> (b, a) -> (b, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z) ((b, RTypeBV b v c tv r) -> (b, RTypeBV b v c tv r))
-> [(b, RTypeBV b v c tv r)] -> [(b, RTypeBV b v c tv r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(b, RTypeBV b v c tv r)]
e) ((tv, RTypeBV b v c tv (NoReftB b)) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RTypeBV b v c tv (NoReftB b)
τ) r
r) Oblig
o (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
z RTypeBV b v c tv r
t)
subsFree Bool
_ HashSet tv
_ (tv
α, RTypeBV b v c tv (NoReftB b)
τ, RTypeBV b v c tv r
_) (RHole r
r)
  = r -> RTypeBV b v c tv r
forall b v c tv r. r -> RTypeBV b v c tv r
RHole ((tv, RTypeBV b v c tv (NoReftB b)) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RTypeBV b v c tv (NoReftB b)
τ) r
r)

subsFrees
  :: (Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => Bool
  -> S.HashSet tv
  -> [(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)]
  -> RTypeBV b v c tv r
  -> RTypeBV b v c tv r
subsFrees :: forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> [(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)]
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFrees Bool
m HashSet tv
s [(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)]
zs RTypeBV b v c tv r
t = (RTypeBV b v c tv r
 -> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
 -> RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> [(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)]
-> RTypeBV b v c tv r
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
 -> RTypeBV b v c tv r -> RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s)) RTypeBV b v c tv r
t [(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)]
zs

-- GHC INVARIANT: RApp is Type Application to something other than TYCon
subsFreeRAppTy
  :: (Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
      FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => Bool
  -> S.HashSet tv
  -> RTypeBV b v c tv r
  -> RTypeBV b v c tv r
  -> r
  -> RTypeBV b v c tv r
subsFreeRAppTy :: forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
subsFreeRAppTy Bool
m HashSet tv
s (RApp c
c [RTypeBV b v c tv r]
ts [RTPropBV b v c tv r]
rs r
r) RTypeBV b v c tv r
t' r
r'
  = Bool
-> HashSet tv
-> c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> r
-> RTypeBV b v c tv r
mkRApp Bool
m HashSet tv
s c
c ([RTypeBV b v c tv r]
ts [RTypeBV b v c tv r]
-> [RTypeBV b v c tv r] -> [RTypeBV b v c tv r]
forall a. [a] -> [a] -> [a]
++ [RTypeBV b v c tv r
t']) [RTPropBV b v c tv r]
rs r
r r
r'
subsFreeRAppTy Bool
_ HashSet tv
_ RTypeBV b v c tv r
t RTypeBV b v c tv r
t' r
r'
  = RTypeBV b v c tv r -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
forall b v c tv r.
RTypeBV b v c tv r -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAppTy RTypeBV b v c tv r
t RTypeBV b v c tv r
t' r
r'


-- | @mkRApp@ is the refined variant of GHC's @mkTyConApp@ which ensures that
--    that applications of the "function" type constructor are normalized to
--    the special case @FunTy _@ representation. The extra `_rep1`, and `_rep2`
--    parameters come from the "levity polymorphism" changes in GHC 8.6 (?)
--    See [NOTE:Levity-Polymorphism]

mkRApp :: (Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => Bool
  -> S.HashSet tv
  -> c
  -> [RTypeBV b v c tv r]
  -> [RTPropBV b v c tv r]
  -> r
  -> r
  -> RTypeBV b v c tv r
mkRApp :: forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> r
-> RTypeBV b v c tv r
mkRApp Bool
m HashSet tv
s c
c [RTypeBV b v c tv r]
ts [RTPropBV b v c tv r]
rs r
r r
r'
  | c -> Bool
forall c. TyConable c => c -> Bool
isFun c
c, [RTypeBV b v c tv r
_m, RTypeBV b v c tv r
_rep1, RTypeBV b v c tv r
_rep2, RTypeBV b v c tv r
t1, RTypeBV b v c tv r
t2] <- [RTypeBV b v c tv r]
ts
  = b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
forall b v c tv r.
b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
RFun b
forall b. Binder b => b
wildcard RFInfo
defRFInfo RTypeBV b v c tv r
t1 RTypeBV b v c tv r
t2 (r -> r
forall r. ToReft r => r -> r
refAppTyToFun r
r')
  | Bool
otherwise
  = Bool
-> HashSet tv
-> [(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)]
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> [(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)]
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFrees Bool
m HashSet tv
s [(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)]
zs (c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
forall b v c tv r.
c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
RApp c
c [RTypeBV b v c tv r]
ts [RTPropBV b v c tv r]
rs (r
r r -> r -> r
forall r. Meet r => r -> r -> r
`meet` r
r'))
  where
    zs :: [(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)]
zs = [(tv
tv, RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
forall b v c tv r.
Binder b =>
RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
toRSort RTypeBV b v c tv r
t, RTypeBV b v c tv r
t) | (tv
tv, RTypeBV b v c tv r
t) <- [tv] -> [RTypeBV b v c tv r] -> [(tv, RTypeBV b v c tv r)]
forall a b. [a] -> [b] -> [(a, b)]
zip (c -> [tv]
forall a v. FreeVar a v => a -> [v]
freeVars c
c) [RTypeBV b v c tv r]
ts]

{-| [NOTE:Levity-Polymorphism]

     Thanks to Joachim Brietner and Simon Peyton-Jones!
     With GHC's "levity polymorphism feature", see more here

         https://stackoverflow.com/questions/35318562/what-is-levity-polymorphism

     The function type constructor actually has type

        (->) :: forall (r1::RuntimeRep) (r2::RuntimeRep).  TYPE r1 -> TYPE r2 -> TYPE LiftedRep

     so we have to be careful to follow GHC's @mkTyConApp@

        https://hackage.haskell.org/package/ghc-8.6.4/docs/src/Type.html#mkTyConApp

     which normalizes applications of the `FunTyCon` constructor to use the special
     case `FunTy _` representation thus, so that we are not stuck with incompatible
     representations e.g.

        thing -> thing                                                  ... (using RFun)

     and

        (-> 'GHC.Types.LiftedRep 'GHC.Types.LiftedRep thing thing)      ... (using RApp)


     More details from Joachim Brietner:

     Now you might think that the function arrow has the following kind: `(->) :: * -> * -> *`.
     But that is not the full truth: You can have functions that accept or return things with
     different representations than just the usual lifted one.

     So the function arrow actually has kind `(->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> *`.
     And in `(-> 'GHC.Types.LiftedRep 'GHC.Types.LiftedRep thing thing)`  you see this spelled
     out explicitly. But it really is just `(thing -> thing)`, just printed with more low-level detail.

     Also see

       • https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#levity-polymorphism
       • and other links from https://stackoverflow.com/a/35320729/946226 (edited)
 -}

refAppTyToFun :: ToReft r => r -> r
refAppTyToFun :: forall r. ToReft r => r -> r
refAppTyToFun r
r
  | r -> Bool
forall r. ToReft r => r -> Bool
isTauto r
r = r
r
  | Bool
otherwise = Maybe SrcSpan -> [Char] -> r
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType.refAppTyToFun"

subsFreeRef
  :: (Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) c, SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)), FreeVar c tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
      SubsTy tv (RTypeBV b v c tv (NoReftB b)) (RTVar tv (RTypeBV b v c tv (NoReftB b))))
  => Bool
  -> S.HashSet tv
  -> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
  -> RTPropBV b v c tv r
  -> RTPropBV b v c tv r
subsFreeRef :: forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTPropBV b v c tv r
-> RTPropBV b v c tv r
subsFreeRef Bool
_ HashSet tv
_ (tv
α', RTypeBV b v c tv (NoReftB b)
τ', RTypeBV b v c tv r
_) (RProp [(b, RTypeBV b v c tv (NoReftB b))]
ss (RHole r
r))
  = [(b, RTypeBV b v c tv (NoReftB b))]
-> RTypeBV b v c tv r
-> RefB b (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv r)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp ((RTypeBV b v c tv (NoReftB b) -> RTypeBV b v c tv (NoReftB b))
-> (b, RTypeBV b v c tv (NoReftB b))
-> (b, RTypeBV b v c tv (NoReftB b))
forall a b. (a -> b) -> (b, a) -> (b, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((tv, RTypeBV b v c tv (NoReftB b))
-> RTypeBV b v c tv (NoReftB b) -> RTypeBV b v c tv (NoReftB b)
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α', RTypeBV b v c tv (NoReftB b)
τ')) ((b, RTypeBV b v c tv (NoReftB b))
 -> (b, RTypeBV b v c tv (NoReftB b)))
-> [(b, RTypeBV b v c tv (NoReftB b))]
-> [(b, RTypeBV b v c tv (NoReftB b))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(b, RTypeBV b v c tv (NoReftB b))]
ss) (r -> RTypeBV b v c tv r
forall b v c tv r. r -> RTypeBV b v c tv r
RHole r
r)
subsFreeRef Bool
m HashSet tv
s (tv
α', RTypeBV b v c tv (NoReftB b)
τ', RTypeBV b v c tv r
t')  (RProp [(b, RTypeBV b v c tv (NoReftB b))]
ss RTypeBV b v c tv r
t)
  = [(b, RTypeBV b v c tv (NoReftB b))]
-> RTypeBV b v c tv r
-> RefB b (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv r)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp ((RTypeBV b v c tv (NoReftB b) -> RTypeBV b v c tv (NoReftB b))
-> (b, RTypeBV b v c tv (NoReftB b))
-> (b, RTypeBV b v c tv (NoReftB b))
forall a b. (a -> b) -> (b, a) -> (b, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((tv, RTypeBV b v c tv (NoReftB b))
-> RTypeBV b v c tv (NoReftB b) -> RTypeBV b v c tv (NoReftB b)
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α', RTypeBV b v c tv (NoReftB b)
τ')) ((b, RTypeBV b v c tv (NoReftB b))
 -> (b, RTypeBV b v c tv (NoReftB b)))
-> [(b, RTypeBV b v c tv (NoReftB b))]
-> [(b, RTypeBV b v c tv (NoReftB b))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(b, RTypeBV b v c tv (NoReftB b))]
ss) (RTypeBV b v c tv r
 -> RefB b (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv r))
-> RTypeBV b v c tv r
-> RefB b (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv r)
forall a b. (a -> b) -> a -> b
$ Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
Bool
-> HashSet tv
-> (tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
subsFree Bool
m HashSet tv
s (tv
α', RTypeBV b v c tv (NoReftB b)
τ', (r -> r) -> RTypeBV b v c tv r -> RTypeBV b v c tv r
forall a b. (a -> b) -> RTypeBV b v c tv a -> RTypeBV b v c tv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> r
forall r. Top r => r -> r
top RTypeBV b v c tv r
t') RTypeBV b v c tv r
t


--------------------------------------------------------------------------------
-- | Type Substitutions --------------------------------------------------------
--------------------------------------------------------------------------------

subts :: (SubsTy tv ty c) => [(tv, ty)] -> c -> c
subts :: forall tv ty c. SubsTy tv ty c => [(tv, ty)] -> c -> c
subts = (c -> [(tv, ty)] -> c) -> [(tv, ty)] -> c -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((tv, ty) -> c -> c) -> c -> [(tv, ty)] -> c
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (tv, ty) -> c -> c
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt)

instance SubsTy RTyVar (RType RTyCon RTyVar NoReft) RTyVar where
  subt :: (RTyVar, RType RTyCon RTyVar NoReft) -> RTyVar -> RTyVar
subt (RTV Var
x, RType RTyCon RTyVar NoReft
t) (RTV Var
z) | Var -> Bool
isTyVar Var
z, Var -> Type
tyVarKind Var
z Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Var -> Type
TyVarTy Var
x
    = Var -> RTyVar
RTV (Var -> Type -> Var
setVarType Var
z (Type -> Var) -> Type -> Var
forall a b. (a -> b) -> a -> b
$ Bool -> RType RTyCon RTyVar NoReft -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
False RType RTyCon RTyVar NoReft
t)
  subt (RTyVar, RType RTyCon RTyVar NoReft)
_ RTyVar
v
    = RTyVar
v

instance SubsTy RTyVar (RType RTyCon RTyVar NoReft) (RTVar RTyVar (RType RTyCon RTyVar NoReft)) where
  -- NV TODO: update kind
  subt :: (RTyVar, RType RTyCon RTyVar NoReft)
-> RTVar RTyVar (RType RTyCon RTyVar NoReft)
-> RTVar RTyVar (RType RTyCon RTyVar NoReft)
subt (RTyVar, RType RTyCon RTyVar NoReft)
su RTVar RTyVar (RType RTyCon RTyVar NoReft)
rty = RTVar RTyVar (RType RTyCon RTyVar NoReft)
rty { ty_var_value = subt su $ ty_var_value rty }


instance SubsTy BTyVar (RType c BTyVar NoReft) BTyVar where
  subt :: (BTyVar, RType c BTyVar NoReft) -> BTyVar -> BTyVar
subt (BTyVar, RType c BTyVar NoReft)
_ = BTyVar -> BTyVar
forall a. a -> a
id

instance SubsTy BTyVar (RType c BTyVar NoReft) (RTVar BTyVar (RType c BTyVar NoReft)) where
  subt :: (BTyVar, RType c BTyVar NoReft)
-> RTVar BTyVar (RType c BTyVar NoReft)
-> RTVar BTyVar (RType c BTyVar NoReft)
subt (BTyVar, RType c BTyVar NoReft)
_ = RTVar BTyVar (RType c BTyVar NoReft)
-> RTVar BTyVar (RType c BTyVar NoReft)
forall a. a -> a
id

instance SubsTy tv ty NoReft   where
  subt :: (tv, ty) -> NoReft -> NoReft
subt (tv, ty)
_ = NoReft -> NoReft
forall a. a -> a
id

instance SubsTy tv ty Symbol where
  subt :: (tv, ty) -> Symbol -> Symbol
subt (tv, ty)
_ = Symbol -> Symbol
forall a. a -> a
id



instance (SubsTy tv ty Expr) => SubsTy tv ty Reft where
  subt :: (tv, ty) -> ReftBV Symbol Symbol -> ReftBV Symbol Symbol
subt (tv, ty)
su (Reft (Symbol
x, Expr
e)) = (Symbol, Expr) -> ReftBV Symbol Symbol
forall b v. (b, ExprBV b v) -> ReftBV b v
Reft (Symbol
x, (tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e)

instance SubsTy Symbol Symbol (BRType r) where
  subt :: (Symbol, Symbol) -> BRType r -> BRType r
subt (Symbol
x,Symbol
y) (RVar (BTV Located Symbol
v) r
r)
    | Symbol
x Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Located Symbol -> Symbol
forall a. Located a -> a
val Located Symbol
v = BTyVar -> r -> BRType r
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
RVar (Located Symbol -> BTyVar
BTV (Symbol
y Symbol -> Located Symbol -> Located Symbol
forall a b. a -> Located b -> Located a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Located Symbol
v)) r
r
    | Bool
otherwise  = BTyVar -> r -> BRType r
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
RVar (Located Symbol -> BTyVar
BTV Located Symbol
v) r
r
  subt (Symbol
x, Symbol
y) (RAllT (RTVar (BTV Located Symbol
v) RTVInfo (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
i) BRType r
t r
r)
    | Symbol
x Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Located Symbol -> Symbol
forall a. Located a -> a
val Located Symbol
v = RTVar BTyVar (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
-> BRType r -> r -> BRType r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT (BTyVar
-> RTVInfo (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
-> RTVar BTyVar (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar (Located Symbol -> BTyVar
BTV Located Symbol
v) RTVInfo (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
i) BRType r
t r
r
    | Bool
otherwise  = RTVar BTyVar (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
-> BRType r -> r -> BRType r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT (BTyVar
-> RTVInfo (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
-> RTVar BTyVar (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar (Located Symbol -> BTyVar
BTV Located Symbol
v) RTVInfo (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
i) ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol
x,Symbol
y) BRType r
t) r
r
  subt (Symbol, Symbol)
su (RFun Symbol
x RFInfo
i BRType r
t1 BRType r
t2 r
r)  = Symbol -> RFInfo -> BRType r -> BRType r -> r -> BRType r
forall b v c tv r.
b
-> RFInfo
-> RTypeBV b v c tv r
-> RTypeBV b v c tv r
-> r
-> RTypeBV b v c tv r
RFun Symbol
x RFInfo
i ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t1) ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t2) r
r
  subt (Symbol, Symbol)
su (RAllP PVUBV Symbol Symbol BTyCon BTyVar
p BRType r
t)       = PVUBV Symbol Symbol BTyCon BTyVar -> BRType r -> BRType r
forall b v c tv r.
PVUBV b v c tv -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllP PVUBV Symbol Symbol BTyCon BTyVar
p ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t)
  subt (Symbol, Symbol)
su (RApp BTyCon
c [BRType r]
ts [RefB
   Symbol (RTypeBV Symbol Symbol BTyCon BTyVar NoReft) (BRType r)]
ps r
r)  = BTyCon
-> [BRType r]
-> [RefB
      Symbol (RTypeBV Symbol Symbol BTyCon BTyVar NoReft) (BRType r)]
-> r
-> BRType r
forall b v c tv r.
c
-> [RTypeBV b v c tv r]
-> [RTPropBV b v c tv r]
-> r
-> RTypeBV b v c tv r
RApp BTyCon
c ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su (BRType r -> BRType r) -> [BRType r] -> [BRType r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BRType r]
ts) ((Symbol, Symbol)
-> RefB
     Symbol (RTypeBV Symbol Symbol BTyCon BTyVar NoReft) (BRType r)
-> RefB
     Symbol (RTypeBV Symbol Symbol BTyCon BTyVar NoReft) (BRType r)
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su (RefB
   Symbol (RTypeBV Symbol Symbol BTyCon BTyVar NoReft) (BRType r)
 -> RefB
      Symbol (RTypeBV Symbol Symbol BTyCon BTyVar NoReft) (BRType r))
-> [RefB
      Symbol (RTypeBV Symbol Symbol BTyCon BTyVar NoReft) (BRType r)]
-> [RefB
      Symbol (RTypeBV Symbol Symbol BTyCon BTyVar NoReft) (BRType r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RefB
   Symbol (RTypeBV Symbol Symbol BTyCon BTyVar NoReft) (BRType r)]
ps) r
r
  subt (Symbol, Symbol)
su (RAllE Symbol
x BRType r
t1 BRType r
t2)   = Symbol -> BRType r -> BRType r -> BRType r
forall b v c tv r.
b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RAllE Symbol
x ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t1) ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t2)
  subt (Symbol, Symbol)
su (REx Symbol
x BRType r
t1 BRType r
t2)     = Symbol -> BRType r -> BRType r -> BRType r
forall b v c tv r.
b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
REx Symbol
x ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t1) ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t2)
  subt (Symbol, Symbol)
_  (RExprArg Located Expr
e)      = Located Expr -> BRType r
forall b v c tv r. Located (ExprBV b v) -> RTypeBV b v c tv r
RExprArg Located Expr
e
  subt (Symbol, Symbol)
su (RAppTy BRType r
t1 BRType r
t2 r
r)  = BRType r -> BRType r -> r -> BRType r
forall b v c tv r.
RTypeBV b v c tv r -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAppTy ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t1) ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t2) r
r
  subt (Symbol, Symbol)
su (RRTy [(Symbol, BRType r)]
e r
r Oblig
o BRType r
t)    = [(Symbol, BRType r)] -> r -> Oblig -> BRType r -> BRType r
forall b v c tv r.
[(b, RTypeBV b v c tv r)]
-> r -> Oblig -> RTypeBV b v c tv r -> RTypeBV b v c tv r
RRTy [(Symbol
x, (Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
p) | (Symbol
x,BRType r
p) <- [(Symbol, BRType r)]
e] r
r Oblig
o ((Symbol, Symbol) -> BRType r -> BRType r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su BRType r
t)
  subt (Symbol, Symbol)
_ (RHole r
r)          = r -> BRType r
forall b v c tv r. r -> RTypeBV b v c tv r
RHole r
r

instance SubsTy Symbol Symbol (RTProp BTyCon BTyVar r) where
  subt :: (Symbol, Symbol)
-> RTProp BTyCon BTyVar r -> RTProp BTyCon BTyVar r
subt (Symbol, Symbol)
su (RProp [(Symbol, RTypeBV Symbol Symbol BTyCon BTyVar NoReft)]
e RTypeBV Symbol Symbol BTyCon BTyVar r
t) =  [(Symbol, RTypeBV Symbol Symbol BTyCon BTyVar NoReft)]
-> RTypeBV Symbol Symbol BTyCon BTyVar r -> RTProp BTyCon BTyVar r
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp [(Symbol
x, (Symbol, Symbol)
-> RTypeBV Symbol Symbol BTyCon BTyVar NoReft
-> RTypeBV Symbol Symbol BTyCon BTyVar NoReft
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su RTypeBV Symbol Symbol BTyCon BTyVar NoReft
xt) | (Symbol
x,RTypeBV Symbol Symbol BTyCon BTyVar NoReft
xt) <- [(Symbol, RTypeBV Symbol Symbol BTyCon BTyVar NoReft)]
e] ((Symbol, Symbol)
-> RTypeBV Symbol Symbol BTyCon BTyVar r
-> RTypeBV Symbol Symbol BTyCon BTyVar r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su RTypeBV Symbol Symbol BTyCon BTyVar r
t)



instance (SubsTy tv ty Sort) => SubsTy tv ty Expr where
  subt :: (tv, ty) -> Expr -> Expr
subt (tv, ty)
su (ELam (Symbol
x, Sort
s) Expr
e) = (Symbol, Sort) -> Expr -> Expr
forall b v. (b, Sort) -> ExprBV b v -> ExprBV b v
ELam (Symbol
x, (tv, ty) -> Sort -> Sort
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Sort
s) (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ (tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e
  subt (tv, ty)
su (EApp Expr
e1 Expr
e2)    = Expr -> Expr -> Expr
forall b v. ExprBV b v -> ExprBV b v -> ExprBV b v
EApp ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e1) ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e2)
  subt (tv, ty)
su (ENeg Expr
e)        = Expr -> Expr
forall b v. ExprBV b v -> ExprBV b v
ENeg ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e)
  subt (tv, ty)
su (PNot Expr
e)        = Expr -> Expr
forall b v. ExprBV b v -> ExprBV b v
PNot ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e)
  subt (tv, ty)
su (EBin Bop
b Expr
e1 Expr
e2)  = Bop -> Expr -> Expr -> Expr
forall b v. Bop -> ExprBV b v -> ExprBV b v -> ExprBV b v
EBin Bop
b ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e1) ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e2)
  subt (tv, ty)
su (EIte Expr
e Expr
e1 Expr
e2)  = Expr -> Expr -> Expr -> Expr
forall b v. ExprBV b v -> ExprBV b v -> ExprBV b v -> ExprBV b v
EIte ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e) ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e1) ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e2)
  subt (tv, ty)
su (ECst Expr
e Sort
s)      = Expr -> Sort -> Expr
forall b v. ExprBV b v -> Sort -> ExprBV b v
ECst ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e) ((tv, ty) -> Sort -> Sort
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Sort
s)
  subt (tv, ty)
su (ETApp Expr
e Sort
s)     = Expr -> Sort -> Expr
forall b v. ExprBV b v -> Sort -> ExprBV b v
ETApp ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e) ((tv, ty) -> Sort -> Sort
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Sort
s)
  subt (tv, ty)
su (ETAbs Expr
e Symbol
x)     = Expr -> Symbol -> Expr
forall b v. ExprBV b v -> b -> ExprBV b v
ETAbs ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e) Symbol
x
  subt (tv, ty)
su (PAnd [Expr]
es)       = [Expr] -> Expr
forall b v. [ExprBV b v] -> ExprBV b v
PAnd ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su (Expr -> Expr) -> [Expr] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr]
es)
  subt (tv, ty)
su (POr  [Expr]
es)       = [Expr] -> Expr
forall b v. [ExprBV b v] -> ExprBV b v
POr  ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su (Expr -> Expr) -> [Expr] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr]
es)
  subt (tv, ty)
su (PImp Expr
e1 Expr
e2)    = Expr -> Expr -> Expr
forall b v. ExprBV b v -> ExprBV b v -> ExprBV b v
PImp ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e1) ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e2)
  subt (tv, ty)
su (PIff Expr
e1 Expr
e2)    = Expr -> Expr -> Expr
forall b v. ExprBV b v -> ExprBV b v -> ExprBV b v
PIff ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e1) ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e2)
  subt (tv, ty)
su (PAtom Brel
b Expr
e1 Expr
e2) = Brel -> Expr -> Expr -> Expr
forall b v. Brel -> ExprBV b v -> ExprBV b v -> ExprBV b v
PAtom Brel
b ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e1) ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e2)
  subt (tv, ty)
su (PAll [(Symbol, Sort)]
xes Expr
e)    = [(Symbol, Sort)] -> Expr -> Expr
forall b v. [(b, Sort)] -> ExprBV b v -> ExprBV b v
PAll ((tv, ty) -> (Symbol, Sort) -> (Symbol, Sort)
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su ((Symbol, Sort) -> (Symbol, Sort))
-> [(Symbol, Sort)] -> [(Symbol, Sort)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, Sort)]
xes) ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e)
  subt (tv, ty)
su (PExist [(Symbol, Sort)]
xes Expr
e)  = [(Symbol, Sort)] -> Expr -> Expr
forall b v. [(b, Sort)] -> ExprBV b v -> ExprBV b v
PExist ((tv, ty) -> (Symbol, Sort) -> (Symbol, Sort)
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su ((Symbol, Sort) -> (Symbol, Sort))
-> [(Symbol, Sort)] -> [(Symbol, Sort)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, Sort)]
xes) ((tv, ty) -> Expr -> Expr
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su Expr
e)
  subt (tv, ty)
_ Expr
e                = Expr
e

instance (SubsTy tv ty a, SubsTy tv ty b) => SubsTy tv ty (a, b) where
  subt :: (tv, ty) -> (a, b) -> (a, b)
subt (tv, ty)
su (a
x, b
y) = ((tv, ty) -> a -> a
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su a
x, (tv, ty) -> b -> b
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su b
y)

instance SubsTy BTyVar (RType BTyCon BTyVar NoReft) Sort where
  subt :: (BTyVar, RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
-> Sort -> Sort
subt (BTyVar
v, RVar BTyVar
α NoReft
_) (FObj Symbol
s)
    | BTyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol BTyVar
v Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
s = Symbol -> Sort
FObj (Symbol -> Sort) -> Symbol -> Sort
forall a b. (a -> b) -> a -> b
$ BTyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol BTyVar
α
    | Bool
otherwise     = Symbol -> Sort
FObj Symbol
s
  subt (BTyVar, RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
_ Sort
s          = Sort
s


instance SubsTy Symbol RSort Sort where
  subt :: (Symbol, RType RTyCon RTyVar NoReft) -> Sort -> Sort
subt (Symbol
v, RVar RTyVar
α NoReft
_) (FObj Symbol
s)
    | Symbol -> Symbol
forall a. Symbolic a => a -> Symbol
symbol Symbol
v Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
s = Symbol -> Sort
FObj (Symbol -> Sort) -> Symbol -> Sort
forall a b. (a -> b) -> a -> b
$ RTyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol {- rTyVarSymbol -} RTyVar
α
    | Bool
otherwise     = Symbol -> Sort
FObj Symbol
s
  subt (Symbol, RType RTyCon RTyVar NoReft)
_ Sort
s          = Sort
s


instance SubsTy RTyVar RSort Sort where
  subt :: (RTyVar, RType RTyCon RTyVar NoReft) -> Sort -> Sort
subt (RTyVar
v, RType RTyCon RTyVar NoReft
sv) (FObj Symbol
s)
    | RTyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol RTyVar
v Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
s = TCEmb TyCon -> Type -> Sort
typeSort TCEmb TyCon
forall a. Monoid a => a
mempty (Bool -> RType RTyCon RTyVar NoReft -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
True RType RTyCon RTyVar NoReft
sv)
    | Bool
otherwise     = Symbol -> Sort
FObj Symbol
s
  subt (RTyVar, RType RTyCon RTyVar NoReft)
_ Sort
s          = Sort
s

instance (SubsTy tv ty ty) => SubsTy tv ty (PVarBV b v ty) where
  subt :: (tv, ty) -> PVarBV b v ty -> PVarBV b v ty
subt (tv, ty)
su (PV b
n ty
pvk b
v [(ty, b, ExprBV b v)]
xts) = b -> ty -> b -> [(ty, b, ExprBV b v)] -> PVarBV b v ty
forall b v t. b -> t -> b -> [(t, b, ExprBV b v)] -> PVarBV b v t
PV b
n ((tv, ty) -> ty -> ty
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su ty
pvk) b
v [((tv, ty) -> ty -> ty
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su ty
t, b
x, ExprBV b v
y) | (ty
t,b
x,ExprBV b v
y) <- [(ty, b, ExprBV b v)]
xts]

instance SubsTy RTyVar RSort RTyCon where
   subt :: (RTyVar, RType RTyCon RTyVar NoReft) -> RTyCon -> RTyCon
subt (RTyVar, RType RTyCon RTyVar NoReft)
z RTyCon
c = TyCon -> [RPVar] -> TyConInfo -> RTyCon
RTyCon TyCon
tc [RPVar]
ps' TyConInfo
i
     where
       tc :: TyCon
tc   = RTyCon -> TyCon
rtc_tc RTyCon
c
       ps' :: [RPVar]
ps'  = (RTyVar, RType RTyCon RTyVar NoReft) -> RPVar -> RPVar
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (RTyVar, RType RTyCon RTyVar NoReft)
z (RPVar -> RPVar) -> [RPVar] -> [RPVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RTyCon -> [RPVar]
rTyConPVs RTyCon
c
       i :: TyConInfo
i    = RTyCon -> TyConInfo
rtc_info RTyCon
c

instance SubsTy RTyVar RSort SpecType where
  subt :: (RTyVar, RType RTyCon RTyVar NoReft) -> SpecType -> SpecType
subt (RTyVar
α, RType RTyCon RTyVar NoReft
τ) = (RTyVar, RType RTyCon RTyVar NoReft, SpecType)
-> SpecType -> SpecType
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet (RTyVar
α, RType RTyCon RTyVar NoReft
τ, RType RTyCon RTyVar NoReft -> SpecType
forall r b v c tv.
IsReft r =>
RTypeBV b v c tv (NoReftB b) -> RTypeBV b v c tv r
ofRSort RType RTyCon RTyVar NoReft
τ)

instance SubsTy TyVar Type SpecType where
  subt :: (Var, Type) -> SpecType -> SpecType
subt (Var
α, Type
τ) = (RTyVar, RType RTyCon RTyVar NoReft, SpecType)
-> SpecType -> SpecType
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet (Var -> RTyVar
RTV Var
α, Type -> RType RTyCon RTyVar NoReft
forall r. IsReft r => Type -> RRType r
ofType Type
τ, Type -> SpecType
forall r. IsReft r => Type -> RRType r
ofType Type
τ)

instance SubsTy RTyVar RTyVar SpecType where
  subt :: (RTyVar, RTyVar) -> SpecType -> SpecType
subt (RTyVar
α, RTyVar
a) = (RTyVar, RType RTyCon RTyVar NoReft) -> SpecType -> SpecType
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (RTyVar
α, RTyVar -> NoReft -> RType RTyCon RTyVar NoReft
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
RVar RTyVar
a NoReft
forall b. NoReftB b
NoReft :: RSort)


instance SubsTy RTyVar RSort RSort where
  subt :: (RTyVar, RType RTyCon RTyVar NoReft)
-> RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft
subt (RTyVar
α, RType RTyCon RTyVar NoReft
τ) = (RTyVar, RType RTyCon RTyVar NoReft, RType RTyCon RTyVar NoReft)
-> RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet (RTyVar
α, RType RTyCon RTyVar NoReft
τ, RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft
forall r b v c tv.
IsReft r =>
RTypeBV b v c tv (NoReftB b) -> RTypeBV b v c tv r
ofRSort RType RTyCon RTyVar NoReft
τ)

instance SubsTy tv RSort Predicate where
  subt :: (tv, RType RTyCon RTyVar NoReft)
-> PredicateBV Symbol Symbol -> PredicateBV Symbol Symbol
subt (tv, RType RTyCon RTyVar NoReft)
_ = PredicateBV Symbol Symbol -> PredicateBV Symbol Symbol
forall a. a -> a
id -- NV TODO

instance (SubsTy tv ty r) => SubsTy tv ty (UReft r) where
  subt :: (tv, ty) -> UReft r -> UReft r
subt (tv, ty)
su UReft r
r = UReft r
r {ur_reft = subt su $ ur_reft r}

-- Here the "String" is a Bare-TyCon. TODO: wrap in newtype
instance SubsTy BTyVar BSort BTyCon where
  subt :: (BTyVar, RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
-> BTyCon -> BTyCon
subt (BTyVar, RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
_ BTyCon
t = BTyCon
t

instance SubsTy BTyVar BSort BSort where
  subt :: (BTyVar, RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
-> RTypeBV Symbol Symbol BTyCon BTyVar NoReft
-> RTypeBV Symbol Symbol BTyCon BTyVar NoReft
subt (BTyVar
α, RTypeBV Symbol Symbol BTyCon BTyVar NoReft
τ) = (BTyVar, RTypeBV Symbol Symbol BTyCon BTyVar NoReft,
 RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
-> RTypeBV Symbol Symbol BTyCon BTyVar NoReft
-> RTypeBV Symbol Symbol BTyCon BTyVar NoReft
forall tv r c b v.
(Eq tv, Hashable tv, IsReft r, TyConable c, Binder b,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) c,
 SubsTy tv (RTypeBV b v c tv (NoReftB b)) r,
 SubsTy
   tv (RTypeBV b v c tv (NoReftB b)) (RTypeBV b v c tv (NoReftB b)),
 FreeVar c tv, SubsTy tv (RTypeBV b v c tv (NoReftB b)) tv,
 SubsTy
   tv
   (RTypeBV b v c tv (NoReftB b))
   (RTVar tv (RTypeBV b v c tv (NoReftB b)))) =>
(tv, RTypeBV b v c tv (NoReftB b), RTypeBV b v c tv r)
-> RTypeBV b v c tv r -> RTypeBV b v c tv r
subsTyVarMeet (BTyVar
α, RTypeBV Symbol Symbol BTyCon BTyVar NoReft
τ, RTypeBV Symbol Symbol BTyCon BTyVar NoReft
-> RTypeBV Symbol Symbol BTyCon BTyVar NoReft
forall r b v c tv.
IsReft r =>
RTypeBV b v c tv (NoReftB b) -> RTypeBV b v c tv r
ofRSort RTypeBV Symbol Symbol BTyCon BTyVar NoReft
τ)

instance (SubsTy tv ty (UReft r), SubsTy tv ty (RType c tv NoReft)) => SubsTy tv ty (RTProp c tv (UReft r))  where
  subt :: (tv, ty) -> RTProp c tv (UReft r) -> RTProp c tv (UReft r)
subt (tv, ty)
m (RProp [(Symbol, RType c tv NoReft)]
ss (RHole UReft r
p)) = [(Symbol, RType c tv NoReft)]
-> RTypeBV Symbol Symbol c tv (UReft r) -> RTProp c tv (UReft r)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp ((RType c tv NoReft -> RType c tv NoReft)
-> (Symbol, RType c tv NoReft) -> (Symbol, RType c tv NoReft)
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((tv, ty) -> RType c tv NoReft -> RType c tv NoReft
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
m) ((Symbol, RType c tv NoReft) -> (Symbol, RType c tv NoReft))
-> [(Symbol, RType c tv NoReft)] -> [(Symbol, RType c tv NoReft)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv NoReft)]
ss) (RTypeBV Symbol Symbol c tv (UReft r) -> RTProp c tv (UReft r))
-> RTypeBV Symbol Symbol c tv (UReft r) -> RTProp c tv (UReft r)
forall a b. (a -> b) -> a -> b
$ UReft r -> RTypeBV Symbol Symbol c tv (UReft r)
forall b v c tv r. r -> RTypeBV b v c tv r
RHole (UReft r -> RTypeBV Symbol Symbol c tv (UReft r))
-> UReft r -> RTypeBV Symbol Symbol c tv (UReft r)
forall a b. (a -> b) -> a -> b
$ (tv, ty) -> UReft r -> UReft r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
m UReft r
p
  subt (tv, ty)
m (RProp [(Symbol, RType c tv NoReft)]
ss RTypeBV Symbol Symbol c tv (UReft r)
t) = [(Symbol, RType c tv NoReft)]
-> RTypeBV Symbol Symbol c tv (UReft r) -> RTProp c tv (UReft r)
forall b τ t. [(b, τ)] -> t -> RefB b τ t
RProp ((RType c tv NoReft -> RType c tv NoReft)
-> (Symbol, RType c tv NoReft) -> (Symbol, RType c tv NoReft)
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((tv, ty) -> RType c tv NoReft -> RType c tv NoReft
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
m) ((Symbol, RType c tv NoReft) -> (Symbol, RType c tv NoReft))
-> [(Symbol, RType c tv NoReft)] -> [(Symbol, RType c tv NoReft)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv NoReft)]
ss) (RTypeBV Symbol Symbol c tv (UReft r) -> RTProp c tv (UReft r))
-> RTypeBV Symbol Symbol c tv (UReft r) -> RTProp c tv (UReft r)
forall a b. (a -> b) -> a -> b
$ (UReft r -> UReft r)
-> RTypeBV Symbol Symbol c tv (UReft r)
-> RTypeBV Symbol Symbol c tv (UReft r)
forall a b.
(a -> b)
-> RTypeBV Symbol Symbol c tv a -> RTypeBV Symbol Symbol c tv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((tv, ty) -> UReft r -> UReft r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
m) RTypeBV Symbol Symbol c tv (UReft r)
t

subvUReft     :: (UsedPVar -> UsedPVar) -> UReft Reft -> UReft Reft
subvUReft :: (UsedPVar -> UsedPVar) -> RReft -> RReft
subvUReft UsedPVar -> UsedPVar
f (MkUReft ReftBV Symbol Symbol
r PredicateBV Symbol Symbol
p) = ReftBV Symbol Symbol -> PredicateBV Symbol Symbol -> RReft
forall b v r. r -> PredicateBV b v -> UReftBV b v r
MkUReft ReftBV Symbol Symbol
r ((UsedPVar -> UsedPVar)
-> PredicateBV Symbol Symbol -> PredicateBV Symbol Symbol
subvPredicate UsedPVar -> UsedPVar
f PredicateBV Symbol Symbol
p)

subvPredicate :: (UsedPVar -> UsedPVar) -> Predicate -> Predicate
subvPredicate :: (UsedPVar -> UsedPVar)
-> PredicateBV Symbol Symbol -> PredicateBV Symbol Symbol
subvPredicate UsedPVar -> UsedPVar
f (Pr [UsedPVar]
pvs) = [UsedPVar] -> PredicateBV Symbol Symbol
forall b v. [UsedPVarBV b v] -> PredicateBV b v
Pr (UsedPVar -> UsedPVar
f (UsedPVar -> UsedPVar) -> [UsedPVar] -> [UsedPVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UsedPVar]
pvs)

--------------------------------------------------------------------------------
ofType :: IsReft r => Type -> RRType r
--------------------------------------------------------------------------------
ofType :: forall r. IsReft r => Type -> RRType r
ofType      = TyConv RTyCon RTyVar r -> Type -> RType RTyCon RTyVar r
forall r c tv. IsReft r => TyConv c tv r -> Type -> RType c tv r
ofType_ (TyConv RTyCon RTyVar r -> Type -> RType RTyCon RTyVar r)
-> TyConv RTyCon RTyVar r -> Type -> RType RTyCon RTyVar r
forall a b. (a -> b) -> a -> b
$ TyConv
  { tcFVar :: Var -> RType RTyCon RTyVar r
tcFVar  = Var -> RType RTyCon RTyVar r
forall r c. IsReft r => Var -> RType c RTyVar r
rVar
  , tcFTVar :: Var -> RTVar RTyVar (RType RTyCon RTyVar NoReft)
tcFTVar = Var -> RTVar RTyVar (RType RTyCon RTyVar NoReft)
forall r. IsReft r => Var -> RTVar RTyVar (RRType r)
rTVar
  , tcFApp :: TyCon -> [RType RTyCon RTyVar r] -> RType RTyCon RTyVar r
tcFApp  = \TyCon
c [RType RTyCon RTyVar r]
ts -> TyCon
-> [RType RTyCon RTyVar r]
-> [RTProp RTyCon RTyVar r]
-> r
-> RType RTyCon RTyVar r
forall tv r.
TyCon
-> [RType RTyCon tv r]
-> [RTProp RTyCon tv r]
-> r
-> RType RTyCon tv r
rApp TyCon
c [RType RTyCon RTyVar r]
ts [] r
forall r. IsReft r => r
trueReft
  , tcFLit :: TyLit -> RType RTyCon RTyVar r
tcFLit  = (TyCon
 -> [RType RTyCon RTyVar r]
 -> [RTProp RTyCon RTyVar r]
 -> r
 -> RType RTyCon RTyVar r)
-> TyLit -> RType RTyCon RTyVar r
forall r c tv p.
IsReft r =>
(TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r)
-> TyLit -> RType c tv r
ofLitType TyCon
-> [RType RTyCon RTyVar r]
-> [RTProp RTyCon RTyVar r]
-> r
-> RType RTyCon RTyVar r
forall tv r.
TyCon
-> [RType RTyCon tv r]
-> [RTProp RTyCon tv r]
-> r
-> RType RTyCon tv r
rApp
  }

--------------------------------------------------------------------------------
bareOfType :: IsReft r => Type -> BRType r
--------------------------------------------------------------------------------
bareOfType :: forall r. IsReft r => Type -> BRType r
bareOfType  = TyConv BTyCon BTyVar r -> Type -> RType BTyCon BTyVar r
forall r c tv. IsReft r => TyConv c tv r -> Type -> RType c tv r
ofType_ (TyConv BTyCon BTyVar r -> Type -> RType BTyCon BTyVar r)
-> TyConv BTyCon BTyVar r -> Type -> RType BTyCon BTyVar r
forall a b. (a -> b) -> a -> b
$ TyConv
  { tcFVar :: Var -> RType BTyCon BTyVar r
tcFVar  = (BTyVar -> r -> RType BTyCon BTyVar r
forall b v c tv r. tv -> r -> RTypeBV b v c tv r
`RVar` r
forall r. IsReft r => r
trueReft) (BTyVar -> RType BTyCon BTyVar r)
-> (Var -> BTyVar) -> Var -> RType BTyCon BTyVar r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Symbol -> BTyVar
BTV (Located Symbol -> BTyVar)
-> (Var -> Located Symbol) -> Var -> BTyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var -> Symbol) -> Located Var -> Located Symbol
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Located Var -> Located Symbol)
-> (Var -> Located Var) -> Var -> Located Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Located Var
forall a. NamedThing a => a -> Located a
GM.locNamedThing
  , tcFTVar :: Var -> RTVar BTyVar (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
tcFTVar = Var -> RTVar BTyVar (RTypeBV Symbol Symbol BTyCon BTyVar NoReft)
forall r. IsReft r => Var -> RTVar BTyVar (BRType r)
bTVar
  , tcFApp :: TyCon -> [RType BTyCon BTyVar r] -> RType BTyCon BTyVar r
tcFApp  = \TyCon
c [RType BTyCon BTyVar r]
ts -> TyCon
-> [RType BTyCon BTyVar r]
-> [BRProp r]
-> r
-> RType BTyCon BTyVar r
forall r. TyCon -> [BRType r] -> [BRProp r] -> r -> BRType r
bApp TyCon
c [RType BTyCon BTyVar r]
ts [] r
forall r. IsReft r => r
trueReft
  , tcFLit :: TyLit -> RType BTyCon BTyVar r
tcFLit  = (TyCon
 -> [RType BTyCon BTyVar r]
 -> [BRProp r]
 -> r
 -> RType BTyCon BTyVar r)
-> TyLit -> RType BTyCon BTyVar r
forall r c tv p.
IsReft r =>
(TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r)
-> TyLit -> RType c tv r
ofLitType TyCon
-> [RType BTyCon BTyVar r]
-> [BRProp r]
-> r
-> RType BTyCon BTyVar r
forall r. TyCon -> [BRType r] -> [BRProp r] -> r -> BRType r
bApp
  }

--------------------------------------------------------------------------------
ofType_ :: IsReft r => TyConv c tv r -> Type -> RType c tv r
--------------------------------------------------------------------------------
ofType_ :: forall r c tv. IsReft r => TyConv c tv r -> Type -> RType c tv r
ofType_ TyConv c tv r
tx = Type -> RTypeBV Symbol Symbol c tv r
go (Type -> RTypeBV Symbol Symbol c tv r)
-> (Type -> Type) -> Type -> RTypeBV Symbol Symbol c tv r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
expandTypeSynonyms
  where
    go :: Type -> RTypeBV Symbol Symbol c tv r
go (TyVarTy Var
α)
      = TyConv c tv r -> Var -> RTypeBV Symbol Symbol c tv r
forall c tv r. TyConv c tv r -> Var -> RType c tv r
tcFVar TyConv c tv r
tx Var
α
    go (FunTy FunTyFlag
_ Type
_ Type
τ Type
τ')
      = Symbol
-> RTypeBV Symbol Symbol c tv r
-> RTypeBV Symbol Symbol c tv r
-> RTypeBV Symbol Symbol c tv r
forall r b v c tv.
IsReft r =>
b -> RTypeBV b v c tv r -> RTypeBV b v c tv r -> RTypeBV b v c tv r
rFun Symbol
dummySymbol (Type -> RTypeBV Symbol Symbol c tv r
go Type
τ) (Type -> RTypeBV Symbol Symbol c tv r
go Type
τ')
    go (ForAllTy (Bndr Var
α ForAllTyFlag
_) Type
τ)
      = RTVUBV Symbol Symbol c tv
-> RTypeBV Symbol Symbol c tv r
-> r
-> RTypeBV Symbol Symbol c tv r
forall b v c tv r.
RTVUBV b v c tv -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAllT (TyConv c tv r -> Var -> RTVUBV Symbol Symbol c tv
forall c tv r. TyConv c tv r -> Var -> RTVar tv (RType c tv NoReft)
tcFTVar TyConv c tv r
tx Var
α) (Type -> RTypeBV Symbol Symbol c tv r
go Type
τ) r
forall r. IsReft r => r
trueReft
    go (TyConApp TyCon
c [Type]
τs)
      | Just ([Var]
αs, Type
τ) <- TyCon -> Maybe ([Var], Type)
Ghc.synTyConDefn_maybe TyCon
c
      = Type -> RTypeBV Symbol Symbol c tv r
go ([Var] -> [Type] -> Type -> Type
HasDebugCallStack => [Var] -> [Type] -> Type -> Type
substTyWith [Var]
αs [Type]
τs Type
τ)
      | Bool
otherwise
      = TyConv c tv r
-> TyCon
-> [RTypeBV Symbol Symbol c tv r]
-> RTypeBV Symbol Symbol c tv r
forall c tv r.
TyConv c tv r -> TyCon -> [RType c tv r] -> RType c tv r
tcFApp TyConv c tv r
tx TyCon
c (Type -> RTypeBV Symbol Symbol c tv r
go (Type -> RTypeBV Symbol Symbol c tv r)
-> [Type] -> [RTypeBV Symbol Symbol c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
τs) -- [] mempty
    go (AppTy Type
t1 Type
t2)
      = RTypeBV Symbol Symbol c tv r
-> RTypeBV Symbol Symbol c tv r
-> r
-> RTypeBV Symbol Symbol c tv r
forall b v c tv r.
RTypeBV b v c tv r -> RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
RAppTy (Type -> RTypeBV Symbol Symbol c tv r
go Type
t1) (TyConv c tv r -> Type -> RTypeBV Symbol Symbol c tv r
forall r c tv. IsReft r => TyConv c tv r -> Type -> RType c tv r
ofType_ TyConv c tv r
tx Type
t2) r
forall r. IsReft r => r
trueReft
    go (LitTy TyLit
x)
      = TyConv c tv r -> TyLit -> RTypeBV Symbol Symbol c tv r
forall c tv r. TyConv c tv r -> TyLit -> RType c tv r
tcFLit TyConv c tv r
tx TyLit
x
    go (CastTy Type
t KindCoercion
_)
      = Type -> RTypeBV Symbol Symbol c tv r
go Type
t
    go (CoercionTy KindCoercion
_)
      = [Char] -> RTypeBV Symbol Symbol c tv r
forall a. HasCallStack => [Char] -> a
errorstar [Char]
"Coercion is currently not supported"

ofLitType :: (IsReft r) => (TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r) -> TyLit -> RType c tv r
ofLitType :: forall r c tv p.
IsReft r =>
(TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r)
-> TyLit -> RType c tv r
ofLitType TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r
rF (NumTyLit Integer
_)  = TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r
rF TyCon
intTyCon [] [] r
forall r. IsReft r => r
trueReft
ofLitType TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r
rF t :: TyLit
t@(StrTyLit FastString
_)
  | TyLit
t TyLit -> TyLit -> Bool
forall a. Eq a => a -> a -> Bool
== TyLit
holeLit           = r -> RType c tv r
forall b v c tv r. r -> RTypeBV b v c tv r
RHole r
forall r. IsReft r => r
trueReft
  | Bool
otherwise              = TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r
rF TyCon
listTyCon [TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r
rF TyCon
charTyCon [] [] r
forall r. IsReft r => r
trueReft] [] r
forall r. IsReft r => r
trueReft

holeLit :: TyLit
holeLit :: TyLit
holeLit = FastString -> TyLit
StrTyLit FastString
"$LH_RHOLE"

data TyConv c tv r = TyConv
  { forall c tv r. TyConv c tv r -> Var -> RType c tv r
tcFVar  :: TyVar -> RType c tv r
  , forall c tv r. TyConv c tv r -> Var -> RTVar tv (RType c tv NoReft)
tcFTVar :: TyVar -> RTVar tv (RType c tv NoReft)
  , forall c tv r.
TyConv c tv r -> TyCon -> [RType c tv r] -> RType c tv r
tcFApp  :: TyCon -> [RType c tv r] -> RType c tv r
  , forall c tv r. TyConv c tv r -> TyLit -> RType c tv r
tcFLit  :: TyLit -> RType c tv r
  }

--------------------------------------------------------------------------------
-- | Converting to Fixpoint ----------------------------------------------------
--------------------------------------------------------------------------------


instance Expression Var where
  expr :: Var -> Expr
expr   = Var -> Expr
forall a. Symbolic a => a -> Expr
eVar

-- TODO: turn this into a map lookup?
dataConReft ::  DataCon -> [Symbol] -> Reft
dataConReft :: DataCon -> [Symbol] -> ReftBV Symbol Symbol
dataConReft DataCon
c []
  | DataCon
c DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
trueDataCon
  = Expr -> ReftBV Symbol Symbol
forall a. Predicate a => a -> ReftBV Symbol Symbol
predReft (Expr -> ReftBV Symbol Symbol) -> Expr -> ReftBV Symbol Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> Expr
forall a. Symbolic a => a -> Expr
eProp Symbol
vv_
  | DataCon
c DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
falseDataCon
  = Expr -> ReftBV Symbol Symbol
forall a. Predicate a => a -> ReftBV Symbol Symbol
predReft (Expr -> ReftBV Symbol Symbol) -> Expr -> ReftBV Symbol Symbol
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
forall b v. ExprBV b v -> ExprBV b v
PNot (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Symbol -> Expr
forall a. Symbolic a => a -> Expr
eProp Symbol
vv_

dataConReft DataCon
c [Symbol
x]
  | DataCon
c DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
intDataCon
  = Symbol -> ReftBV Symbol Symbol
forall a. Symbolic a => a -> ReftBV Symbol Symbol
symbolReft Symbol
x -- OLD (vv_, [RConc (PAtom Eq (EVar vv_) (EVar x))])
dataConReft DataCon
c [Symbol]
_
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DataCon -> Bool
isBaseDataCon DataCon
c
  = ReftBV Symbol Symbol
forall a. Monoid a => a
mempty
dataConReft DataCon
c [Symbol]
xs
  = Expr -> ReftBV Symbol Symbol
forall a. Expression a => a -> ReftBV Symbol Symbol
exprReft Expr
dcValue -- OLD Reft (vv_, [RConc (PAtom Eq (EVar vv_) dcValue)])
  where
    dcValue :: Expr
dcValue
      | [Symbol] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Symbol]
xs Bool -> Bool -> Bool
&& [Var] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataCon -> [Var]
dataConUnivTyVars DataCon
c)
      = Symbol -> Expr
forall b v. v -> ExprBV b v
EVar (Symbol -> Expr) -> Symbol -> Expr
forall a b. (a -> b) -> a -> b
$ DataCon -> Symbol
forall a. Symbolic a => a -> Symbol
symbol DataCon
c
      | Bool
otherwise
      = Located Symbol -> [Expr] -> Expr
forall v b. Located v -> [ExprBV b v] -> ExprBV b v
mkEApp (Symbol -> Located Symbol
forall a. a -> Located a
dummyLoc (Symbol -> Located Symbol) -> Symbol -> Located Symbol
forall a b. (a -> b) -> a -> b
$ DataCon -> Symbol
forall a. Symbolic a => a -> Symbol
symbol DataCon
c) (Symbol -> Expr
forall a. Symbolic a => a -> Expr
eVar (Symbol -> Expr) -> [Symbol] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
xs)

isBaseDataCon :: DataCon -> Bool
isBaseDataCon :: DataCon -> Bool
isBaseDataCon DataCon
c = (Scaled Type -> Bool) -> [Scaled Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Type -> Bool
isBaseTy (Type -> Bool) -> (Scaled Type -> Type) -> Scaled Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scaled Type -> Type
forall a. Scaled a -> a
irrelevantMult) (DataCon -> [Scaled Type]
dataConOrigArgTys DataCon
c [Scaled Type] -> [Scaled Type] -> [Scaled Type]
forall a. [a] -> [a] -> [a]
++ DataCon -> [Scaled Type]
dataConRepArgTys DataCon
c)

isBaseTy :: Type -> Bool
isBaseTy :: Type -> Bool
isBaseTy (TyVarTy Var
_)      = Bool
True
isBaseTy (AppTy Type
_ Type
_)      = Bool
False
isBaseTy (TyConApp TyCon
_ [Type]
ts)  = (Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
isBaseTy [Type]
ts
isBaseTy FunTy{}          = Bool
False
isBaseTy (ForAllTy VarBndr Var ForAllTyFlag
_ Type
_)   = Bool
False
isBaseTy (LitTy TyLit
_)        = Bool
True
isBaseTy (CastTy Type
_ KindCoercion
_)     = Bool
False
isBaseTy (CoercionTy KindCoercion
_)   = Bool
False


dataConMsReft :: (ToReft r, ReftBind r ~ v, ReftVar r ~ v, F.Refreshable v) => RTypeBV v v c tv r -> [v] -> ReftBV v v
dataConMsReft :: forall r v c tv.
(ToReft r, ReftBind r ~ v, ReftVar r ~ v, Refreshable v) =>
RTypeBV v v c tv r -> [v] -> ReftBV v v
dataConMsReft RTypeBV v v c tv r
ty [v]
ys  = SubstV (Variable (ReftBV v v)) -> ReftBV v v -> ReftBV v v
forall a.
(Subable a, HasCallStack) =>
SubstV (Variable a) -> a -> a
subst SubstV v
SubstV (Variable (ReftBV v v))
su (RTypeBV v v c tv r -> ReftBV (ReftBind r) (ReftVar r)
forall r b v c tv.
(ToReft r, Binder (ReftBind r)) =>
RTypeBV b v c tv r -> ReftBV (ReftBind r) (ReftVar r)
rTypeReft (RTypeBV v v c tv r -> RTypeBV v v c tv r
forall b v c tv r. RTypeBV b v c tv r -> RTypeBV b v c tv r
ignoreOblig (RTypeBV v v c tv r -> RTypeBV v v c tv r)
-> RTypeBV v v c tv r -> RTypeBV v v c tv r
forall a b. (a -> b) -> a -> b
$ RTypeRepBV v v c tv r -> RTypeBV v v c tv r
forall b v c tv r. RTypeRepBV b v c tv r -> RTypeBV b v c tv r
ty_res RTypeRepBV v v c tv r
trep))
  where
    trep :: RTypeRepBV v v c tv r
trep = RTypeBV v v c tv r -> RTypeRepBV v v c tv r
forall b v c tv r. RTypeBV b v c tv r -> RTypeRepBV b v c tv r
toRTypeRep RTypeBV v v c tv r
ty
    xs :: [v]
xs   = RTypeRepBV v v c tv r -> [v]
forall b v c tv r. RTypeRepBV b v c tv r -> [b]
ty_binds RTypeRepBV v v c tv r
trep
    ts :: [RTypeBV v v c tv r]
ts   = RTypeRepBV v v c tv r -> [RTypeBV v v c tv r]
forall b v c tv r. RTypeRepBV b v c tv r -> [RTypeBV b v c tv r]
ty_args  RTypeRepBV v v c tv r
trep
    su :: SubstV v
su   = [(v, ExprBV v v)] -> SubstV v
forall v. Hashable v => [(v, ExprBV v v)] -> SubstV v
mkSubst ([(v, ExprBV v v)] -> SubstV v) -> [(v, ExprBV v v)] -> SubstV v
forall a b. (a -> b) -> a -> b
$ [(v
x, v -> ExprBV v v
forall b v. v -> ExprBV b v
EVar v
y) | ((v
x, RTypeBV v v c tv r
_), v
y) <- [(v, RTypeBV v v c tv r)] -> [v] -> [((v, RTypeBV v v c tv r), v)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([v] -> [RTypeBV v v c tv r] -> [(v, RTypeBV v v c tv r)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
xs [RTypeBV v v c tv r]
ts) [v]
ys]

--------------------------------------------------------------------------------
-- | Embedding RefTypes --------------------------------------------------------
--------------------------------------------------------------------------------

type ToTypeable r = (IsReft r, ReftBind r ~ Symbol, ReftVar r ~ Symbol, PPrint r, PPrint (RTProp RTyCon RTyVar r), SubsTy RTyVar (RRType NoReft) r)

-- TODO: remove toType, generalize typeSort
-- YL: really should take a type-level Bool
toType  :: (ToTypeable r) => Bool -> RRType r -> Type
toType :: forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo (RFun Symbol
_ RFInfo{permitTC :: RFInfo -> Maybe Bool
permitTC = Maybe Bool
permitTC} t :: RTypeBV Symbol Symbol RTyCon RTyVar r
t@(RApp RTyCon
c [RTypeBV Symbol Symbol RTyCon RTyVar r]
_ [RTProp RTyCon RTyVar r]
_ r
_) RTypeBV Symbol Symbol RTyCon RTyVar r
t' r
_)
  | Bool
useRFInfo Bool -> Bool -> Bool
&& RTyCon -> Bool
isErasable RTyCon
c = Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t'
  | Bool
otherwise
  = FunTyFlag -> Type -> Type -> Type -> Type
FunTy FunTyFlag
FTF_T_T Type
ManyTy (Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t) (Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t')
  where isErasable :: RTyCon -> Bool
isErasable = if Maybe Bool
permitTC Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True then RTyCon -> Bool
forall c. TyConable c => c -> Bool
isEmbeddedDict else RTyCon -> Bool
forall c. TyConable c => c -> Bool
isClass
toType Bool
useRFInfo (RFun Symbol
_ RFInfo
_ RTypeBV Symbol Symbol RTyCon RTyVar r
t RTypeBV Symbol Symbol RTyCon RTyVar r
t' r
_)
  = FunTyFlag -> Type -> Type -> Type -> Type
FunTy FunTyFlag
FTF_T_T Type
ManyTy (Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t) (Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t')
toType Bool
useRFInfo (RAllT RTVar RTyVar (RType RTyCon RTyVar NoReft)
a RTypeBV Symbol Symbol RTyCon RTyVar r
t r
_) | RTV Var
α <- RTVar RTyVar (RType RTyCon RTyVar NoReft) -> RTyVar
forall tv s. RTVar tv s -> tv
ty_var_value RTVar RTyVar (RType RTyCon RTyVar NoReft)
a
  = VarBndr Var ForAllTyFlag -> Type -> Type
ForAllTy (Var -> ForAllTyFlag -> VarBndr Var ForAllTyFlag
forall var argf. var -> argf -> VarBndr var argf
Bndr Var
α ForAllTyFlag
Required) (Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t)
toType Bool
useRFInfo (RAllP RPVar
_ RTypeBV Symbol Symbol RTyCon RTyVar r
t)
  = Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t
toType Bool
_ (RVar (RTV Var
α) r
_)
  = Var -> Type
TyVarTy Var
α
toType Bool
useRFInfo (RApp RTyCon{rtc_tc :: RTyCon -> TyCon
rtc_tc = TyCon
c} [RTypeBV Symbol Symbol RTyCon RTyVar r]
ts [RTProp RTyCon RTyVar r]
_ r
_)
  = TyCon -> [Type] -> Type
TyConApp TyCon
c (Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo (RTypeBV Symbol Symbol RTyCon RTyVar r -> Type)
-> [RTypeBV Symbol Symbol RTyCon RTyVar r] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RTypeBV Symbol Symbol RTyCon RTyVar r -> Bool)
-> [RTypeBV Symbol Symbol RTyCon RTyVar r]
-> [RTypeBV Symbol Symbol RTyCon RTyVar r]
forall a. (a -> Bool) -> [a] -> [a]
filter RTypeBV Symbol Symbol RTyCon RTyVar r -> Bool
forall v c tv r. RTypeV v c tv r -> Bool
notExprArg [RTypeBV Symbol Symbol RTyCon RTyVar r]
ts)
toType Bool
useRFInfo (RAllE Symbol
_ RTypeBV Symbol Symbol RTyCon RTyVar r
_ RTypeBV Symbol Symbol RTyCon RTyVar r
t)
  = Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t
toType Bool
useRFInfo (REx Symbol
_ RTypeBV Symbol Symbol RTyCon RTyVar r
_ RTypeBV Symbol Symbol RTyCon RTyVar r
t)
  = Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t
toType Bool
useRFInfo (RAppTy RTypeBV Symbol Symbol RTyCon RTyVar r
t (RExprArg Located Expr
_) r
_)
  = Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t
toType Bool
useRFInfo (RAppTy RTypeBV Symbol Symbol RTyCon RTyVar r
t RTypeBV Symbol Symbol RTyCon RTyVar r
t' r
_)
  = Type -> Type -> Type
AppTy (Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t) (Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t')
toType Bool
_ t :: RTypeBV Symbol Symbol RTyCon RTyVar r
t@(RExprArg Located Expr
_)
  = Maybe SrcSpan -> [Char] -> Type
forall a. Maybe SrcSpan -> [Char] -> a
impossible Maybe SrcSpan
forall a. Maybe a
Nothing ([Char] -> Type) -> [Char] -> Type
forall a b. (a -> b) -> a -> b
$ [Char]
"CANNOT HAPPEN: RefType.toType called with: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ RTypeBV Symbol Symbol RTyCon RTyVar r -> [Char]
forall a. PPrint a => a -> [Char]
showpp RTypeBV Symbol Symbol RTyCon RTyVar r
t
toType Bool
useRFInfo (RRTy [(Symbol, RTypeBV Symbol Symbol RTyCon RTyVar r)]
_ r
_ Oblig
_ RTypeBV Symbol Symbol RTyCon RTyVar r
t)
  = Bool -> RTypeBV Symbol Symbol RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RTypeBV Symbol Symbol RTyCon RTyVar r
t
toType Bool
_ (RHole r
_)
  = TyLit -> Type
LitTy TyLit
holeLit
-- toType t
--  = {- impossible Nothing -} Prelude.error $ "RefType.toType cannot handle: " ++ show t

{- | [NOTE:Hole-Lit]

We use `toType` to convert RType to GHC.Type to expand any GHC
related type-aliases, e.g. in Bare.Resolve.expandRTypeSynonyms.
If the RType has a RHole then what to do?

We, encode `RHole` as `LitTy "LH_HOLE"` -- which is a bit of
a *hack*. The only saving grace is it is used *temporarily*
and then swiftly turned back into an `RHole` via `ofType`
(after GHC has done its business of expansion).

Of course, we hope this doesn't break any GHC invariants!
See issue #1476 and #1477

The other option is to *not* use `toType` on things that have
holes in them, but this seems worse, e.g. because you may define
a plain GHC alias like:

    type ToNat a = a -> Nat

and then you might write refinement types like:

    {-@ foo :: ToNat {v:_ | 0 <= v} @-}

and we'd want to expand the above to

    {-@ foo :: {v:_ | 0 <= v} -> Nat @-}

and then resolve the hole using the (GHC) type of `foo`.

-}

--------------------------------------------------------------------------------
-- | Annotations and Solutions -------------------------------------------------
--------------------------------------------------------------------------------

rTypeSortedReft ::  (PPrint r, IsReft r, ReftBind r ~ Symbol, ReftVar r ~ Symbol, SubsTy RTyVar (RType RTyCon RTyVar NoReft) r)
                => TCEmb TyCon -> RRType r -> SortedReft
rTypeSortedReft :: forall r.
(PPrint r, IsReft r, ReftBind r ~ Symbol, ReftVar r ~ Symbol,
 SubsTy RTyVar (RType RTyCon RTyVar NoReft) r) =>
TCEmb TyCon -> RRType r -> SortedReft
rTypeSortedReft TCEmb TyCon
emb RRType r
t = Sort -> ReftBV Symbol Symbol -> SortedReft
RR (TCEmb TyCon -> RRType r -> Sort
forall r.
(PPrint r, IsReft r, ReftBind r ~ Symbol, ReftVar r ~ Symbol,
 SubsTy RTyVar (RType RTyCon RTyVar NoReft) r) =>
TCEmb TyCon -> RRType r -> Sort
rTypeSort TCEmb TyCon
emb RRType r
t) (RRType r -> ReftBV (ReftBind r) (ReftVar r)
forall r b v c tv.
(ToReft r, Binder (ReftBind r)) =>
RTypeBV b v c tv r -> ReftBV (ReftBind r) (ReftVar r)
rTypeReft RRType r
t)

rTypeSort     ::  (PPrint r, IsReft r, ReftBind r ~ Symbol, ReftVar r ~ Symbol, SubsTy RTyVar (RType RTyCon RTyVar NoReft) r)
              => TCEmb TyCon -> RRType r -> Sort
rTypeSort :: forall r.
(PPrint r, IsReft r, ReftBind r ~ Symbol, ReftVar r ~ Symbol,
 SubsTy RTyVar (RType RTyCon RTyVar NoReft) r) =>
TCEmb TyCon -> RRType r -> Sort
rTypeSort TCEmb TyCon
tce = TCEmb TyCon -> Type -> Sort
typeSort TCEmb TyCon
tce (Type -> Sort)
-> (RType RTyCon RTyVar r -> Type) -> RType RTyCon RTyVar r -> Sort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RType RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
True

--------------------------------------------------------------------------------
applySolution
  :: (Functor f)
  => FInfo a -> M.HashMap KVar (Delayed Expr) -> f SpecType -> f SpecType
--------------------------------------------------------------------------------
applySolution :: forall (f :: * -> *) a.
Functor f =>
FInfo a -> HashMap KVar (Delayed Expr) -> f SpecType -> f SpecType
applySolution FInfo a
si = (SpecType -> SpecType) -> f SpecType -> f SpecType
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SpecType -> SpecType) -> f SpecType -> f SpecType)
-> (HashMap KVar (Delayed Expr) -> SpecType -> SpecType)
-> HashMap KVar (Delayed Expr)
-> f SpecType
-> f SpecType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RReft -> RReft) -> SpecType -> SpecType
forall a b.
(a -> b)
-> RTypeBV Symbol Symbol RTyCon RTyVar a
-> RTypeBV Symbol Symbol RTyCon RTyVar b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RReft -> RReft) -> SpecType -> SpecType)
-> (HashMap KVar (Delayed Expr) -> RReft -> RReft)
-> HashMap KVar (Delayed Expr)
-> SpecType
-> SpecType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Expr) -> RReft -> RReft
forall {b} {v} {v} {b} {v}.
(ExprBV b v -> ExprBV b v)
-> UReftBV b v (ReftBV b v) -> UReftBV b v (ReftBV b v)
mapReft' ((Expr -> Expr) -> RReft -> RReft)
-> (HashMap KVar (Delayed Expr) -> Expr -> Expr)
-> HashMap KVar (Delayed Expr)
-> RReft
-> RReft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FInfo a -> HashMap KVar (Delayed Expr) -> Expr -> Expr
forall t (c :: * -> *) a.
Visitable t =>
GInfo c a -> HashMap KVar (Delayed Expr) -> t -> t
appSolRefa FInfo a
si
  where
    mapReft' :: (ExprBV b v -> ExprBV b v)
-> UReftBV b v (ReftBV b v) -> UReftBV b v (ReftBV b v)
mapReft' ExprBV b v -> ExprBV b v
f (MkUReft (Reft (b
x, ExprBV b v
z)) PredicateBV b v
p) = ReftBV b v -> PredicateBV b v -> UReftBV b v (ReftBV b v)
forall b v r. r -> PredicateBV b v -> UReftBV b v r
MkUReft ((b, ExprBV b v) -> ReftBV b v
forall b v. (b, ExprBV b v) -> ReftBV b v
Reft (b
x, ExprBV b v -> ExprBV b v
f ExprBV b v
z)) PredicateBV b v
p

appSolRefa :: Visitable t
           => GInfo c a -> M.HashMap KVar (Delayed Expr) -> t -> t
appSolRefa :: forall t (c :: * -> *) a.
Visitable t =>
GInfo c a -> HashMap KVar (Delayed Expr) -> t -> t
appSolRefa GInfo c a
si HashMap KVar (Delayed Expr)
s = (KVar -> Maybe Expr) -> t -> t
forall t. Visitable t => (KVar -> Maybe Expr) -> t -> t
mapKVars KVar -> Maybe Expr
f0
  where
    f0 :: KVar -> Maybe Expr
f0 KVar
k        = Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ Delayed Expr -> Expr
forall a. Delayed a -> a
forceDelayed (Delayed Expr -> Expr) -> Delayed Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Delayed Expr -> KVar -> HashMap KVar (Delayed Expr) -> Delayed Expr
forall k v. Hashable k => v -> k -> HashMap k v -> v
M.lookupDefault (Expr -> Delayed Expr
forall a. a -> Delayed a
Delayed Expr
forall b v. ExprBV b v
PTop) KVar
k HashMap KVar (Delayed Expr)
s

    mapKVars :: Visitable t => (KVar -> Maybe Expr) -> t -> t
    mapKVars :: forall t. Visitable t => (KVar -> Maybe Expr) -> t -> t
mapKVars KVar -> Maybe Expr
f = (Expr -> Expr) -> t -> t
forall t. Visitable t => (Expr -> Expr) -> t -> t
trans Expr -> Expr
txK
      where
        txK :: Expr -> Expr
txK (PKVar KVar
k TyVarSubst
_tsu KVarSubst Symbol Symbol
su)
          | Just Expr
p' <- KVar -> Maybe Expr
f KVar
k =
              HashSet Symbol -> SubstV Symbol -> Expr -> Expr
forall v.
(Hashable v, Refreshable v) =>
HashSet v -> SubstV v -> ExprBV v v -> ExprBV v v
rapierSubstExpr (SubstV Symbol -> HashSet Symbol
forall v. (Eq v, Hashable v) => SubstV v -> HashSet v
substSymbolsSet (SubstV Symbol -> HashSet Symbol)
-> SubstV Symbol -> HashSet Symbol
forall a b. (a -> b) -> a -> b
$ KVarSubst Symbol Symbol -> SubstV Symbol
forall v. Hashable v => KVarSubst v v -> SubstV v
substFromKSubst KVarSubst Symbol Symbol
su) (KVar -> KVarSubst Symbol Symbol -> SubstV Symbol
renameDomain KVar
k KVarSubst Symbol Symbol
su) Expr
p'
        txK Expr
p = Expr
p

        -- The parameters of kvars all seem to have prefix $ and suffix ##k_
        -- at the point where mapKVars is used. We compensate for that here.
        renameDomain :: KVar -> KVarSubst Symbol Symbol -> SubstV Symbol
renameDomain KVar
k KVarSubst Symbol Symbol
su =
          HashMap Symbol Expr -> SubstV Symbol
forall v. HashMap v (ExprBV v v) -> SubstV v
Su (HashMap Symbol Expr -> SubstV Symbol)
-> HashMap Symbol Expr -> SubstV Symbol
forall a b. (a -> b) -> a -> b
$ [(Symbol, Expr)] -> HashMap Symbol Expr
forall k v. Hashable k => [(k, v)] -> HashMap k v
M.fromList
            [ (Char -> Symbol -> Symbol
consSym Char
'$' (Symbol -> Symbol -> Symbol
suffixSymbol Symbol
v Symbol
"k_"), Expr
e)
            | Symbol
v <- GInfo c a -> KVar -> [Symbol]
forall (c :: * -> *) a. GInfo c a -> KVar -> [Symbol]
kvarDomain GInfo c a
si KVar
k
            , let e :: Expr
e = Expr -> Symbol -> HashMap Symbol Expr -> Expr
forall k v. Hashable k => v -> k -> HashMap k v -> v
M.lookupDefault (Symbol -> Expr
forall b v. v -> ExprBV b v
EVar Symbol
v) Symbol
v (KVarSubst Symbol Symbol -> HashMap Symbol Expr
forall b v. Hashable b => KVarSubst b v -> HashMap b (ExprBV b v)
fromKVarSubst KVarSubst Symbol Symbol
su)
            ]

--------------------------------------------------------------------------------
-- shiftVV :: Int -- SpecType -> Symbol -> SpecType
shiftVV :: (TyConable c, IsReft (f Reft), Functor f, Subable (f Reft),
            Variable (f Reft) ~ Variable Reft, ReftBind (f Reft) ~ ReftBind Reft)
        => RType c tv (f Reft) -> Symbol -> RType c tv (f Reft)
--------------------------------------------------------------------------------
shiftVV :: forall c (f :: * -> *) tv.
(TyConable c, IsReft (f (ReftBV Symbol Symbol)), Functor f,
 Subable (f (ReftBV Symbol Symbol)),
 Variable (f (ReftBV Symbol Symbol))
 ~ Variable (ReftBV Symbol Symbol),
 ReftBind (f (ReftBV Symbol Symbol))
 ~ ReftBind (ReftBV Symbol Symbol)) =>
RType c tv (f (ReftBV Symbol Symbol))
-> Symbol -> RType c tv (f (ReftBV Symbol Symbol))
shiftVV t :: RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t@(RApp c
_ [RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))]
ts [RTPropBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))]
rs f (ReftBV Symbol Symbol)
r) Symbol
vv'
  = RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t { rt_args  = subst1 ts (rTypeValueVar t, EVar vv') }
      { rt_pargs = subst1 rs (rTypeValueVar t, EVar vv') }
      { rt_reft  = (`F.shiftVV` vv') <$> r }

shiftVV t :: RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t@(RFun Symbol
_ RFInfo
_ RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
_ RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
_ f (ReftBV Symbol Symbol)
r) Symbol
vv'
  = RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t { rt_reft = (`F.shiftVV` vv') <$> r }

shiftVV t :: RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t@(RAppTy RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
_ RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
_ f (ReftBV Symbol Symbol)
r) Symbol
vv'
  = RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t { rt_reft = (`F.shiftVV` vv') <$> r }

shiftVV t :: RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t@(RVar tv
_ f (ReftBV Symbol Symbol)
r) Symbol
vv'
  = RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t { rt_reft = (`F.shiftVV` vv') <$> r }

shiftVV RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t Symbol
_
  = RTypeBV Symbol Symbol c tv (f (ReftBV Symbol Symbol))
t -- errorstar $ "shiftVV: cannot handle " ++ showpp t


--------------------------------------------------------------------------------
-- |Auxiliary Stuff Used Elsewhere ---------------------------------------------
--------------------------------------------------------------------------------

-- MOVE TO TYPES
instance (Show tv, Show ty) => Show (RTAlias tv ty) where
  show :: RTAlias tv ty -> [Char]
show (RTA Located LHName
n [tv]
as [Symbol]
xs ty
t) =
    [Char] -> [Char] -> [Char] -> [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"type %s %s %s = %s" (Symbol -> [Char]
symbolString (Symbol -> [Char])
-> (Located LHName -> Symbol) -> Located LHName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHName -> Symbol
getLHNameSymbol (LHName -> Symbol)
-> (Located LHName -> LHName) -> Located LHName -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located LHName -> LHName
forall a. Located a -> a
val (Located LHName -> [Char]) -> Located LHName -> [Char]
forall a b. (a -> b) -> a -> b
$ Located LHName
n)
      ([[Char]] -> [Char]
unwords (tv -> [Char]
forall a. Show a => a -> [Char]
show (tv -> [Char]) -> [tv] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [tv]
as))
      ([[Char]] -> [Char]
unwords (Symbol -> [Char]
forall a. Show a => a -> [Char]
show (Symbol -> [Char]) -> [Symbol] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
xs))
      (ty -> [Char]
forall a. Show a => a -> [Char]
show ty
t)

--------------------------------------------------------------------------------
-- | From Old Fixpoint ---------------------------------------------------------
--------------------------------------------------------------------------------
typeSort :: TCEmb TyCon -> Type -> Sort
typeSort :: TCEmb TyCon -> Type -> Sort
typeSort TCEmb TyCon
tce = Type -> Sort
go
  where
    go :: Type -> Sort
    go :: Type -> Sort
go t :: Type
t@FunTy{}        = TCEmb TyCon -> Type -> Sort
typeSortFun TCEmb TyCon
tce Type
t
    go τ :: Type
τ@(ForAllTy VarBndr Var ForAllTyFlag
_ Type
_) = TCEmb TyCon -> Type -> Sort
typeSortForAll TCEmb TyCon
tce Type
τ
    -- go (TyConApp c τs)  = fApp (tyConFTyCon tce c) (go <$> τs)
    go (TyConApp TyCon
c [Type]
τs)
      | TyCon -> Bool
isNewTyCon TyCon
c
      , Bool -> Bool
not (TyCon -> Bool
isRecursivenewTyCon TyCon
c)
      , [Type]
τs [Type] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthAtLeast` TyCon -> Int
newTyConEtadArity TyCon
c
      = Type -> Sort
go (TyCon -> [Type] -> Type
Ghc.newTyConInstRhs TyCon
c [Type]
τs)
      | Bool
otherwise
      = TCEmb TyCon -> TyCon -> [Sort] -> Sort
tyConFTyCon TCEmb TyCon
tce TyCon
c (Type -> Sort
go (Type -> Sort) -> [Type] -> [Sort]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
τs)
    go (AppTy Type
t1 Type
t2)    = Sort -> [Sort] -> Sort
fApp (Type -> Sort
go Type
t1) [Type -> Sort
go Type
t2]
    go (TyVarTy Var
tv)     = Var -> Sort
tyVarSort Var
tv
    go (CastTy Type
t KindCoercion
_)     = Type -> Sort
go Type
t
    go Type
τ                = Symbol -> Sort
FObj (Type -> Symbol
typeUniqueSymbol Type
τ)

tyConFTyCon :: TCEmb TyCon -> TyCon -> [Sort] -> Sort
-- ignore the nat arguments of the Any types, see test/pos/T2535A.hs
-- tyConFTyCon _ c _ | Ghc.zonkAnyTyCon  == c = FObj (symbol c)
tyConFTyCon :: TCEmb TyCon -> TyCon -> [Sort] -> Sort
tyConFTyCon TCEmb TyCon
tce TyCon
c [Sort]
ts =
  case TyCon -> TCEmb TyCon -> Maybe (Sort, TCArgs)
forall a.
(Eq a, Hashable a) =>
a -> TCEmb a -> Maybe (Sort, TCArgs)
tceLookup TyCon
c TCEmb TyCon
tce of
    Just (Sort
t, TCArgs
WithArgs) -> Sort
t
    Just (Sort
t, TCArgs
NoArgs)   -> Sort -> [Sort] -> Sort
fApp Sort
t [Sort]
ts
    Maybe (Sort, TCArgs)
Nothing            -> Sort -> [Sort] -> Sort
fApp (FTycon -> Sort
fTyconSort FTycon
niTc) [Sort]
ts
  where
    niTc :: FTycon
niTc             = Located Symbol -> Bool -> Bool -> FTycon
symbolNumInfoFTyCon (Symbol -> Located Symbol
forall a. a -> Located a
dummyLoc (Symbol -> Located Symbol) -> Symbol -> Located Symbol
forall a b. (a -> b) -> a -> b
$ TyCon -> Symbol
tyConName TyCon
c) (TyCon -> Bool
forall c. TyConable c => c -> Bool
isNumCls TyCon
c) (TyCon -> Bool
forall c. TyConable c => c -> Bool
isFracCls TyCon
c)
    -- oldRes           = F.notracepp _msg $ M.lookupDefault def c tce
    -- _msg             = "tyConFTyCon c = " ++ show c ++ "default " ++ show (def, Ghc.isFamInstTyCon c)

tyVarSort :: TyVar -> Sort
tyVarSort :: Var -> Sort
tyVarSort = Symbol -> Sort
FObj (Symbol -> Sort) -> (Var -> Symbol) -> Var -> Sort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Symbol
forall a. Symbolic a => a -> Symbol
symbol

typeUniqueSymbol :: Type -> Symbol
typeUniqueSymbol :: Type -> Symbol
typeUniqueSymbol = [Char] -> Symbol
forall a. Symbolic a => a -> Symbol
symbol ([Char] -> Symbol) -> (Type -> [Char]) -> Type -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [Char]
forall a. Outputable a => a -> [Char]
GM.typeUniqueString

typeSortForAll :: TCEmb TyCon -> Type -> Sort
typeSortForAll :: TCEmb TyCon -> Type -> Sort
typeSortForAll TCEmb TyCon
tce Type
τ  = [Char] -> Sort -> Sort
forall a. PPrint a => [Char] -> a -> a
F.notracepp ([Char]
"typeSortForall " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Type -> [Char]
forall a. PPrint a => a -> [Char]
showpp Type
τ) (Sort -> Sort) -> Sort -> Sort
forall a b. (a -> b) -> a -> b
$ Sort -> Sort
genSort Sort
sbody
  where
    sbody :: Sort
sbody             = TCEmb TyCon -> Type -> Sort
typeSort TCEmb TyCon
tce Type
tbody
    genSort :: Sort -> Sort
genSort Sort
t         = (Sort -> Int -> Sort) -> Sort -> [Int] -> Sort
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Int -> Sort -> Sort) -> Sort -> Int -> Sort
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Sort -> Sort
FAbs) (TyVarSubst -> Sort -> Sort
sortSubst TyVarSubst
su Sort
t) [Int
i..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
    ([Var]
as, Type
tbody)       = [Char] -> ([Var], Type) -> ([Var], Type)
forall a. PPrint a => [Char] -> a -> a
F.notracepp ([Char]
"splitForallTys" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Type -> [Char]
forall a. Outputable a => a -> [Char]
GM.showPpr Type
τ) (Type -> ([Var], Type)
splitForAllTyCoVars Type
τ)
    su :: TyVarSubst
su                = [(Symbol, Sort)] -> TyVarSubst
forall k v. Hashable k => [(k, v)] -> HashMap k v
M.fromList ([(Symbol, Sort)] -> TyVarSubst) -> [(Symbol, Sort)] -> TyVarSubst
forall a b. (a -> b) -> a -> b
$ [Symbol] -> [Sort] -> [(Symbol, Sort)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
sas (Int -> Sort
FVar (Int -> Sort) -> [Int] -> [Sort]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  [Int
i..])
    sas :: [Symbol]
sas               = Var -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Var -> Symbol) -> [Var] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
as
    n :: Int
n                 = [Var] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Var]
as
    i :: Int
i                 = Sort -> Int
sortAbs Sort
sbody Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- RJ: why not make this the Symbolic instance?
tyConName :: TyCon -> Symbol
tyConName :: TyCon -> Symbol
tyConName TyCon
c
  | TyCon
listTyCon TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
c    = Symbol
listConName
  | TyCon -> Bool
Ghc.isTupleTyCon TyCon
c = [Char] -> Symbol
forall a. Symbolic a => a -> Symbol
symbol ([Char] -> Symbol) -> [Char] -> Symbol
forall a b. (a -> b) -> a -> b
$ [Char]
"Tuple" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (TyCon -> Int
tyConArity TyCon
c)
  | Bool
otherwise         = TyCon -> Symbol
forall a. Symbolic a => a -> Symbol
symbol TyCon
c

typeSortFun :: TCEmb TyCon -> Type -> Sort
typeSortFun :: TCEmb TyCon -> Type -> Sort
typeSortFun TCEmb TyCon
tce Type
t = Int -> [Sort] -> Sort
mkFFunc Int
0 [Sort]
sos
  where
    sos :: [Sort]
sos           = TCEmb TyCon -> Type -> Sort
typeSort TCEmb TyCon
tce (Type -> Sort) -> [Type] -> [Sort]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
τs
    τs :: [Type]
τs            = [Type] -> Type -> [Type]
grabArgs [] Type
t

grabArgs :: [Type] -> Type -> [Type]
grabArgs :: [Type] -> Type -> [Type]
grabArgs [Type]
τs (FunTy FunTyFlag
_ Type
_ Type
τ1 Type
τ2)
  | Just Type
a <- Type -> Maybe Type
stringClassArg Type
τ1
  = [Type] -> Type -> [Type]
grabArgs [Type]
τs ((Type -> Type) -> Type -> Type
mapType (\Type
t -> if Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
a then Type
stringTy else Type
t) Type
τ2)
  -- not ( F.notracepp ("isNonArg: " ++ GM.showPpr τ1) $ isNonValueTy τ1)
  | Bool
otherwise
  = [Type] -> Type -> [Type]
grabArgs (Type
τ1Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:[Type]
τs) Type
τ2
  -- otherwise
  -- = grabArgs τs τ2
  -- -- | otherwise
  -- -- = grabArgs τs τ2
grabArgs [Type]
τs Type
τ
  = [Type] -> [Type]
forall a. [a] -> [a]
reverse (Type
τType -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:[Type]
τs)


expandProductType :: (PPrint r, IsReft r, SubsTy RTyVar (RType RTyCon RTyVar NoReft) r,
                      ReftBind r ~ Symbol, ReftVar r ~ Symbol, Variable r ~ Symbol)
                  => Var -> RType RTyCon RTyVar r -> RType RTyCon RTyVar r
expandProductType :: forall r.
(PPrint r, IsReft r, SubsTy RTyVar (RType RTyCon RTyVar NoReft) r,
 ReftBind r ~ Symbol, ReftVar r ~ Symbol, Variable r ~ Symbol) =>
Var -> RType RTyCon RTyVar r -> RType RTyCon RTyVar r
expandProductType Var
x RType RTyCon RTyVar r
t
  | Bool
isTrivial'      = RType RTyCon RTyVar r
t
  | Bool
otherwise       = RTypeRepBV Symbol Symbol RTyCon RTyVar r -> RType RTyCon RTyVar r
forall b v c tv r. RTypeRepBV b v c tv r -> RTypeBV b v c tv r
fromRTypeRep (RTypeRepBV Symbol Symbol RTyCon RTyVar r -> RType RTyCon RTyVar r)
-> RTypeRepBV Symbol Symbol RTyCon RTyVar r
-> RType RTyCon RTyVar r
forall a b. (a -> b) -> a -> b
$ RTypeRepBV Symbol Symbol RTyCon RTyVar r
trep {ty_binds = xs', ty_info=is', ty_args = ts', ty_refts = rs'}
     where
      isTrivial' :: Bool
isTrivial'    = Type -> RType RTyCon RTyVar NoReft
forall r. IsReft r => Type -> RRType r
ofType (Var -> Type
varType Var
x) RType RTyCon RTyVar NoReft -> RType RTyCon RTyVar NoReft -> Bool
forall a. Eq a => a -> a -> Bool
== RType RTyCon RTyVar r -> RType RTyCon RTyVar NoReft
forall b v c tv r.
Binder b =>
RTypeBV b v c tv r -> RTypeBV b v c tv (NoReftB b)
toRSort RType RTyCon RTyVar r
t
      τs :: [Type]
τs            = (Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
forall a. Scaled a -> a
irrelevantMult ([Scaled Type] -> [Type]) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> a -> b
$ ([Scaled Type], Type) -> [Scaled Type]
forall a b. (a, b) -> a
fst (([Scaled Type], Type) -> [Scaled Type])
-> ([Scaled Type], Type) -> [Scaled Type]
forall a b. (a -> b) -> a -> b
$ Type -> ([Scaled Type], Type)
splitFunTys (Type -> ([Scaled Type], Type)) -> Type -> ([Scaled Type], Type)
forall a b. (a -> b) -> a -> b
$ ([Var], Type) -> Type
forall a b. (a, b) -> b
snd (([Var], Type) -> Type) -> ([Var], Type) -> Type
forall a b. (a -> b) -> a -> b
$ Type -> ([Var], Type)
splitForAllTyCoVars (Type -> ([Var], Type)) -> Type -> ([Var], Type)
forall a b. (a -> b) -> a -> b
$ Bool -> RType RTyCon RTyVar r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
False RType RTyCon RTyVar r
t
      trep :: RTypeRepBV Symbol Symbol RTyCon RTyVar r
trep          = RType RTyCon RTyVar r -> RTypeRepBV Symbol Symbol RTyCon RTyVar r
forall b v c tv r. RTypeBV b v c tv r -> RTypeRepBV b v c tv r
toRTypeRep RType RTyCon RTyVar r
t
      ([Symbol]
xs',[RFInfo]
is',[RType RTyCon RTyVar r]
ts',[r]
rs') = [(Symbol, RFInfo, RType RTyCon RTyVar r, r)]
-> ([Symbol], [RFInfo], [RType RTyCon RTyVar r], [r])
forall t t1 t2 t3. [(t, t1, t2, t3)] -> ([t], [t1], [t2], [t3])
unzip4 ([(Symbol, RFInfo, RType RTyCon RTyVar r, r)]
 -> ([Symbol], [RFInfo], [RType RTyCon RTyVar r], [r]))
-> [(Symbol, RFInfo, RType RTyCon RTyVar r, r)]
-> ([Symbol], [RFInfo], [RType RTyCon RTyVar r], [r])
forall a b. (a -> b) -> a -> b
$ ((Type, Symbol, RFInfo, RType RTyCon RTyVar r, r)
 -> [(Symbol, RFInfo, RType RTyCon RTyVar r, r)])
-> [(Type, Symbol, RFInfo, RType RTyCon RTyVar r, r)]
-> [(Symbol, RFInfo, RType RTyCon RTyVar r, r)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Type, Symbol, RFInfo, RType RTyCon RTyVar r, r)
-> [(Symbol, RFInfo, RType RTyCon RTyVar r, r)]
forall t r.
(IsReft t, IsReft r) =>
(Type, Symbol, RFInfo, RType RTyCon RTyVar r, t)
-> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
mkProductTy ([(Type, Symbol, RFInfo, RType RTyCon RTyVar r, r)]
 -> [(Symbol, RFInfo, RType RTyCon RTyVar r, r)])
-> [(Type, Symbol, RFInfo, RType RTyCon RTyVar r, r)]
-> [(Symbol, RFInfo, RType RTyCon RTyVar r, r)]
forall a b. (a -> b) -> a -> b
$ [Type]
-> [Symbol]
-> [RFInfo]
-> [RType RTyCon RTyVar r]
-> [r]
-> [(Type, Symbol, RFInfo, RType RTyCon RTyVar r, r)]
forall t t1 t2 t3 t4.
[t] -> [t1] -> [t2] -> [t3] -> [t4] -> [(t, t1, t2, t3, t4)]
zip5 [Type]
τs (RTypeRepBV Symbol Symbol RTyCon RTyVar r -> [Symbol]
forall b v c tv r. RTypeRepBV b v c tv r -> [b]
ty_binds RTypeRepBV Symbol Symbol RTyCon RTyVar r
trep) (RTypeRepBV Symbol Symbol RTyCon RTyVar r -> [RFInfo]
forall b v c tv r. RTypeRepBV b v c tv r -> [RFInfo]
ty_info RTypeRepBV Symbol Symbol RTyCon RTyVar r
trep) (RTypeRepBV Symbol Symbol RTyCon RTyVar r -> [RType RTyCon RTyVar r]
forall b v c tv r. RTypeRepBV b v c tv r -> [RTypeBV b v c tv r]
ty_args RTypeRepBV Symbol Symbol RTyCon RTyVar r
trep) (RTypeRepBV Symbol Symbol RTyCon RTyVar r -> [r]
forall b v c tv r. RTypeRepBV b v c tv r -> [r]
ty_refts RTypeRepBV Symbol Symbol RTyCon RTyVar r
trep)

-- splitFunTys :: Type -> ([Type], Type)

data DataConAppContext
  = DataConAppContext
  { DataConAppContext -> DataCon
dcac_dc      :: !DataCon
  , DataConAppContext -> [Type]
dcac_tys     :: ![Type]
  , DataConAppContext -> [(Type, StrictnessMark)]
dcac_arg_tys :: ![(Type, StrictnessMark)]
  , DataConAppContext -> KindCoercion
dcac_co      :: !Coercion
  }

mkProductTy :: forall t r. (IsReft t, IsReft r)
            => (Type, Symbol, RFInfo, RType RTyCon RTyVar r, t)
            -> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
mkProductTy :: forall t r.
(IsReft t, IsReft r) =>
(Type, Symbol, RFInfo, RType RTyCon RTyVar r, t)
-> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
mkProductTy (Type
τ, Symbol
x, RFInfo
i, RType RTyCon RTyVar r
t, t
r) = [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
-> (DataConAppContext
    -> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)])
-> Maybe DataConAppContext
-> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Symbol
x, RFInfo
i, RType RTyCon RTyVar r
t, t
r)] DataConAppContext -> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
f (FamInstEnvs -> Type -> Maybe DataConAppContext
deepSplitProductType FamInstEnvs
menv Type
τ)
  where
    f    :: DataConAppContext -> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
    f :: DataConAppContext -> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
f    DataConAppContext{[(Type, StrictnessMark)]
[Type]
KindCoercion
DataCon
dcac_dc :: DataConAppContext -> DataCon
dcac_tys :: DataConAppContext -> [Type]
dcac_arg_tys :: DataConAppContext -> [(Type, StrictnessMark)]
dcac_co :: DataConAppContext -> KindCoercion
dcac_dc :: DataCon
dcac_tys :: [Type]
dcac_arg_tys :: [(Type, StrictnessMark)]
dcac_co :: KindCoercion
..} = ((Type, StrictnessMark)
 -> (Symbol, RFInfo, RType RTyCon RTyVar r, t))
-> [(Type, StrictnessMark)]
-> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
forall a b. (a -> b) -> [a] -> [b]
map ((Symbol
dummySymbol, RFInfo
defRFInfo, , t
forall r. IsReft r => r
trueReft) (RType RTyCon RTyVar r
 -> (Symbol, RFInfo, RType RTyCon RTyVar r, t))
-> ((Type, StrictnessMark) -> RType RTyCon RTyVar r)
-> (Type, StrictnessMark)
-> (Symbol, RFInfo, RType RTyCon RTyVar r, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> RType RTyCon RTyVar r
forall r. IsReft r => Type -> RRType r
ofType (Type -> RType RTyCon RTyVar r)
-> ((Type, StrictnessMark) -> Type)
-> (Type, StrictnessMark)
-> RType RTyCon RTyVar r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, StrictnessMark) -> Type
forall a b. (a, b) -> a
fst) [(Type, StrictnessMark)]
dcac_arg_tys
    menv :: FamInstEnvs
menv = (FamInstEnv
emptyFamInstEnv, FamInstEnv
emptyFamInstEnv)

-- Copied from GHC 9.0.2.
orElse :: Maybe a -> a -> a
orElse :: forall a. Maybe a -> a -> a
orElse = (a -> Maybe a -> a) -> Maybe a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe

-- Copied from GHC 9.0.2.
deepSplitProductType :: FamInstEnvs -> Type -> Maybe DataConAppContext
-- If    deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co)
-- then  dc @ tys (args::arg_tys) :: rep_ty
--       co :: ty ~ rep_ty
-- Why do we return the strictness of the data-con arguments?
-- Answer: see Note [Record evaluated-ness in worker/wrapper]
deepSplitProductType :: FamInstEnvs -> Type -> Maybe DataConAppContext
deepSplitProductType FamInstEnvs
fam_envs Type
ty
  | let Reduction KindCoercion
co Type
ty1 = FamInstEnvs -> Type -> Maybe Reduction
topNormaliseType_maybe FamInstEnvs
fam_envs Type
ty
                    Maybe Reduction -> Reduction -> Reduction
forall a. Maybe a -> a -> a
`orElse` KindCoercion -> Type -> Reduction
Reduction (Type -> KindCoercion
mkRepReflCo Type
ty) Type
ty
  , Just (TyCon
tc, [Type]
tc_args) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty1
  , Just DataCon
con <- TyCon -> Maybe DataCon
tyConSingleDataCon_maybe TyCon
tc
  , let arg_tys :: [Scaled Type]
arg_tys = DataCon -> [Type] -> [Scaled Type]
dataConInstArgTys DataCon
con [Type]
tc_args
        strict_marks :: [StrictnessMark]
strict_marks = DataCon -> [StrictnessMark]
dataConRepStrictness DataCon
con
  = DataConAppContext -> Maybe DataConAppContext
forall a. a -> Maybe a
Just DataConAppContext { dcac_dc :: DataCon
dcac_dc = DataCon
con
                           , dcac_tys :: [Type]
dcac_tys = [Type]
tc_args
                           , dcac_arg_tys :: [(Type, StrictnessMark)]
dcac_arg_tys = [Type] -> [StrictnessMark] -> [(Type, StrictnessMark)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
forall a. Scaled a -> a
irrelevantMult [Scaled Type]
arg_tys) [StrictnessMark]
strict_marks
                           , dcac_co :: KindCoercion
dcac_co = KindCoercion
co }

deepSplitProductType FamInstEnvs
_ Type
_ = Maybe DataConAppContext
forall a. Maybe a
Nothing


-----------------------------------------------------------------------------------------
-- | Binders generated by class predicates, typically for constraining tyvars (e.g. FNum)
-----------------------------------------------------------------------------------------
classBinds :: TCEmb TyCon -> SpecType -> [(Symbol, SortedReft)]
classBinds :: TCEmb TyCon -> SpecType -> [(Symbol, SortedReft)]
classBinds TCEmb TyCon
_ (RApp RTyCon
c [SpecType]
ts [RTProp RTyCon RTyVar RReft]
_ RReft
_)
  | RTyCon -> Bool
forall c. TyConable c => c -> Bool
isFracCls RTyCon
c
  = [(RTyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol RTyVar
a, Sort -> SortedReft
trueSortedReft Sort
FFrac) | (RVar RTyVar
a RReft
_) <- [SpecType]
ts]
  | RTyCon -> Bool
forall c. TyConable c => c -> Bool
isNumCls RTyCon
c
  = [(RTyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol RTyVar
a, Sort -> SortedReft
trueSortedReft Sort
FNum) | (RVar RTyVar
a RReft
_) <- [SpecType]
ts]
classBinds TCEmb TyCon
emb (RApp RTyCon
c [SpecType
_, SpecType
_, RVar RTyVar
a RReft
_, SpecType
t] [RTProp RTyCon RTyVar RReft]
_ RReft
_)
  | RTyCon -> Bool
forall c. TyConable c => c -> Bool
isEqual RTyCon
c
  = [(RTyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol RTyVar
a, TCEmb TyCon -> SpecType -> SortedReft
forall r.
(PPrint r, IsReft r, ReftBind r ~ Symbol, ReftVar r ~ Symbol,
 SubsTy RTyVar (RType RTyCon RTyVar NoReft) r) =>
TCEmb TyCon -> RRType r -> SortedReft
rTypeSortedReft TCEmb TyCon
emb SpecType
t)]
classBinds  TCEmb TyCon
emb ty :: SpecType
ty@(RApp RTyCon
c [SpecType
_, RVar RTyVar
a RReft
_, SpecType
t] [RTProp RTyCon RTyVar RReft]
_ RReft
_)
  | SpecType -> Bool
isEqualityConstr SpecType
ty
  = [(RTyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol RTyVar
a, TCEmb TyCon -> SpecType -> SortedReft
forall r.
(PPrint r, IsReft r, ReftBind r ~ Symbol, ReftVar r ~ Symbol,
 SubsTy RTyVar (RType RTyCon RTyVar NoReft) r) =>
TCEmb TyCon -> RRType r -> SortedReft
rTypeSortedReft TCEmb TyCon
emb SpecType
t)]
  | Bool
otherwise
  = [Char] -> [(Symbol, SortedReft)] -> [(Symbol, SortedReft)]
forall a. PPrint a => [Char] -> a -> a
notracepp ([Char]
"CLASSBINDS-0: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ RTyCon -> [Char]
forall a. PPrint a => a -> [Char]
showpp RTyCon
c) []
classBinds TCEmb TyCon
_ SpecType
t
  = [Char] -> [(Symbol, SortedReft)] -> [(Symbol, SortedReft)]
forall a. PPrint a => [Char] -> a -> a
notracepp ([Char]
"CLASSBINDS-1: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Type, Bool) -> [Char]
forall a. PPrint a => a -> [Char]
showpp (Bool -> SpecType -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
False SpecType
t, SpecType -> Bool
isEqualityConstr SpecType
t)) []

isEqualityConstr :: SpecType -> Bool
isEqualityConstr :: SpecType -> Bool
isEqualityConstr (Bool -> SpecType -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
False -> Type
ty) = Type -> Bool
Ghc.isEqPred Type
ty Bool -> Bool -> Bool
|| Type -> Bool
Ghc.isEqClassPred Type
ty

--------------------------------------------------------------------------------
-- | Termination Predicates ----------------------------------------------------
--------------------------------------------------------------------------------

makeNumEnv :: (Foldable t, TyConable c) => t (RType c b t1) -> [b]
makeNumEnv :: forall (t :: * -> *) c b t1.
(Foldable t, TyConable c) =>
t (RType c b t1) -> [b]
makeNumEnv = (RType c b t1 -> [b]) -> t (RType c b t1) -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RType c b t1 -> [b]
forall {c} {b} {v} {a} {r}. TyConable c => RTypeBV b v c a r -> [a]
go
  where
    go :: RTypeBV b v c a r -> [a]
go (RApp c
c [RTypeBV b v c a r]
ts [RTPropBV b v c a r]
_ r
_) | c -> Bool
forall c. TyConable c => c -> Bool
isNumCls c
c Bool -> Bool -> Bool
|| c -> Bool
forall c. TyConable c => c -> Bool
isFracCls c
c = [ a
a | (RVar a
a r
_) <- [RTypeBV b v c a r]
ts]
    go RTypeBV b v c a r
_ = []

isDecreasing :: S.HashSet TyCon -> [RTyVar] -> SpecType -> Bool
isDecreasing :: HashSet TyCon -> [RTyVar] -> SpecType -> Bool
isDecreasing HashSet TyCon
autoenv  [RTyVar]
_ (RApp RTyCon
c [SpecType]
_ [RTProp RTyCon RTyVar RReft]
_ RReft
_)
  =  Maybe SizeFun -> Bool
forall a. Maybe a -> Bool
isJust (TyConInfo -> Maybe SizeFun
sizeFunction (RTyCon -> TyConInfo
rtc_info RTyCon
c)) -- user specified size or
  Bool -> Bool -> Bool
|| HashSet TyCon -> TyCon -> Bool
isSizeable HashSet TyCon
autoenv TyCon
tc
  where tc :: TyCon
tc = RTyCon -> TyCon
rtc_tc RTyCon
c
isDecreasing HashSet TyCon
_ [RTyVar]
cenv (RVar RTyVar
v RReft
_)
  = RTyVar
v RTyVar -> [RTyVar] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RTyVar]
cenv
isDecreasing HashSet TyCon
_ [RTyVar]
_ SpecType
_
  = Bool
False

makeDecrType :: Symbolic a
             => S.HashSet TyCon
             -> Maybe (a, (Symbol, RType RTyCon t (UReft Reft)))
             -> Either (Symbol, RType RTyCon t (UReft Reft)) String
makeDecrType :: forall a t.
Symbolic a =>
HashSet TyCon
-> Maybe (a, (Symbol, RType RTyCon t RReft))
-> Either (Symbol, RType RTyCon t RReft) [Char]
makeDecrType HashSet TyCon
autoenv (Just (a
v, (Symbol
x, RType RTyCon t RReft
t)))
  = (Symbol, RType RTyCon t RReft)
-> Either (Symbol, RType RTyCon t RReft) [Char]
forall a b. a -> Either a b
Left (Symbol
x, RType RTyCon t RReft
t RType RTyCon t RReft -> RReft -> RType RTyCon t RReft
forall r b v c tv.
Meet r =>
RTypeBV b v c tv r -> r -> RTypeBV b v c tv r
`strengthen` RReft
tr)
  where
    tr :: RReft
tr  = ReftBV Symbol Symbol -> RReft
forall r v. r -> UReftV v r
uTop (ReftBV Symbol Symbol -> RReft) -> ReftBV Symbol Symbol -> RReft
forall a b. (a -> b) -> a -> b
$ (Symbol, Expr) -> ReftBV Symbol Symbol
forall b v. (b, ExprBV b v) -> ReftBV b v
Reft (Symbol
forall {a}. IsString a => a
vv', [Expr] -> Expr
forall b v.
(Ord b, Hashable b, Ord v) =>
ListNE (ExprBV b v) -> ExprBV b v
pOr [Expr
r])
    r :: Expr
r   = (Symbol, Symbol, Symbol -> Expr) -> Expr
forall t. (t, t, t -> Expr) -> Expr
cmpLexRef (Symbol
v', Symbol
forall {a}. IsString a => a
vv', Symbol -> Expr
f)
    v' :: Symbol
v'  = a -> Symbol
forall a. Symbolic a => a -> Symbol
symbol a
v
    f :: Symbol -> Expr
f   = HashSet TyCon -> RType RTyCon t RReft -> Symbol -> Expr
forall t t1. HashSet TyCon -> RType RTyCon t t1 -> Symbol -> Expr
mkDecrFun HashSet TyCon
autoenv RType RTyCon t RReft
t
    vv' :: a
vv' = a
"vvRec"

makeDecrType HashSet TyCon
_ Maybe (a, (Symbol, RType RTyCon t RReft))
_
  = [Char] -> Either (Symbol, RType RTyCon t RReft) [Char]
forall a b. b -> Either a b
Right [Char]
"RefType.makeDecrType called on invalid input"

isSizeable  :: S.HashSet TyCon -> TyCon -> Bool
isSizeable :: HashSet TyCon -> TyCon -> Bool
isSizeable HashSet TyCon
autoenv TyCon
tc = TyCon -> HashSet TyCon -> Bool
forall a. Hashable a => a -> HashSet a -> Bool
S.member TyCon
tc HashSet TyCon
autoenv --   Ghc.isAlgTyCon tc -- && Ghc.isRecursiveTyCon tc

mkDecrFun :: S.HashSet TyCon -> RType RTyCon t t1 -> Symbol -> Expr
mkDecrFun :: forall t t1. HashSet TyCon -> RType RTyCon t t1 -> Symbol -> Expr
mkDecrFun HashSet TyCon
autoenv (RApp RTyCon
c [RTypeBV Symbol Symbol RTyCon t t1]
_ [RTPropBV Symbol Symbol RTyCon t t1]
_ t1
_)
  | Just Symbol -> Expr
f <- SizeFun -> Symbol -> Expr
szFun (SizeFun -> Symbol -> Expr)
-> Maybe SizeFun -> Maybe (Symbol -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyConInfo -> Maybe SizeFun
sizeFunction (RTyCon -> TyConInfo
rtc_info RTyCon
c)
  = Symbol -> Expr
f
  | HashSet TyCon -> TyCon -> Bool
isSizeable HashSet TyCon
autoenv (TyCon -> Bool) -> TyCon -> Bool
forall a b. (a -> b) -> a -> b
$ RTyCon -> TyCon
rtc_tc RTyCon
c
  = \Symbol
v -> Located Symbol -> [Expr] -> Expr
forall v b. Located v -> [ExprBV b v] -> ExprBV b v
F.mkEApp Located Symbol
lenLocSymbol [Symbol -> Expr
forall b v. v -> ExprBV b v
F.EVar Symbol
v]
mkDecrFun HashSet TyCon
_ (RVar t
_ t1
_)
  = Symbol -> Expr
forall b v. v -> ExprBV b v
EVar
mkDecrFun HashSet TyCon
_ RTypeBV Symbol Symbol RTyCon t t1
_
  = Maybe SrcSpan -> [Char] -> Symbol -> Expr
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType.mkDecrFun called on invalid input"

-- | [NOTE]: THIS IS WHERE THE TERMINATION METRIC REFINEMENTS ARE CREATED.
cmpLexRef :: (t, t, t -> Expr) -> Expr
cmpLexRef :: forall t. (t, t, t -> Expr) -> Expr
cmpLexRef (t
v, t
x, t -> Expr
g)
  = [Expr] -> Expr
forall b v.
(Ord b, Hashable b, Ord v) =>
ListNE (ExprBV b v) -> ExprBV b v
pAnd [Brel -> Expr -> Expr -> Expr
forall b v. Brel -> ExprBV b v -> ExprBV b v -> ExprBV b v
PAtom Brel
Lt (t -> Expr
g t
x) (t -> Expr
g t
v), Brel -> Expr -> Expr -> Expr
forall b v. Brel -> ExprBV b v -> ExprBV b v -> ExprBV b v
PAtom Brel
Ge (t -> Expr
g t
x) Expr
forall b v. ExprBV b v
zero]
  where zero :: ExprBV b v
zero = Constant -> ExprBV b v
forall b v. Constant -> ExprBV b v
ECon (Constant -> ExprBV b v) -> Constant -> ExprBV b v
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
I Integer
0

makeLexRefa :: [Located Expr] -> [Located Expr] -> UReft Reft
makeLexRefa :: [Located Expr] -> [Located Expr] -> RReft
makeLexRefa [Located Expr]
es' [Located Expr]
es = ReftBV Symbol Symbol -> RReft
forall r v. r -> UReftV v r
uTop (ReftBV Symbol Symbol -> RReft) -> ReftBV Symbol Symbol -> RReft
forall a b. (a -> b) -> a -> b
$ (Symbol, Expr) -> ReftBV Symbol Symbol
forall b v. (b, ExprBV b v) -> ReftBV b v
Reft (Symbol
forall {a}. IsString a => a
vv', Expr -> Expr -> Expr
forall b v. ExprBV b v -> ExprBV b v -> ExprBV b v
PIff (Symbol -> Expr
forall b v. v -> ExprBV b v
EVar Symbol
forall {a}. IsString a => a
vv') (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
forall b v.
(Ord b, Hashable b, Ord v) =>
ListNE (ExprBV b v) -> ExprBV b v
pOr [Expr]
rs)
  where
    rs :: [Expr]
rs  = [(Expr, Expr)] -> [Expr] -> [Expr] -> [Expr] -> [Expr]
makeLexReft [] [] (Located Expr -> Expr
forall a. Located a -> a
val (Located Expr -> Expr) -> [Located Expr] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located Expr]
es) (Located Expr -> Expr
forall a. Located a -> a
val (Located Expr -> Expr) -> [Located Expr] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located Expr]
es')
    vv' :: a
vv' = a
"vvRec"

makeLexReft :: [(Expr, Expr)] -> [Expr] -> [Expr] -> [Expr] -> [Expr]
makeLexReft :: [(Expr, Expr)] -> [Expr] -> [Expr] -> [Expr] -> [Expr]
makeLexReft [(Expr, Expr)]
_ [Expr]
acc [] []
  = [Expr]
acc
makeLexReft [(Expr, Expr)]
old [Expr]
acc (Expr
e:[Expr]
es) (Expr
e':[Expr]
es')
  = [(Expr, Expr)] -> [Expr] -> [Expr] -> [Expr] -> [Expr]
makeLexReft ((Expr
e,Expr
e')(Expr, Expr) -> [(Expr, Expr)] -> [(Expr, Expr)]
forall a. a -> [a] -> [a]
:[(Expr, Expr)]
old) (Expr
rExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
acc) [Expr]
es [Expr]
es'
  where
    r :: Expr
r    = [Expr] -> Expr
forall b v.
(Ord b, Hashable b, Ord v) =>
ListNE (ExprBV b v) -> ExprBV b v
pAnd ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$   Brel -> Expr -> Expr -> Expr
forall b v. Brel -> ExprBV b v -> ExprBV b v -> ExprBV b v
PAtom Brel
Lt Expr
e' Expr
e
                Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:   Brel -> Expr -> Expr -> Expr
forall b v. Brel -> ExprBV b v -> ExprBV b v -> ExprBV b v
PAtom Brel
Ge Expr
e' Expr
forall b v. ExprBV b v
zero
                Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:  [Brel -> Expr -> Expr -> Expr
forall b v. Brel -> ExprBV b v -> ExprBV b v -> ExprBV b v
PAtom Brel
Eq Expr
o' Expr
o    | (Expr
o,Expr
o') <- [(Expr, Expr)]
old]
                [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Brel -> Expr -> Expr -> Expr
forall b v. Brel -> ExprBV b v -> ExprBV b v -> ExprBV b v
PAtom Brel
Ge Expr
o' Expr
forall b v. ExprBV b v
zero | (Expr
_,Expr
o') <- [(Expr, Expr)]
old]
    zero :: ExprBV b v
zero = Constant -> ExprBV b v
forall b v. Constant -> ExprBV b v
ECon (Constant -> ExprBV b v) -> Constant -> ExprBV b v
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
I Integer
0
makeLexReft [(Expr, Expr)]
_ [Expr]
_ [Expr]
_ [Expr]
_
  = Maybe SrcSpan -> [Char] -> [Expr]
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType.makeLexReft on invalid input"

--------------------------------------------------------------------------------
mkTyConInfo :: TyCon -> VarianceInfo -> VarianceInfo -> Maybe SizeFun -> TyConInfo
mkTyConInfo :: TyCon -> VarianceInfo -> VarianceInfo -> Maybe SizeFun -> TyConInfo
mkTyConInfo TyCon
c VarianceInfo
userTv VarianceInfo
userPv Maybe SizeFun
f = VarianceInfo -> VarianceInfo -> Maybe SizeFun -> TyConInfo
TyConInfo VarianceInfo
tcTv VarianceInfo
userPv Maybe SizeFun
f
  where
    tcTv :: VarianceInfo
tcTv                      = if VarianceInfo -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null VarianceInfo
userTv then VarianceInfo
defTv else VarianceInfo
userTv
    defTv :: VarianceInfo
defTv                     = TyCon -> VarianceInfo
makeTyConVariance TyCon
c


-------------------------------------------------------------------------------
-- | tyVarsPosition t returns the type variables appearing
-- | (in positive positions, in negative positions, in undetermined positions)
-- | undetermined positions are due to type constructors and type application
-------------------------------------------------------------------------------
tyVarsPosition :: RType RTyCon tv r -> Positions tv
tyVarsPosition :: forall tv r. RType RTyCon tv r -> Positions tv
tyVarsPosition = Maybe Bool -> RTypeBV Symbol Symbol RTyCon tv r -> Positions tv
forall {b} {v} {a} {r}.
Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
  where
    go :: Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p (RVar a
t r
_)         = Maybe Bool -> a -> Positions a
forall {a}. Maybe Bool -> a -> Positions a
report Maybe Bool
p a
t
    go Maybe Bool
p (RFun b
_ RFInfo
_ RTypeBV b v RTyCon a r
t1 RTypeBV b v RTyCon a r
t2 r
_) = Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go (Maybe Bool -> Maybe Bool
forall {f :: * -> *}. Functor f => f Bool -> f Bool
flip' Maybe Bool
p) RTypeBV b v RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t2
    go Maybe Bool
p (RAllT RTVUBV b v RTyCon a
_ RTypeBV b v RTyCon a r
t r
_)      = Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t
    go Maybe Bool
p (RAllP PVUBV b v RTyCon a
_ RTypeBV b v RTyCon a r
t)        = Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t
    go Maybe Bool
p (RApp RTyCon
c [RTypeBV b v RTyCon a r]
ts [RTPropBV b v RTyCon a r]
_ r
_)    = [Positions a] -> Positions a
forall a. Monoid a => [a] -> a
mconcat ((Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a)
-> [Maybe Bool] -> [RTypeBV b v RTyCon a r] -> [Positions a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go (Maybe Bool -> Variance -> Maybe Bool
getPosition Maybe Bool
p (Variance -> Maybe Bool) -> VarianceInfo -> [Maybe Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyConInfo -> VarianceInfo
varianceTyArgs (RTyCon -> TyConInfo
rtc_info RTyCon
c)) [RTypeBV b v RTyCon a r]
ts)
    go Maybe Bool
p (RAllE b
_ RTypeBV b v RTyCon a r
t1 RTypeBV b v RTyCon a r
t2)    = Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t2
    go Maybe Bool
p (REx b
_ RTypeBV b v RTyCon a r
t1 RTypeBV b v RTyCon a r
t2)      = Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t2
    go Maybe Bool
_ (RExprArg Located (ExprBV b v)
_)       = Positions a
forall a. Monoid a => a
mempty
    go Maybe Bool
p (RAppTy RTypeBV b v RTyCon a r
t1 RTypeBV b v RTyCon a r
t2 r
_)   = Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t2
    go Maybe Bool
p (RRTy [(b, RTypeBV b v RTyCon a r)]
_ r
_ Oblig
_ RTypeBV b v RTyCon a r
t)     = Maybe Bool -> RTypeBV b v RTyCon a r -> Positions a
go Maybe Bool
p RTypeBV b v RTyCon a r
t
    go Maybe Bool
_ (RHole r
_)          = Positions a
forall a. Monoid a => a
mempty

    getPosition :: Maybe Bool -> Variance -> Maybe Bool
    getPosition :: Maybe Bool -> Variance -> Maybe Bool
getPosition Maybe Bool
b Variance
Contravariant = Bool -> Bool
not (Bool -> Bool) -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
b
    getPosition Maybe Bool
b Variance
_             = Maybe Bool
b

    report :: Maybe Bool -> a -> Positions a
report (Just Bool
True)  a
v = [a] -> [a] -> [a] -> Positions a
forall a. [a] -> [a] -> [a] -> Positions a
Pos [a
v] []  []
    report (Just Bool
False) a
v = [a] -> [a] -> [a] -> Positions a
forall a. [a] -> [a] -> [a] -> Positions a
Pos []  [a
v] []
    report Maybe Bool
Nothing a
v      = [a] -> [a] -> [a] -> Positions a
forall a. [a] -> [a] -> [a] -> Positions a
Pos []  []  [a
v]
    flip' :: f Bool -> f Bool
flip' = (Bool -> Bool) -> f Bool -> f Bool
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not

data Positions a = Pos {forall a. Positions a -> [a]
ppos :: [a], forall a. Positions a -> [a]
pneg :: [a], forall a. Positions a -> [a]
punknown :: [a]}

instance Monoid (Positions a) where
  mempty :: Positions a
mempty = [a] -> [a] -> [a] -> Positions a
forall a. [a] -> [a] -> [a] -> Positions a
Pos [] [] []
instance Semigroup (Positions a) where
  (Pos [a]
x1 [a]
x2 [a]
x3) <> :: Positions a -> Positions a -> Positions a
<> (Pos [a]
y1 [a]
y2 [a]
y3) = [a] -> [a] -> [a] -> Positions a
forall a. [a] -> [a] -> [a] -> Positions a
Pos ([a]
x1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y1) ([a]
x2 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y2) ([a]
x3 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y3)