{-# 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              #-}

{-# 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)
import           Language.Fixpoint.Types.Visitor (mapKVars, 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 :: (TyVar, SpecType) -> (TyVar, SpecType)
strengthenDataConType (TyVar
x, SpecType
t) = (TyVar
x, RTypeRepV Symbol RTyCon RTyVar RReft -> SpecType
forall v c tv r. RTypeRepV v c tv r -> RTypeV v c tv r
fromRTypeRep RTypeRepV 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
$ RTypeRepV Symbol RTyCon RTyVar RReft -> SpecType
forall v c tv r. RTypeRepV v c tv r -> RTypeV v c tv r
ty_res RTypeRepV Symbol RTyCon RTyVar RReft
trep SpecType -> RReft -> SpecType
forall r v c tv.
Reftable r =>
RTypeV v c tv r -> r -> RTypeV v c tv r
`strengthen` Reft -> PredicateV Symbol -> RReft
forall v r. r -> PredicateV v -> UReftV v r
MkUReft (Expr -> Reft
forall a. Expression a => a -> Reft
exprReft Expr
expr') PredicateV Symbol
forall a. Monoid a => a
mempty
    trep :: RTypeRepV Symbol RTyCon RTyVar RReft
trep     = SpecType -> RTypeRepV Symbol RTyCon RTyVar RReft
forall v c tv r. RTypeV v c tv r -> RTypeRepV v c tv r
toRTypeRep SpecType
t
    _msg :: [Char]
_msg     = [Char]
"STRENGTHEN-DATACONTYPE x = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (TyVar, [(Symbol, SpecType)]) -> [Char]
forall a. PPrint a => a -> [Char]
F.showpp (TyVar
x, [Symbol] -> [SpecType] -> [(Symbol, SpecType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
xs [SpecType]
ts)
    ([Symbol]
xs, [SpecType]
ts) = RTypeRepV Symbol RTyCon RTyVar RReft -> ([Symbol], [SpecType])
dataConArgs RTypeRepV Symbol RTyCon RTyVar RReft
trep
    as :: [(RTVar RTyVar (RType RTyCon RTyVar ()), RReft)]
as       = RTypeRepV Symbol RTyCon RTyVar RReft
-> [(RTVar RTyVar (RType RTyCon RTyVar ()), RReft)]
forall v c tv r.
RTypeRepV v c tv r -> [(RTVar tv (RTypeV v c tv ()), r)]
ty_vars  RTypeRepV Symbol RTyCon RTyVar RReft
trep
    x' :: Symbol
x'       = TyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol TyVar
x
    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 ()), RReft)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RTVar RTyVar (RType RTyCon RTyVar ()), RReft)]
as = Symbol -> Expr
forall v. v -> ExprV v
EVar Symbol
x'
          | Bool
otherwise          = LocSymbol -> [Expr] -> Expr
mkEApp (Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc Symbol
x') (Symbol -> Expr
forall v. v -> ExprV 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 :: RTypeRepV Symbol RTyCon RTyVar RReft -> ([Symbol], [SpecType])
dataConArgs RTypeRepV 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}.
(PPrint r, SubsTy RTyVar (RType RTyCon RTyVar ()) r, Reftable r,
 Reftable (RTProp RTyCon RTyVar r)) =>
RRType r -> Bool
isValTy SpecType
t]
  where
    xs :: [Symbol]
xs           = RTypeRepV Symbol RTyCon RTyVar RReft -> [Symbol]
forall v c tv r. RTypeRepV v c tv r -> [Symbol]
ty_binds RTypeRepV Symbol RTyCon RTyVar RReft
trep
    ts :: [SpecType]
ts           = RTypeRepV Symbol RTyCon RTyVar RReft -> [SpecType]
forall v c tv r. RTypeRepV v c tv r -> [RTypeV v c tv r]
ty_args RTypeRepV Symbol RTyCon RTyVar RReft
trep
    isValTy :: RRType r -> Bool
isValTy      = Bool -> Bool
not (Bool -> Bool) -> (RRType r -> Bool) -> RRType r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Bool
Ghc.isEvVarType (Type -> Bool) -> (RRType r -> Type) -> RRType r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RRType 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  = [UsedPVarV v] -> PredicateV v
forall v. [UsedPVarV v] -> PredicateV v
Pr [PVarV v t -> UsedPVarV v
forall v t. PVarV v t -> UsedPVarV v
uPVar PVarV v t
v]

findPVar :: [PVar (RType c tv ())] -> UsedPVar -> PVar (RType c tv ())
findPVar :: forall c tv.
[PVar (RType c tv ())] -> UsedPVar -> PVar (RType c tv ())
findPVar [PVar (RType c tv ())]
ps UsedPVar
upv = Symbol
-> RType c tv ()
-> Symbol
-> [(RType c tv (), Symbol, Expr)]
-> PVar (RType c tv ())
forall v t.
Symbol -> t -> Symbol -> [(t, Symbol, ExprV v)] -> PVarV v t
PV Symbol
name RType c tv ()
ty Symbol
v ((((), Symbol, Expr)
 -> (RType c tv (), Symbol, Expr) -> (RType c tv (), Symbol, Expr))
-> [((), Symbol, Expr)]
-> [(RType c tv (), Symbol, Expr)]
-> [(RType c tv (), Symbol, Expr)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(()
_, Symbol
_, Expr
e) (RType c tv ()
t, Symbol
s, Expr
_) -> (RType c tv ()
t, Symbol
s, Expr
e)) (UsedPVar -> [((), Symbol, Expr)]
forall v t. PVarV v t -> [(t, Symbol, ExprV v)]
pargs UsedPVar
upv) [(RType c tv (), Symbol, Expr)]
args)
  where
    PV Symbol
name RType c tv ()
ty Symbol
v [(RType c tv (), Symbol, Expr)]
args = PVar (RType c tv ())
-> Maybe (PVar (RType c tv ())) -> PVar (RType c tv ())
forall a. a -> Maybe a -> a
fromMaybe (UsedPVar -> PVar (RType c tv ())
forall {a} {a}. PPrint a => a -> a
msg UsedPVar
upv) (Maybe (PVar (RType c tv ())) -> PVar (RType c tv ()))
-> Maybe (PVar (RType c tv ())) -> PVar (RType c tv ())
forall a b. (a -> b) -> a -> b
$ (PVar (RType c tv ()) -> Bool)
-> [PVar (RType c tv ())] -> Maybe (PVar (RType c tv ()))
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 v t. PVarV v t -> Symbol
pname UsedPVar
upv) (Symbol -> Bool)
-> (PVar (RType c tv ()) -> Symbol) -> PVar (RType c tv ()) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVar (RType c tv ()) -> Symbol
forall v t. PVarV v t -> Symbol
pname) [PVar (RType c tv ())]
ps
    msg :: a -> a
msg a
p = Maybe SrcSpan -> [Char] -> a
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing ([Char] -> a) -> [Char] -> a
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)
-> RTypeV Symbol c tv a -> RTypeV Symbol c tv (UReft a)
forall a b.
(a -> b) -> RTypeV Symbol c tv a -> RTypeV 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)
-> RTypeV Symbol c tv (UReft a) -> RTypeV Symbol c tv a
forall a b.
(a -> b) -> RTypeV Symbol c tv a -> RTypeV Symbol c tv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UReft a -> a
forall v r. UReftV v r -> r
ur_reft

uRTypeGen       :: Reftable b => RType c tv a -> RType c tv b
uRTypeGen :: forall b c tv a. Reftable b => RType c tv a -> RType c tv b
uRTypeGen       = (a -> b) -> RTypeV Symbol c tv a -> RTypeV Symbol c tv b
forall a b.
(a -> b) -> RTypeV Symbol c tv a -> RTypeV Symbol c tv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> RTypeV Symbol c tv a -> RTypeV Symbol c tv b)
-> (a -> b) -> RTypeV Symbol c tv a -> RTypeV Symbol c tv b
forall a b. (a -> b) -> a -> b
$ b -> a -> b
forall a b. a -> b -> a
const b
forall a. Monoid a => a
mempty

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

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

uTop            ::  r -> UReftV v r
uTop :: forall r v. r -> UReftV v r
uTop r
r          = r -> PredicateV v -> UReftV v r
forall v r. r -> PredicateV v -> UReftV v r
MkUReft r
r ([UsedPVarV v] -> PredicateV v
forall v. [UsedPVarV v] -> PredicateV v
Pr [])

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


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

instance ( SubsTy tv (RType c tv ()) (RType c tv ())
         , SubsTy tv (RType c tv ()) c
         , OkRT c tv r
         , FreeVar c tv
         , SubsTy tv (RType c tv ()) r
         , SubsTy tv (RType c tv ()) tv
         , SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))
         )
        => Semigroup (RType c tv r)  where
  <> :: RType c tv r -> RType c tv r -> RType c tv r
(<>) = RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType

-- TODO: remove, use only Semigroup?
instance ( SubsTy tv (RType c tv ()) (RType c tv ())
         , SubsTy tv (RType c tv ()) c
         , OkRT c tv r
         , FreeVar c tv
         , SubsTy tv (RType c tv ()) r
         , SubsTy tv (RType c tv ()) tv
         , SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))
         )
        => Monoid (RType c tv r)  where
  mempty :: RType c tv r
mempty  = Maybe SrcSpan -> [Char] -> RType 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 (RType c tv ()) c
         , OkRT c tv r
         , FreeVar c tv
         , SubsTy tv (RType c tv ()) r
         , SubsTy tv (RType c tv ()) (RType c tv ())
         , SubsTy tv (RType c tv ()) tv
         , SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))
         )
         => Semigroup (RTProp c tv r) where
  <> :: RTProp c tv r -> RTProp c tv r -> RTProp c tv r
(<>) (RProp [(Symbol, RType c tv ())]
s1 (RHole r
r1)) (RProp [(Symbol, RType c tv ())]
s2 (RHole r
r2))
    | r -> Bool
forall r. Reftable r => r -> Bool
isTauto r
r1 = [(Symbol, RType c tv ())] -> RType c tv r -> RTProp c tv r
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType c tv ())]
s2 (r -> RType c tv r
forall v c tv r. r -> RTypeV v c tv r
RHole r
r2)
    | r -> Bool
forall r. Reftable r => r -> Bool
isTauto r
r2 = [(Symbol, RType c tv ())] -> RType c tv r -> RTProp c tv r
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType c tv ())]
s1 (r -> RType c tv r
forall v c tv r. r -> RTypeV v c tv r
RHole r
r1)
    | Bool
otherwise  = [(Symbol, RType c tv ())] -> RType c tv r -> RTProp c tv r
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType c tv ())]
s1 (RType c tv r -> RTProp c tv r) -> RType c tv r -> RTProp c tv r
forall a b. (a -> b) -> a -> b
$ r -> RType c tv r
forall v c tv r. r -> RTypeV v c tv r
RHole (r -> RType c tv r) -> r -> RType c tv r
forall a b. (a -> b) -> a -> b
$ r
r1 r -> r -> r
forall r. Reftable r => r -> r -> r
`meet`
                               Subst -> r -> r
forall a. Subable a => Subst -> a -> a
subst ([(Symbol, Expr)] -> Subst
mkSubst ([(Symbol, Expr)] -> Subst) -> [(Symbol, Expr)] -> Subst
forall a b. (a -> b) -> a -> b
$ [Symbol] -> [Expr] -> [(Symbol, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Symbol, RType c tv ()) -> Symbol
forall a b. (a, b) -> a
fst ((Symbol, RType c tv ()) -> Symbol)
-> [(Symbol, RType c tv ())] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv ())]
s2) (Symbol -> Expr
forall v. v -> ExprV v
EVar (Symbol -> Expr)
-> ((Symbol, RType c tv ()) -> Symbol)
-> (Symbol, RType c tv ())
-> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol, RType c tv ()) -> Symbol
forall a b. (a, b) -> a
fst ((Symbol, RType c tv ()) -> Expr)
-> [(Symbol, RType c tv ())] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv ())]
s1)) r
r2

  (<>) (RProp [(Symbol, RType c tv ())]
s1 RType c tv r
t1) (RProp [(Symbol, RType c tv ())]
s2 RType c tv r
t2)
    | RType c tv r -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial RType c tv r
t1 = [(Symbol, RType c tv ())] -> RType c tv r -> RTProp c tv r
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType c tv ())]
s2 RType c tv r
t2
    | RType c tv r -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial RType c tv r
t2 = [(Symbol, RType c tv ())] -> RType c tv r -> RTProp c tv r
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType c tv ())]
s1 RType c tv r
t1
    | Bool
otherwise    = [(Symbol, RType c tv ())] -> RType c tv r -> RTProp c tv r
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType c tv ())]
s1 (RType c tv r -> RTProp c tv r) -> RType c tv r -> RTProp c tv r
forall a b. (a -> b) -> a -> b
$ RType c tv r
t1  RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
RType c tv r -> RType c tv r -> RType c tv r
`strengthenRefType`
                                Subst -> RType c tv r -> RType c tv r
forall a. Subable a => Subst -> a -> a
subst ([(Symbol, Expr)] -> Subst
mkSubst ([(Symbol, Expr)] -> Subst) -> [(Symbol, Expr)] -> Subst
forall a b. (a -> b) -> a -> b
$ [Symbol] -> [Expr] -> [(Symbol, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Symbol, RType c tv ()) -> Symbol
forall a b. (a, b) -> a
fst ((Symbol, RType c tv ()) -> Symbol)
-> [(Symbol, RType c tv ())] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv ())]
s2) (Symbol -> Expr
forall v. v -> ExprV v
EVar (Symbol -> Expr)
-> ((Symbol, RType c tv ()) -> Symbol)
-> (Symbol, RType c tv ())
-> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol, RType c tv ()) -> Symbol
forall a b. (a, b) -> a
fst ((Symbol, RType c tv ()) -> Expr)
-> [(Symbol, RType c tv ())] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv ())]
s1)) RType c tv r
t2

-- TODO: remove and use only Semigroup?
instance ( SubsTy tv (RType c tv ()) c
         , OkRT c tv r
         , FreeVar c tv
         , SubsTy tv (RType c tv ()) r
         , SubsTy tv (RType c tv ()) (RType c tv ())
         , SubsTy tv (RType c tv ()) tv
         , SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))
         )
         => Monoid (RTProp c tv r) where
  mempty :: RTProp c tv r
mempty  = Maybe SrcSpan -> [Char] -> RTProp c tv r
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"mempty: RTProp"
  mappend :: RTProp c tv r -> RTProp c tv r -> RTProp c tv r
mappend = RTProp c tv r -> RTProp c tv r -> RTProp c tv r
forall a. Semigroup a => a -> a -> a
(<>)

{-
NV: The following makes ghc diverge thus dublicating the code
instance ( OkRT c tv r
         , FreeVar c tv
         , SubsTy tv (RType c tv ()) r
         , SubsTy tv (RType c tv ()) (RType c tv ())
         , SubsTy tv (RType c tv ()) c
         , SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))
         , SubsTy tv (RType c tv ()) tv
         ) => Reftable (RTProp c tv r) where
  isTauto (RProp _ (RHole r)) = isTauto r
  isTauto (RProp _ t)         = isTrivial t
  top (RProp _ (RHole _))     = panic Nothing "RefType: Reftable top called on (RProp _ (RHole _))"
  top (RProp xs t)            = RProp xs $ mapReft top t
  ppTy (RProp _ (RHole r)) d  = ppTy r d
  ppTy (RProp _ _) _          = panic Nothing "RefType: Reftable ppTy in RProp"
  toReft                      = panic Nothing "RefType: Reftable toReft"
  params                      = panic Nothing "RefType: Reftable params for Ref"
  bot                         = panic Nothing "RefType: Reftable bot    for Ref"
  ofReft                      = panic Nothing "RefType: Reftable ofReft for Ref"
-}

instance Reftable (RTProp RTyCon RTyVar (UReft Reft)) where
  isTauto :: RTProp RTyCon RTyVar RReft -> Bool
isTauto (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole RReft
r)) = RReft -> Bool
forall r. Reftable r => r -> Bool
isTauto RReft
r
  isTauto (RProp [(Symbol, RType RTyCon RTyVar ())]
_ SpecType
t)         = SpecType -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial SpecType
t
  top :: RTProp RTyCon RTyVar RReft -> RTProp RTyCon RTyVar RReft
top (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole RReft
_))     = Maybe SrcSpan -> [Char] -> RTProp RTyCon RTyVar RReft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable top called on (RProp _ (RHole _))"
  top (RProp [(Symbol, RType RTyCon RTyVar ())]
xs SpecType
t)            = [(Symbol, RType RTyCon RTyVar ())]
-> SpecType -> RTProp RTyCon RTyVar RReft
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType RTyCon RTyVar ())]
xs (SpecType -> RTProp RTyCon RTyVar RReft)
-> SpecType -> RTProp RTyCon RTyVar RReft
forall a b. (a -> b) -> a -> b
$ (RReft -> RReft) -> SpecType -> SpecType
forall r1 r2 v c tv.
(r1 -> r2) -> RTypeV v c tv r1 -> RTypeV v c tv r2
mapReft RReft -> RReft
forall r. Reftable r => r -> r
top SpecType
t
  ppTy :: RTProp RTyCon RTyVar RReft -> Doc -> Doc
ppTy (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole RReft
r)) Doc
d  = RReft -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy RReft
r Doc
d
  ppTy (RProp [(Symbol, RType RTyCon RTyVar ())]
_ SpecType
_) Doc
_          = Maybe SrcSpan -> [Char] -> Doc
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp RTyCon RTyVar RReft -> Reft
toReft                      = Maybe SrcSpan -> [Char] -> RTProp RTyCon RTyVar RReft -> Reft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable toReft"
  ofReft :: Reft -> RTProp RTyCon RTyVar RReft
ofReft                      = Maybe SrcSpan -> [Char] -> Reft -> RTProp RTyCon RTyVar RReft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ofReft for Ref"

instance Reftable (RTProp RTyCon RTyVar ()) where
  isTauto :: RTProp RTyCon RTyVar () -> Bool
isTauto (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole ()
r)) = () -> Bool
forall r. Reftable r => r -> Bool
isTauto ()
r
  isTauto (RProp [(Symbol, RType RTyCon RTyVar ())]
_ RType RTyCon RTyVar ()
t)         = RType RTyCon RTyVar () -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial RType RTyCon RTyVar ()
t
  top :: RTProp RTyCon RTyVar () -> RTProp RTyCon RTyVar ()
top (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole ()
_))     = Maybe SrcSpan -> [Char] -> RTProp RTyCon RTyVar ()
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable top called on (RProp _ (RHole _))"
  top (RProp [(Symbol, RType RTyCon RTyVar ())]
xs RType RTyCon RTyVar ()
t)            = [(Symbol, RType RTyCon RTyVar ())]
-> RType RTyCon RTyVar () -> RTProp RTyCon RTyVar ()
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType RTyCon RTyVar ())]
xs (RType RTyCon RTyVar () -> RTProp RTyCon RTyVar ())
-> RType RTyCon RTyVar () -> RTProp RTyCon RTyVar ()
forall a b. (a -> b) -> a -> b
$ (() -> ()) -> RType RTyCon RTyVar () -> RType RTyCon RTyVar ()
forall r1 r2 v c tv.
(r1 -> r2) -> RTypeV v c tv r1 -> RTypeV v c tv r2
mapReft () -> ()
forall r. Reftable r => r -> r
top RType RTyCon RTyVar ()
t
  ppTy :: RTProp RTyCon RTyVar () -> Doc -> Doc
ppTy (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole ()
r)) Doc
d  = () -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy ()
r Doc
d
  ppTy (RProp [(Symbol, RType RTyCon RTyVar ())]
_ RType RTyCon RTyVar ()
_) Doc
_          = Maybe SrcSpan -> [Char] -> Doc
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp RTyCon RTyVar () -> Reft
toReft                      = Maybe SrcSpan -> [Char] -> RTProp RTyCon RTyVar () -> Reft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable toReft"
  ofReft :: Reft -> RTProp RTyCon RTyVar ()
ofReft                      = Maybe SrcSpan -> [Char] -> Reft -> RTProp RTyCon RTyVar ()
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ofReft for Ref"

instance Reftable (RTProp BTyCon BTyVar (UReft Reft)) where
  isTauto :: RTProp BTyCon BTyVar RReft -> Bool
isTauto (RProp [(Symbol, RType BTyCon BTyVar ())]
_ (RHole RReft
r)) = RReft -> Bool
forall r. Reftable r => r -> Bool
isTauto RReft
r
  isTauto (RProp [(Symbol, RType BTyCon BTyVar ())]
_ RTypeV Symbol BTyCon BTyVar RReft
t)         = RTypeV Symbol BTyCon BTyVar RReft -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial RTypeV Symbol BTyCon BTyVar RReft
t
  top :: RTProp BTyCon BTyVar RReft -> RTProp BTyCon BTyVar RReft
top (RProp [(Symbol, RType BTyCon BTyVar ())]
_ (RHole RReft
_))     = Maybe SrcSpan -> [Char] -> RTProp BTyCon BTyVar RReft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable top called on (RProp _ (RHole _))"
  top (RProp [(Symbol, RType BTyCon BTyVar ())]
xs RTypeV Symbol BTyCon BTyVar RReft
t)            = [(Symbol, RType BTyCon BTyVar ())]
-> RTypeV Symbol BTyCon BTyVar RReft -> RTProp BTyCon BTyVar RReft
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType BTyCon BTyVar ())]
xs (RTypeV Symbol BTyCon BTyVar RReft -> RTProp BTyCon BTyVar RReft)
-> RTypeV Symbol BTyCon BTyVar RReft -> RTProp BTyCon BTyVar RReft
forall a b. (a -> b) -> a -> b
$ (RReft -> RReft)
-> RTypeV Symbol BTyCon BTyVar RReft
-> RTypeV Symbol BTyCon BTyVar RReft
forall r1 r2 v c tv.
(r1 -> r2) -> RTypeV v c tv r1 -> RTypeV v c tv r2
mapReft RReft -> RReft
forall r. Reftable r => r -> r
top RTypeV Symbol BTyCon BTyVar RReft
t
  ppTy :: RTProp BTyCon BTyVar RReft -> Doc -> Doc
ppTy (RProp [(Symbol, RType BTyCon BTyVar ())]
_ (RHole RReft
r)) Doc
d  = RReft -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy RReft
r Doc
d
  ppTy (RProp [(Symbol, RType BTyCon BTyVar ())]
_ RTypeV Symbol BTyCon BTyVar RReft
_) Doc
_          = Maybe SrcSpan -> [Char] -> Doc
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp BTyCon BTyVar RReft -> Reft
toReft                      = Maybe SrcSpan -> [Char] -> RTProp BTyCon BTyVar RReft -> Reft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable toReft"
  ofReft :: Reft -> RTProp BTyCon BTyVar RReft
ofReft                      = Maybe SrcSpan -> [Char] -> Reft -> RTProp BTyCon BTyVar RReft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ofReft for Ref"

instance Reftable (RTProp BTyCon BTyVar ())  where
  isTauto :: RTProp BTyCon BTyVar () -> Bool
isTauto (RProp [(Symbol, RType BTyCon BTyVar ())]
_ (RHole ()
r)) = () -> Bool
forall r. Reftable r => r -> Bool
isTauto ()
r
  isTauto (RProp [(Symbol, RType BTyCon BTyVar ())]
_ RType BTyCon BTyVar ()
t)         = RType BTyCon BTyVar () -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial RType BTyCon BTyVar ()
t
  top :: RTProp BTyCon BTyVar () -> RTProp BTyCon BTyVar ()
top (RProp [(Symbol, RType BTyCon BTyVar ())]
_ (RHole ()
_))     = Maybe SrcSpan -> [Char] -> RTProp BTyCon BTyVar ()
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable top called on (RProp _ (RHole _))"
  top (RProp [(Symbol, RType BTyCon BTyVar ())]
xs RType BTyCon BTyVar ()
t)            = [(Symbol, RType BTyCon BTyVar ())]
-> RType BTyCon BTyVar () -> RTProp BTyCon BTyVar ()
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType BTyCon BTyVar ())]
xs (RType BTyCon BTyVar () -> RTProp BTyCon BTyVar ())
-> RType BTyCon BTyVar () -> RTProp BTyCon BTyVar ()
forall a b. (a -> b) -> a -> b
$ (() -> ()) -> RType BTyCon BTyVar () -> RType BTyCon BTyVar ()
forall r1 r2 v c tv.
(r1 -> r2) -> RTypeV v c tv r1 -> RTypeV v c tv r2
mapReft () -> ()
forall r. Reftable r => r -> r
top RType BTyCon BTyVar ()
t
  ppTy :: RTProp BTyCon BTyVar () -> Doc -> Doc
ppTy (RProp [(Symbol, RType BTyCon BTyVar ())]
_ (RHole ()
r)) Doc
d  = () -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy ()
r Doc
d
  ppTy (RProp [(Symbol, RType BTyCon BTyVar ())]
_ RType BTyCon BTyVar ()
_) Doc
_          = Maybe SrcSpan -> [Char] -> Doc
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp BTyCon BTyVar () -> Reft
toReft                      = Maybe SrcSpan -> [Char] -> RTProp BTyCon BTyVar () -> Reft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable toReft"
  ofReft :: Reft -> RTProp BTyCon BTyVar ()
ofReft                      = Maybe SrcSpan -> [Char] -> Reft -> RTProp BTyCon BTyVar ()
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ofReft for Ref"

instance Reftable (RTProp RTyCon RTyVar Reft) where
  isTauto :: RTProp RTyCon RTyVar Reft -> Bool
isTauto (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole Reft
r)) = Reft -> Bool
forall r. Reftable r => r -> Bool
isTauto Reft
r
  isTauto (RProp [(Symbol, RType RTyCon RTyVar ())]
_ RTypeV Symbol RTyCon RTyVar Reft
t)         = RTypeV Symbol RTyCon RTyVar Reft -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial RTypeV Symbol RTyCon RTyVar Reft
t
  top :: RTProp RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
top (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole Reft
_))     = Maybe SrcSpan -> [Char] -> RTProp RTyCon RTyVar Reft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable top called on (RProp _ (RHole _))"
  top (RProp [(Symbol, RType RTyCon RTyVar ())]
xs RTypeV Symbol RTyCon RTyVar Reft
t)            = [(Symbol, RType RTyCon RTyVar ())]
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType RTyCon RTyVar ())]
xs (RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ (Reft -> Reft)
-> RTypeV Symbol RTyCon RTyVar Reft
-> RTypeV Symbol RTyCon RTyVar Reft
forall r1 r2 v c tv.
(r1 -> r2) -> RTypeV v c tv r1 -> RTypeV v c tv r2
mapReft Reft -> Reft
forall r. Reftable r => r -> r
top RTypeV Symbol RTyCon RTyVar Reft
t
  ppTy :: RTProp RTyCon RTyVar Reft -> Doc -> Doc
ppTy (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole Reft
r)) Doc
d  = Reft -> Doc -> Doc
forall r. Reftable r => r -> Doc -> Doc
ppTy Reft
r Doc
d
  ppTy (RProp [(Symbol, RType RTyCon RTyVar ())]
_ RTypeV Symbol RTyCon RTyVar Reft
_) Doc
_          = Maybe SrcSpan -> [Char] -> Doc
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp RTyCon RTyVar Reft -> Reft
toReft                      = Maybe SrcSpan -> [Char] -> RTProp RTyCon RTyVar Reft -> Reft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable toReft"
  ofReft :: Reft -> RTProp RTyCon RTyVar Reft
ofReft                      = Maybe SrcSpan -> [Char] -> Reft -> RTProp RTyCon RTyVar Reft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"RefType: Reftable ofReft for Ref"

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

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


  subst :: Subst -> RTProp RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
subst Subst
su (RProp [(Symbol, RType RTyCon RTyVar ())]
ss (RHole Reft
r)) = [(Symbol, RType RTyCon RTyVar ())]
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp ((RType RTyCon RTyVar () -> RType RTyCon RTyVar ())
-> (Symbol, RType RTyCon RTyVar ())
-> (Symbol, RType RTyCon RTyVar ())
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Subst -> RType RTyCon RTyVar () -> RType RTyCon RTyVar ()
forall a. Subable a => Subst -> a -> a
subst Subst
su) ((Symbol, RType RTyCon RTyVar ())
 -> (Symbol, RType RTyCon RTyVar ()))
-> [(Symbol, RType RTyCon RTyVar ())]
-> [(Symbol, RType RTyCon RTyVar ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar ())]
ss) (RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ Reft -> RTypeV Symbol RTyCon RTyVar Reft
forall v c tv r. r -> RTypeV v c tv r
RHole (Reft -> RTypeV Symbol RTyCon RTyVar Reft)
-> Reft -> RTypeV Symbol RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ Subst -> Reft -> Reft
forall a. Subable a => Subst -> a -> a
subst Subst
su Reft
r
  subst Subst
su (RProp [(Symbol, RType RTyCon RTyVar ())]
ss RTypeV Symbol RTyCon RTyVar Reft
r)  = [(Symbol, RType RTyCon RTyVar ())]
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp  ((RType RTyCon RTyVar () -> RType RTyCon RTyVar ())
-> (Symbol, RType RTyCon RTyVar ())
-> (Symbol, RType RTyCon RTyVar ())
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Subst -> RType RTyCon RTyVar () -> RType RTyCon RTyVar ()
forall a. Subable a => Subst -> a -> a
subst Subst
su) ((Symbol, RType RTyCon RTyVar ())
 -> (Symbol, RType RTyCon RTyVar ()))
-> [(Symbol, RType RTyCon RTyVar ())]
-> [(Symbol, RType RTyCon RTyVar ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar ())]
ss) (RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ Subst
-> RTypeV Symbol RTyCon RTyVar Reft
-> RTypeV Symbol RTyCon RTyVar Reft
forall a. Subable a => Subst -> a -> a
subst Subst
su RTypeV Symbol RTyCon RTyVar Reft
r


  substf :: (Symbol -> Expr)
-> RTProp RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
substf Symbol -> Expr
f (RProp [(Symbol, RType RTyCon RTyVar ())]
ss (RHole Reft
r)) = [(Symbol, RType RTyCon RTyVar ())]
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp ((RType RTyCon RTyVar () -> RType RTyCon RTyVar ())
-> (Symbol, RType RTyCon RTyVar ())
-> (Symbol, RType RTyCon RTyVar ())
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Symbol -> Expr)
-> RType RTyCon RTyVar () -> RType RTyCon RTyVar ()
forall a. Subable a => (Symbol -> Expr) -> a -> a
substf Symbol -> Expr
f) ((Symbol, RType RTyCon RTyVar ())
 -> (Symbol, RType RTyCon RTyVar ()))
-> [(Symbol, RType RTyCon RTyVar ())]
-> [(Symbol, RType RTyCon RTyVar ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar ())]
ss) (RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ Reft -> RTypeV Symbol RTyCon RTyVar Reft
forall v c tv r. r -> RTypeV v c tv r
RHole (Reft -> RTypeV Symbol RTyCon RTyVar Reft)
-> Reft -> RTypeV Symbol RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ (Symbol -> Expr) -> Reft -> Reft
forall a. Subable a => (Symbol -> Expr) -> a -> a
substf Symbol -> Expr
f Reft
r
  substf Symbol -> Expr
f (RProp [(Symbol, RType RTyCon RTyVar ())]
ss RTypeV Symbol RTyCon RTyVar Reft
r) = [(Symbol, RType RTyCon RTyVar ())]
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp  ((RType RTyCon RTyVar () -> RType RTyCon RTyVar ())
-> (Symbol, RType RTyCon RTyVar ())
-> (Symbol, RType RTyCon RTyVar ())
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Symbol -> Expr)
-> RType RTyCon RTyVar () -> RType RTyCon RTyVar ()
forall a. Subable a => (Symbol -> Expr) -> a -> a
substf Symbol -> Expr
f) ((Symbol, RType RTyCon RTyVar ())
 -> (Symbol, RType RTyCon RTyVar ()))
-> [(Symbol, RType RTyCon RTyVar ())]
-> [(Symbol, RType RTyCon RTyVar ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType RTyCon RTyVar ())]
ss) (RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RTypeV Symbol RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ (Symbol -> Expr)
-> RTypeV Symbol RTyCon RTyVar Reft
-> RTypeV Symbol RTyCon RTyVar Reft
forall a. Subable a => (Symbol -> Expr) -> a -> a
substf Symbol -> Expr
f RTypeV Symbol RTyCon RTyVar Reft
r

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


-------------------------------------------------------------------------------
-- | Reftable Instances -------------------------------------------------------
-------------------------------------------------------------------------------

instance (PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r, Reftable (RTProp RTyCon RTyVar r))
    => Reftable (RType RTyCon RTyVar r) where
  isTauto :: RType RTyCon RTyVar r -> Bool
isTauto     = RType RTyCon RTyVar r -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial
  ppTy :: RType RTyCon RTyVar r -> Doc -> Doc
ppTy        = Maybe SrcSpan -> [Char] -> RType RTyCon RTyVar r -> Doc -> Doc
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"ppTy RProp Reftable"
  toReft :: RType RTyCon RTyVar r -> Reft
toReft      = Maybe SrcSpan -> [Char] -> RType RTyCon RTyVar r -> Reft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"toReft on RType"
  ofReft :: Reft -> RType RTyCon RTyVar r
ofReft      = Maybe SrcSpan -> [Char] -> Reft -> RType RTyCon RTyVar r
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"ofReft on RType"


instance Reftable (RType BTyCon BTyVar (UReft Reft)) where
  isTauto :: RTypeV Symbol BTyCon BTyVar RReft -> Bool
isTauto     = RTypeV Symbol BTyCon BTyVar RReft -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial
  top :: RTypeV Symbol BTyCon BTyVar RReft
-> RTypeV Symbol BTyCon BTyVar RReft
top RTypeV Symbol BTyCon BTyVar RReft
t       = (RReft -> RReft)
-> RTypeV Symbol BTyCon BTyVar RReft
-> RTypeV Symbol BTyCon BTyVar RReft
forall r1 r2 v c tv.
(r1 -> r2) -> RTypeV v c tv r1 -> RTypeV v c tv r2
mapReft RReft -> RReft
forall r. Reftable r => r -> r
top RTypeV Symbol BTyCon BTyVar RReft
t
  ppTy :: RTypeV Symbol BTyCon BTyVar RReft -> Doc -> Doc
ppTy        = Maybe SrcSpan
-> [Char] -> RTypeV Symbol BTyCon BTyVar RReft -> Doc -> Doc
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"ppTy RProp Reftable"
  toReft :: RTypeV Symbol BTyCon BTyVar RReft -> Reft
toReft      = Maybe SrcSpan
-> [Char] -> RTypeV Symbol BTyCon BTyVar RReft -> Reft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"toReft on RType"
  ofReft :: Reft -> RTypeV Symbol BTyCon BTyVar RReft
ofReft      = Maybe SrcSpan
-> [Char] -> Reft -> RTypeV Symbol BTyCon BTyVar RReft
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing [Char]
"ofReft on RType"



-- 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 = (TyVar -> RTyVar
RTV (TyVar -> RTyVar) -> [TyVar] -> [RTyVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([TyVar] -> [RTyVar]) -> (RTyCon -> [TyVar]) -> RTyCon -> [RTyVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> [TyVar]
GM.tyConTyVarsDef (TyCon -> [TyVar]) -> (RTyCon -> TyCon) -> RTyCon -> [TyVar]
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, Reftable (RTProp c tv ()))
      => Eq (RType c tv ()) where
  == :: RType c tv () -> RType c tv () -> Bool
(==) = HashMap tv tv -> RType c tv () -> RType c tv () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> 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, Reftable (RTProp a k ()))
        => M.HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort :: forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m (RAllP PVUV Symbol a k
_ RTypeV Symbol a k ()
t) (RAllP PVUV Symbol a k
_ RTypeV Symbol a k ()
t')
  = HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m RTypeV Symbol a k ()
t RTypeV Symbol a k ()
t'
eqRSort HashMap k k
m (RAllP PVUV Symbol a k
_ RTypeV Symbol a k ()
t) RTypeV Symbol a k ()
t'
  = HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m RTypeV Symbol a k ()
t RTypeV Symbol a k ()
t'
eqRSort HashMap k k
m (RAllT RTVUV Symbol a k
a RTypeV Symbol a k ()
t ()
_) (RAllT RTVUV Symbol a k
a' RTypeV Symbol a k ()
t' ()
_)
  | RTVUV Symbol a k
a RTVUV Symbol a k -> RTVUV Symbol a k -> Bool
forall a. Eq a => a -> a -> Bool
== RTVUV Symbol a k
a'
  = HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m RTypeV Symbol a k ()
t RTypeV Symbol a k ()
t'
  | Bool
otherwise
  = HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort (k -> k -> HashMap k k -> HashMap k k
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert (RTVUV Symbol a k -> k
forall tv s. RTVar tv s -> tv
ty_var_value RTVUV Symbol a k
a') (RTVUV Symbol a k -> k
forall tv s. RTVar tv s -> tv
ty_var_value RTVUV Symbol a k
a) HashMap k k
m) RTypeV Symbol a k ()
t RTypeV Symbol a k ()
t'
eqRSort HashMap k k
m (RAllT RTVUV Symbol a k
_ RTypeV Symbol a k ()
t ()
_) RTypeV Symbol a k ()
t'
  = HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m RTypeV Symbol a k ()
t RTypeV Symbol a k ()
t'
eqRSort HashMap k k
m RTypeV Symbol a k ()
t (RAllT RTVUV Symbol a k
_ RTypeV Symbol a k ()
t' ()
_)
  = HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m RTypeV Symbol a k ()
t RTypeV Symbol a k ()
t'
eqRSort HashMap k k
m (RFun Symbol
_ RFInfo
_ RTypeV Symbol a k ()
t1 RTypeV Symbol a k ()
t2 ()
_) (RFun Symbol
_ RFInfo
_ RTypeV Symbol a k ()
t1' RTypeV Symbol a k ()
t2' ()
_)
  = HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m RTypeV Symbol a k ()
t1 RTypeV Symbol a k ()
t1' Bool -> Bool -> Bool
&& HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m RTypeV Symbol a k ()
t2 RTypeV Symbol a k ()
t2'
eqRSort HashMap k k
m (RAppTy RTypeV Symbol a k ()
t1 RTypeV Symbol a k ()
t2 ()
_) (RAppTy RTypeV Symbol a k ()
t1' RTypeV Symbol a k ()
t2' ()
_)
  = HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m RTypeV Symbol a k ()
t1 RTypeV Symbol a k ()
t1' Bool -> Bool -> Bool
&& HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m RTypeV Symbol a k ()
t2 RTypeV Symbol a k ()
t2'
eqRSort HashMap k k
m (RApp a
c [RTypeV Symbol a k ()]
ts [RTProp a k ()]
_ ()
_) (RApp a
c' [RTypeV Symbol a k ()]
ts' [RTProp a k ()]
_ ()
_)
  = a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c' Bool -> Bool -> Bool
&& [RTypeV Symbol a k ()] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [RTypeV Symbol a k ()]
ts Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== [RTypeV Symbol a k ()] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [RTypeV Symbol a k ()]
ts' Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool)
-> [RTypeV Symbol a k ()] -> [RTypeV Symbol a k ()] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (HashMap k k -> RTypeV Symbol a k () -> RTypeV Symbol a k () -> Bool
forall a k.
(Eq a, Eq k, Hashable k, TyConable a, PPrint a, PPrint k,
 Reftable (RTProp a k ())) =>
HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m) [RTypeV Symbol a k ()]
ts [RTypeV Symbol a k ()]
ts')
eqRSort HashMap k k
m (RVar k
a ()
_) (RVar k
a' ()
_)
  = k
a k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k -> k -> HashMap k k -> k
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault k
a' k
a' HashMap k k
m
eqRSort HashMap k k
_ (RHole ()
_) RTypeV Symbol a k ()
_
  = Bool
True
eqRSort HashMap k k
_ RTypeV Symbol a k ()
_         (RHole ()
_)
  = Bool
True
eqRSort HashMap k k
_ RTypeV Symbol a k ()
_ RTypeV Symbol a k ()
_
  = 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 TyVar
α == :: RTyVar -> RTyVar -> Bool
== RTV TyVar
α' = TyVar
α TyVar -> TyVar -> Bool
forall a. Eq a => a -> a -> Bool
== TyVar
α' Bool -> Bool -> Bool
&& TyVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyVar
α OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== TyVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyVar
α'

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

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

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

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

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

rVar :: Monoid r => TyVar -> RType c RTyVar r
rVar :: forall r c. Monoid r => TyVar -> RType c RTyVar r
rVar   = (RTyVar -> r -> RTypeV Symbol c RTyVar r
forall v c tv r. tv -> r -> RTypeV v c tv r
`RVar` r
forall a. Monoid a => a
mempty) (RTyVar -> RTypeV Symbol c RTyVar r)
-> (TyVar -> RTyVar) -> TyVar -> RTypeV Symbol c RTyVar r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> RTyVar
RTV

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

updateRTVar :: Monoid r => RTVar RTyVar i -> RTVar RTyVar (RType RTyCon RTyVar r)
updateRTVar :: forall r i.
Monoid r =>
RTVar RTyVar i -> RTVar RTyVar (RType RTyCon RTyVar r)
updateRTVar (RTVar (RTV TyVar
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 (TyVar -> RTyVar
RTV TyVar
a) (TyVar -> RTVInfo (RType RTyCon RTyVar r)
forall r. Monoid r => TyVar -> RTVInfo (RRType r)
rTVarInfo TyVar
a)

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

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

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

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

mkTVarInfo :: (Kind -> s) -> TyVar -> RTVInfo s
mkTVarInfo :: forall s. (Type -> s) -> TyVar -> RTVInfo s
mkTVarInfo Type -> s
k2t TyVar
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
$ TyVar -> Name
varName TyVar
a
  , rtv_kind :: s
rtv_kind   = Type -> s
k2t       (Type -> s) -> Type -> s
forall a b. (a -> b) -> a -> b
$ TyVar -> Type
tyVarKind TyVar
a
  , rtv_is_val :: Bool
rtv_is_val = Type -> Bool
isValKind (Type -> Bool) -> Type -> Bool
forall a b. (a -> b) -> a -> b
$ TyVar -> Type
tyVarKind TyVar
a
  , rtv_is_pol :: Bool
rtv_is_pol = Bool
True
  }

kindToRType :: Monoid r => Type -> RRType r
kindToRType :: forall r. Monoid r => Type -> RRType r
kindToRType = (Type -> RRType r) -> Type -> RRType r
forall z. (Type -> z) -> Type -> z
kindToRType_ Type -> RRType r
forall r. Monoid r => Type -> RRType r
ofType

kindToBRType :: Monoid r => Type -> BRType r
kindToBRType :: forall r. Monoid r => Type -> BRType r
kindToBRType = (Type -> BRType r) -> Type -> BRType r
forall z. (Type -> z) -> Type -> z
kindToRType_ Type -> BRType r
forall r. Monoid 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 :: LocSymbol -> BTyVar
bTyVar      = LocSymbol -> BTyVar
BTV

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

bareRTyVar :: BTyVar -> RTyVar
bareRTyVar :: BTyVar -> RTyVar
bareRTyVar (BTV LocSymbol
tv) = Symbol -> RTyVar
symbolRTyVar (Symbol -> RTyVar) -> Symbol -> RTyVar
forall a b. (a -> b) -> a -> b
$ LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
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 ())] -> RType c tv r -> RType c tv r
forall (t :: * -> *) c tv r.
Foldable t =>
t (PVar (RType c tv ())) -> RType c tv r -> RType c tv r
addPds [PVar (RType c tv ())]
ps RType c tv r
t'
  where
    (RType c tv r
t', [PVar (RType c tv ())]
ps)   = [PVar (RType c tv ())]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv ())])
forall c tv r.
OkRT c tv r =>
[PVar (RType c tv ())]
-> RType c tv r -> (RType c tv r, [PVar (RType c tv ())])
nlzP [] RType c tv r
t

rPred :: PVar (RType c tv ()) -> RType c tv r -> RType c tv r
rPred :: forall c tv r. PVar (RType c tv ()) -> RType c tv r -> RType c tv r
rPred     = PVUV Symbol c tv -> RTypeV Symbol c tv r -> RTypeV Symbol c tv r
forall v c tv r. PVUV v c tv -> RTypeV v c tv r -> RTypeV 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 v c tv r.
Symbol -> RTypeV v c tv r -> RTypeV v c tv r -> RTypeV 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
-> [RTypeV Symbol RTyCon tv r]
-> [RTPropV Symbol RTyCon tv r]
-> r
-> RTypeV Symbol RTyCon tv r
forall v c tv r.
c
-> [RTypeV v c tv r] -> [RTPropV v c tv r] -> r -> RTypeV 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
                  [TyVar -> SpecType
forall r c. Monoid r => TyVar -> RType c RTyVar r
rVar TyVar
α | RTV TyVar
α <- [RTyVar]
αs]
                  ([(Symbol, RType RTyCon RTyVar ())]
-> RReft -> RTProp RTyCon RTyVar RReft
forall τ r v c tv. [(Symbol, τ)] -> r -> Ref τ (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 = (\PredicateV Symbol
p -> Reft -> PredicateV Symbol -> RReft
forall v r. r -> PredicateV v -> UReftV v r
MkUReft Reft
forall a. Monoid a => a
mempty PredicateV Symbol
p) (PredicateV Symbol -> RReft)
-> (PVar t -> PredicateV Symbol) -> PVar t -> RReft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVar t -> PredicateV 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
-> [RTypeV Symbol BTyCon BTyVar r]
-> [RTPropV Symbol BTyCon BTyVar r]
-> r
-> RTypeV Symbol BTyCon BTyVar r
forall v c tv r.
c
-> [RTypeV v c tv r] -> [RTPropV v c tv r] -> r -> RTypeV 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 ())) -> RType c tv r -> RType c tv r
addPds :: forall (t :: * -> *) c tv r.
Foldable t =>
t (PVar (RType c tv ())) -> RType c tv r -> RType c tv r
addPds t (PVar (RType c tv ()))
ps (RAllT RTVUV Symbol c tv
v RTypeV Symbol c tv r
t r
r) = RTVUV Symbol c tv
-> RTypeV Symbol c tv r -> r -> RTypeV Symbol c tv r
forall v c tv r.
RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAllT RTVUV Symbol c tv
v (t (PVar (RType c tv ()))
-> RTypeV Symbol c tv r -> RTypeV Symbol c tv r
forall (t :: * -> *) c tv r.
Foldable t =>
t (PVar (RType c tv ())) -> RType c tv r -> RType c tv r
addPds t (PVar (RType c tv ()))
ps RTypeV Symbol c tv r
t) r
r
addPds t (PVar (RType c tv ()))
ps RTypeV Symbol c tv r
t             = (RTypeV Symbol c tv r
 -> PVar (RType c tv ()) -> RTypeV Symbol c tv r)
-> RTypeV Symbol c tv r
-> t (PVar (RType c tv ()))
-> RTypeV 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 ())
 -> RTypeV Symbol c tv r -> RTypeV Symbol c tv r)
-> RTypeV Symbol c tv r
-> PVar (RType c tv ())
-> RTypeV Symbol c tv r
forall a b c. (a -> b -> c) -> b -> a -> c
flip PVar (RType c tv ())
-> RTypeV Symbol c tv r -> RTypeV Symbol c tv r
forall c tv r. PVar (RType c tv ()) -> RType c tv r -> RType c tv r
rPred) RTypeV Symbol c tv r
t t (PVar (RType c tv ()))
ps

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

strengthenRefTypeGen, strengthenRefType ::
         (  OkRT c tv r
         , FreeVar c tv
         , SubsTy tv (RType c tv ()) (RType c tv ())
         , SubsTy tv (RType c tv ()) c
         , SubsTy tv (RType c tv ()) r
         , SubsTy tv (RType c tv ()) tv
         , SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))
         ) => RType c tv r -> RType c tv r -> RType c tv r

strengthenRefType_ ::
         ( OkRT c tv r
         , FreeVar c tv
         , SubsTy tv (RType c tv ()) (RType c tv ())
         , SubsTy tv (RType c tv ()) c
         , SubsTy tv (RType c tv ()) r
         , SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))
         , SubsTy tv (RType c tv ()) tv
         ) => (RType c tv r -> RType c tv r -> RType c tv r)
           ->  RType c tv r -> RType c tv r -> RType c tv r

strengthenRefTypeGen :: forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
RType c tv r -> RType c tv r -> RType c tv r
strengthenRefTypeGen = (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
forall {r} {c} {c} {tv} {tv}.
(TyConable c, TyConable c, PPrint tv, PPrint c, PPrint r,
 PPrint tv, PPrint c, Reftable r, Reftable (RTProp c tv r),
 Reftable (RTProp c tv ()), Reftable (RTProp c tv r),
 Reftable (RTProp c tv ()), Hashable tv, Hashable tv, FreeVar c tv,
 FreeVar c tv, SubsTy tv (RType c tv ()) c,
 SubsTy tv (RType c tv ()) tv, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
RTypeV Symbol c tv r -> RType c tv r -> RTypeV Symbol c tv r
f
  where
    f :: RTypeV Symbol c tv r -> RType c tv r -> RTypeV Symbol c tv r
f (RVar tv
v1 r
r1) RType c tv r
t  = tv -> r -> RTypeV Symbol c tv r
forall v c tv r. tv -> r -> RTypeV v c tv r
RVar tv
v1 (r
r1 r -> r -> r
forall r. Reftable r => r -> r -> r
`meet` r -> Maybe r -> r
forall a. a -> Maybe a -> a
fromMaybe r
forall a. Monoid a => a
mempty (RType c tv r -> Maybe r
forall c tv r. RType c tv r -> Maybe r
stripRTypeBase RType c tv r
t))
    f RTypeV Symbol c tv r
t (RVar tv
_ r
r1)  = RTypeV Symbol c tv r
t RTypeV Symbol c tv r -> r -> RTypeV Symbol c tv r
forall r v c tv.
Reftable r =>
RTypeV v c tv r -> r -> RTypeV v c tv r
`strengthen` r
r1
    f RTypeV Symbol c tv r
t1 RType c tv r
t2           = Maybe SrcSpan -> [Char] -> RTypeV Symbol c tv r
forall a. HasCallStack => Maybe SrcSpan -> [Char] -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing ([Char] -> RTypeV Symbol c tv r) -> [Char] -> RTypeV Symbol 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]"
                         (RTypeV Symbol c tv r -> [Char]
forall c tv r. OkRT c tv r => RType c tv r -> [Char]
pprRaw RTypeV Symbol c tv r
t1) (RType c tv () -> [Char]
forall a. PPrint a => a -> [Char]
showpp (RTypeV Symbol c tv r -> RType c tv ()
forall v c tv r. RTypeV v c tv r -> RTypeV v c tv ()
toRSort RTypeV Symbol c tv r
t1)) (RType c tv r -> [Char]
forall c tv r. OkRT c tv r => RType c tv r -> [Char]
pprRaw RType c tv r
t2) (RType c tv () -> [Char]
forall a. PPrint a => a -> [Char]
showpp (RType c tv r -> RType c tv ()
forall v c tv r. RTypeV v c tv r -> RTypeV v c tv ()
toRSort RType c tv r
t2))

pprRaw :: (OkRT c tv r) => RType c tv r -> String
pprRaw :: forall c tv r. OkRT c tv r => RType c tv r -> [Char]
pprRaw = Doc -> [Char]
render (Doc -> [Char]) -> (RType c tv r -> Doc) -> RType c tv r -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tidy -> RType c tv r -> Doc
forall c tv r. OkRT c tv r => Tidy -> RType 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 c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType RType c tv r
t1 RType c tv r
t2
  -- | _meetable t1 t2
  = (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
forall a b. a -> b -> a
const RType c tv r
t1 RType 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 :: (OkRT c tv r) => RType c tv r -> RType c tv r -> Bool
_meetable :: forall c tv r. OkRT c tv r => RType c tv r -> RType c tv r -> Bool
_meetable RType c tv r
t1 RType c tv r
t2 = RType c tv r -> RTypeV Symbol c tv ()
forall v c tv r. RTypeV v c tv r -> RTypeV v c tv ()
toRSort RType c tv r
t1 RTypeV Symbol c tv () -> RTypeV Symbol c tv () -> Bool
forall a. Eq a => a -> a -> Bool
== RType c tv r -> RTypeV Symbol c tv ()
forall v c tv r. RTypeV v c tv r -> RTypeV v c tv ()
toRSort RType c tv r
t2

strengthenRefType_ :: forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RAllT RTVar tv (RType c tv ())
a1 RType c tv r
t1 r
r1) (RAllT RTVar tv (RType c tv ())
a2 RType c tv r
t2 r
r2)
  = RTVar tv (RType c tv ()) -> RType c tv r -> r -> RType c tv r
forall v c tv r.
RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAllT RTVar tv (RType c tv ())
a1 ((RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 ((tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
(tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet (RTVar tv (RType c tv ()) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value RTVar tv (RType c tv ())
a2, RType c tv r -> RType c tv ()
forall v c tv r. RTypeV v c tv r -> RTypeV v c tv ()
toRSort RType c tv r
t, RType c tv r
t) RType c tv r
t2)) (r
r1 r -> r -> r
forall r. Reftable r => r -> r -> r
`meet` r
r2)
  where t :: RType c tv r
t = tv -> r -> RType c tv r
forall v c tv r. tv -> r -> RTypeV v c tv r
RVar (RTVar tv (RType c tv ()) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value RTVar tv (RType c tv ())
a1) r
forall a. Monoid a => a
mempty

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RAllT RTVar tv (RType c tv ())
a RType c tv r
t1 r
r1) RType c tv r
t2
  = RTVar tv (RType c tv ()) -> RType c tv r -> r -> RType c tv r
forall v c tv r.
RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAllT RTVar tv (RType c tv ())
a ((RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2) r
r1

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 (RAllT RTVar tv (RType c tv ())
a RType c tv r
t2 r
r2)
  = RTVar tv (RType c tv ()) -> RType c tv r -> r -> RType c tv r
forall v c tv r.
RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAllT RTVar tv (RType c tv ())
a ((RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2) r
r2

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RAllP PVUV Symbol c tv
p1 RType c tv r
t1) (RAllP PVUV Symbol c tv
_ RType c tv r
t2)
  = PVUV Symbol c tv -> RType c tv r -> RType c tv r
forall v c tv r. PVUV v c tv -> RTypeV v c tv r -> RTypeV v c tv r
RAllP PVUV Symbol c tv
p1 (RType c tv r -> RType c tv r) -> RType c tv r -> RType c tv r
forall a b. (a -> b) -> a -> b
$ (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RAllP PVUV Symbol c tv
p RType c tv r
t1) RType c tv r
t2
  = PVUV Symbol c tv -> RType c tv r -> RType c tv r
forall v c tv r. PVUV v c tv -> RTypeV v c tv r -> RTypeV v c tv r
RAllP PVUV Symbol c tv
p (RType c tv r -> RType c tv r) -> RType c tv r -> RType c tv r
forall a b. (a -> b) -> a -> b
$ (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 (RAllP PVUV Symbol c tv
p RType c tv r
t2)
  = PVUV Symbol c tv -> RType c tv r -> RType c tv r
forall v c tv r. PVUV v c tv -> RTypeV v c tv r -> RTypeV v c tv r
RAllP PVUV Symbol c tv
p (RType c tv r -> RType c tv r) -> RType c tv r -> RType c tv r
forall a b. (a -> b) -> a -> b
$ (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RAllE Symbol
x RType c tv r
tx RType c tv r
t1) (RAllE Symbol
y RType c tv r
ty RType c tv r
t2) | Symbol
x Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
y
  = Symbol -> RType c tv r -> RType c tv r -> RType c tv r
forall v c tv r.
Symbol -> RTypeV v c tv r -> RTypeV v c tv r -> RTypeV v c tv r
RAllE Symbol
x ((RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
tx RType c tv r
ty) (RType c tv r -> RType c tv r) -> RType c tv r -> RType c tv r
forall a b. (a -> b) -> a -> b
$ (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RAllE Symbol
x RType c tv r
tx RType c tv r
t1) RType c tv r
t2
  = Symbol -> RType c tv r -> RType c tv r -> RType c tv r
forall v c tv r.
Symbol -> RTypeV v c tv r -> RTypeV v c tv r -> RTypeV v c tv r
RAllE Symbol
x RType c tv r
tx (RType c tv r -> RType c tv r) -> RType c tv r -> RType c tv r
forall a b. (a -> b) -> a -> b
$ (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 (RAllE Symbol
x RType c tv r
tx RType c tv r
t2)
  = Symbol -> RType c tv r -> RType c tv r -> RType c tv r
forall v c tv r.
Symbol -> RTypeV v c tv r -> RTypeV v c tv r -> RTypeV v c tv r
RAllE Symbol
x RType c tv r
tx (RType c tv r -> RType c tv r) -> RType c tv r -> RType c tv r
forall a b. (a -> b) -> a -> b
$ (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RAppTy RType c tv r
t1 RType c tv r
t1' r
r1) (RAppTy RType c tv r
t2 RType c tv r
t2' r
r2)
  = RType c tv r -> RType c tv r -> r -> RType c tv r
forall v c tv r.
RTypeV v c tv r -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAppTy RType c tv r
t RType c tv r
t' (r
r1 r -> r -> r
forall r. Reftable r => r -> r -> r
`meet` r
r2)
    where t :: RType c tv r
t  = (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2
          t' :: RType c tv r
t' = (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1' RType c tv r
t2'

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RFun Symbol
x1 RFInfo
i1 RType c tv r
t1 RType c tv r
t1' r
r1) (RFun Symbol
x2 RFInfo
i2 RType c tv r
t2 RType c tv r
t2' r
r2) =
  -- YL: Evidence that we need a Monoid instance for RFInfo?
  if Symbol
x2 Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
/= Symbol
F.dummySymbol
    then Symbol
-> RFInfo -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall v c tv r.
Symbol
-> RFInfo
-> RTypeV v c tv r
-> RTypeV v c tv r
-> r
-> RTypeV v c tv r
RFun Symbol
x2 RFInfo
i1{permitTC = getFirst b} RType c tv r
t RType c tv r
t1'' (r
r1 r -> r -> r
forall r. Reftable r => r -> r -> r
`meet` r
r2)
    else Symbol
-> RFInfo -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall v c tv r.
Symbol
-> RFInfo
-> RTypeV v c tv r
-> RTypeV v c tv r
-> r
-> RTypeV v c tv r
RFun Symbol
x1 RFInfo
i1{permitTC = getFirst b} RType c tv r
t RType c tv r
t2'' (r
r1 r -> r -> r
forall r. Reftable r => r -> r -> r
`meet` r
r2)
    where t :: RType c tv r
t  = (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2
          t1'' :: RType c tv r
t1'' = (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RType c tv r -> (Symbol, Expr) -> RType c tv r
forall a. Subable a => a -> (Symbol, Expr) -> a
subst1 RType c tv r
t1' (Symbol
x1, Symbol -> Expr
forall v. v -> ExprV v
EVar Symbol
x2)) RType c tv r
t2'
          t2'' :: RType c tv r
t2'' = (RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1' (RType c tv r -> (Symbol, Expr) -> RType c tv r
forall a. Subable a => a -> (Symbol, Expr) -> a
subst1 RType c tv r
t2' (Symbol
x2, Symbol -> Expr
forall v. v -> ExprV v
EVar Symbol
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_ RType c tv r -> RType c tv r -> RType c tv r
f (RApp c
tid [RType c tv r]
t1s [RTPropV Symbol c tv r]
rs1 r
r1) (RApp c
_ [RType c tv r]
t2s [RTPropV Symbol c tv r]
rs2 r
r2)
  = c -> [RType c tv r] -> [RTPropV Symbol c tv r] -> r -> RType c tv r
forall v c tv r.
c
-> [RTypeV v c tv r] -> [RTPropV v c tv r] -> r -> RTypeV v c tv r
RApp c
tid [RType c tv r]
ts [RTPropV Symbol c tv r]
rs (r
r1 r -> r -> r
forall r. Reftable r => r -> r -> r
`meet` r
r2)
    where ts :: [RType c tv r]
ts  = (RType c tv r -> RType c tv r -> RType c tv r)
-> [RType c tv r] -> [RType c tv r] -> [RType c tv r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
forall c tv r.
(OkRT c tv r, FreeVar c tv,
 SubsTy tv (RType c tv ()) (RType c tv ()),
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())),
 SubsTy tv (RType c tv ()) tv) =>
(RType c tv r -> RType c tv r -> RType c tv r)
-> RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f) [RType c tv r]
t1s [RType c tv r]
t2s
          rs :: [RTPropV Symbol c tv r]
rs  = [RTPropV Symbol c tv r]
-> [RTPropV Symbol c tv r] -> [RTPropV Symbol c tv r]
forall r. Reftable r => [r] -> [r] -> [r]
meets [RTPropV Symbol c tv r]
rs1 [RTPropV Symbol c tv r]
rs2

strengthenRefType_ RType c tv r -> RType c tv r -> RType 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 -> RType c tv r
forall v c tv r. tv -> r -> RTypeV v c tv r
RVar tv
v1 (r
r1 r -> r -> r
forall r. Reftable r => r -> r -> r
`meet` r
r2)
strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2
  = RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2

meets :: (Reftable r) => [r] -> [r] -> [r]
meets :: forall r. Reftable r => [r] -> [r] -> [r]
meets [] [r]
rs                 = [r]
rs
meets [r]
rs []                 = [r]
rs
meets [r]
rs [r]
rs'
  | [r] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [r]
rs Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== [r] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
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. Reftable 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 :: Reftable r => RTypeV v c tv r -> r -> RTypeV v c tv r
strengthen :: forall r v c tv.
Reftable r =>
RTypeV v c tv r -> r -> RTypeV v c tv r
strengthen = (r -> r -> r) -> RTypeV v c tv r -> r -> RTypeV v c tv r
forall r v c tv.
(r -> r -> r) -> RTypeV v c tv r -> r -> RTypeV v c tv r
strengthenWith r -> r -> r
forall r. Reftable r => r -> r -> r
meet

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


quantifyRTy :: (Monoid r, Eq tv) => [RTVar tv (RTypeV v c tv ())] -> 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 ())] -> RTypeV v c tv r -> RTypeV v c tv r
quantifyRTy [RTVar tv (RTypeV v c tv ())]
tvs RTypeV v c tv r
ty = (RTVar tv (RTypeV v c tv ()) -> RTypeV v c tv r -> RTypeV v c tv r)
-> RTypeV v c tv r
-> [RTVar tv (RTypeV v c tv ())]
-> 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 ()) -> RTypeV v c tv r -> RTypeV v c tv r
forall {r} {v} {c} {tv}.
Monoid r =>
RTVUV v c tv -> RTypeV v c tv r -> RTypeV v c tv r
rAllT RTypeV v c tv r
ty [RTVar tv (RTypeV v c tv ())]
tvs
  where rAllT :: RTVUV v c tv -> RTypeV v c tv r -> RTypeV v c tv r
rAllT RTVUV v c tv
a RTypeV v c tv r
t = RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
forall v c tv r.
RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAllT RTVUV v c tv
a RTypeV 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 ())] -> 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 ())] -> RTypeV v c tv r -> RTypeV v c tv r
quantifyRTy (RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
ty) RTypeV v c tv r
ty


-------------------------------------------------------------------------
addTyConInfo :: (PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r, Reftable (RTProp RTyCon RTyVar r))
             => TCEmb TyCon
             -> TyConMap
             -> RRType r
             -> RRType r
-------------------------------------------------------------------------
addTyConInfo :: forall r.
(PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar 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, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar r)) =>
TCEmb TyCon -> TyConMap -> RRType r -> RRType r
expandRApp TCEmb TyCon
tce TyConMap
tyi)

-------------------------------------------------------------------------
expandRApp :: (PPrint r, Reftable r, SubsTy RTyVar RSort r, Reftable (RRProp r))
           => TCEmb TyCon -> TyConMap -> RRType r -> RRType r
-------------------------------------------------------------------------
expandRApp :: forall r.
(PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar r)) =>
TCEmb TyCon -> TyConMap -> RRType r -> RRType r
expandRApp TCEmb TyCon
tce TyConMap
tyi t :: RRType r
t@RApp{} = RTyCon -> [RRType r] -> [RRProp r] -> r -> RRType r
forall v c tv r.
c
-> [RTypeV v c tv r] -> [RTPropV v c tv r] -> r -> RTypeV v c tv r
RApp RTyCon
rc' [RRType r]
ts [RRProp r]
rs' r
r
  where
    RApp RTyCon
rc [RRType r]
ts [RRProp r]
rs r
r            = RRType r
t
    (RTyCon
rc', [RPVar]
_)                   = TCEmb TyCon
-> TyConMap -> RTyCon -> [RRType r] -> (RTyCon, [RPVar])
forall r.
ToTypeable r =>
TCEmb TyCon
-> TyConMap -> RTyCon -> [RRType r] -> (RTyCon, [RPVar])
appRTyCon TCEmb TyCon
tce TyConMap
tyi RTyCon
rc [RRType r]
as
    pvs :: [RPVar]
pvs                        = RTyCon -> [RPVar]
rTyConPVs RTyCon
rc'
    rs' :: [RRProp r]
rs'                        = [RRProp r]
-> ([RRProp r] -> [RRProp r]) -> [RRProp r] -> [RRProp r]
forall b a. b -> ([a] -> b) -> [a] -> b
applyNonNull [RRProp r]
rs0 (RTyCon -> [RPVar] -> [RRProp r] -> [RRProp r]
forall a r c tv.
(Fixpoint a, Reftable r) =>
a
-> [PVar (RType c tv ())]
-> [Ref (RType c tv ()) (RType c tv r)]
-> [Ref (RType c tv ()) (RType c tv r)]
rtPropPV RTyCon
rc [RPVar]
pvs) [RRProp r]
rs
    rs0 :: [RRProp r]
rs0                        = RPVar -> RRProp r
forall c tv r.
(OkRT c tv r, SubsTy tv (RType c tv ()) c,
 SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
PVar (RType c tv ()) -> Ref (RType c tv ()) (RType c tv r)
rtPropTop (RPVar -> RRProp r) -> [RPVar] -> [RRProp r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPVar]
pvs
    n :: Arity
n                          = [TyVar] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [TyVar]
fVs
    fVs :: [TyVar]
fVs                        = TyCon -> [TyVar]
GM.tyConTyVarsDef (TyCon -> [TyVar]) -> TyCon -> [TyVar]
forall a b. (a -> b) -> a -> b
$ RTyCon -> TyCon
rtc_tc RTyCon
rc
    as :: [RRType r]
as                         = Arity -> [RRType r] -> [RRType r] -> [RRType r]
forall a. Arity -> [a] -> [a] -> [a]
choosen Arity
n [RRType r]
ts (TyVar -> RRType r
forall r c. Monoid r => TyVar -> RType c RTyVar r
rVar (TyVar -> RRType r) -> [TyVar] -> [RRType r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyVar]
fVs)
expandRApp TCEmb TyCon
_ TyConMap
_ RRType r
t               = RRType r
t

choosen :: Int -> [a] -> [a] -> [a]
choosen :: forall a. Arity -> [a] -> [a] -> [a]
choosen Arity
0 [a]
_ [a]
_           = []
choosen Arity
i (a
x:[a]
xs) (a
_:[a]
ys) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:Arity -> [a] -> [a] -> [a]
forall a. Arity -> [a] -> [a] -> [a]
choosen (Arity
iArity -> Arity -> Arity
forall a. Num a => a -> a -> a
-Arity
1) [a]
xs [a]
ys
choosen Arity
i []     (a
y:[a]
ys) = a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:Arity -> [a] -> [a] -> [a]
forall a. Arity -> [a] -> [a] -> [a]
choosen (Arity
iArity -> Arity -> Arity
forall a. Num a => a -> a -> a
-Arity
1) [] [a]
ys
choosen Arity
_ [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,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
   => PVar (RType c tv ()) -> Ref (RType c tv ()) (RType c tv r)
rtPropTop :: forall c tv r.
(OkRT c tv r, SubsTy tv (RType c tv ()) c,
 SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
PVar (RType c tv ()) -> Ref (RType c tv ()) (RType c tv r)
rtPropTop PVar (RType c tv ())
pv = [(Symbol, RType c tv ())]
-> RType c tv r -> Ref (RType c tv ()) (RType c tv r)
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp (PVar (RType c tv ()) -> [(Symbol, RType c tv ())]
forall t. PVar t -> [(Symbol, t)]
pvArgs PVar (RType c tv ())
pv) (RType c tv r -> Ref (RType c tv ()) (RType c tv r))
-> RType c tv r -> Ref (RType c tv ()) (RType c tv r)
forall a b. (a -> b) -> a -> b
$ RType c tv () -> RType c tv r
forall r c tv. Reftable r => RType c tv () -> RType c tv r
ofRSort (RType c tv () -> RType c tv r) -> RType c tv () -> RType c tv r
forall a b. (a -> b) -> a -> b
$ PVar (RType c tv ()) -> RType c tv ()
forall v t. PVarV v t -> t
ptype PVar (RType c tv ())
pv

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

mkRTProp :: Reftable r
         => PVar (RType c tv ())
         -> Ref (RType c tv ()) (RType c tv r)
         -> Ref (RType c tv ()) (RType c tv r)
mkRTProp :: forall r c tv.
Reftable r =>
PVar (RType c tv ())
-> Ref (RType c tv ()) (RType c tv r)
-> Ref (RType c tv ()) (RType c tv r)
mkRTProp PVar (RType c tv ())
pv (RProp [(Symbol, RType c tv ())]
ss (RHole r
r))
  = [(Symbol, RType c tv ())]
-> RType c tv r -> Ref (RType c tv ()) (RType c tv r)
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType c tv ())]
ss (RType c tv r -> Ref (RType c tv ()) (RType c tv r))
-> RType c tv r -> Ref (RType c tv ()) (RType c tv r)
forall a b. (a -> b) -> a -> b
$ RType c tv () -> RType c tv r
forall r c tv. Reftable r => RType c tv () -> RType c tv r
ofRSort (PVar (RType c tv ()) -> RType c tv ()
forall v t. PVarV v t -> t
pvType PVar (RType c tv ())
pv) RType c tv r -> r -> RType c tv r
forall r v c tv.
Reftable r =>
RTypeV v c tv r -> r -> RTypeV v c tv r
`strengthen` r
r

mkRTProp PVar (RType c tv ())
pv (RProp [(Symbol, RType c tv ())]
ss RType c tv r
t)
  | [(RType c tv (), Symbol, Expr)] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length (PVar (RType c tv ()) -> [(RType c tv (), Symbol, Expr)]
forall v t. PVarV v t -> [(t, Symbol, ExprV v)]
pargs PVar (RType c tv ())
pv) Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== [(Symbol, RType c tv ())] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [(Symbol, RType c tv ())]
ss
  = [(Symbol, RType c tv ())]
-> RType c tv r -> Ref (RType c tv ()) (RType c tv r)
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType c tv ())]
ss RType c tv r
t
  | Bool
otherwise
  = [(Symbol, RType c tv ())]
-> RType c tv r -> Ref (RType c tv ()) (RType c tv r)
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp (PVar (RType c tv ()) -> [(Symbol, RType c tv ())]
forall t. PVar t -> [(Symbol, t)]
pvArgs PVar (RType c tv ())
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 v t. PVarV v t -> [(t, Symbol, ExprV 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, Arity, [Type]) -> [Char]
forall a. PPrint a => a -> [Char]
showpp (TyCon -> Bool
Ghc.isFamilyTyCon TyCon
c, TyCon -> Arity
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, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar 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 ())] -> RPVar -> RPVar
forall tv ty c. SubsTy tv ty c => [(tv, ty)] -> c -> c
subts ([RTyVar]
-> [RType RTyCon RTyVar ()] -> [(RTyVar, RType RTyCon RTyVar ())]
forall a b. [a] -> [b] -> [(a, b)]
zip (TyVar -> RTyVar
RTV (TyVar -> RTyVar) -> [TyVar] -> [RTyVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyVar]
αs) [RType RTyCon RTyVar ()]
ts') (RPVar -> RPVar) -> [RPVar] -> [RPVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPVar]
ps'
      where
        ts' :: [RType RTyCon RTyVar ()]
ts' = if [RRType r] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RRType r]
ts then TyVar -> RType RTyCon RTyVar ()
forall r c. Monoid r => TyVar -> RType c RTyVar r
rVar (TyVar -> RType RTyCon RTyVar ())
-> [TyVar] -> [RType RTyCon RTyVar ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyVar]
βs else RRType r -> RType RTyCon RTyVar ()
forall v c tv r. RTypeV v c tv r -> RTypeV v c tv ()
toRSort (RRType r -> RType RTyCon RTyVar ())
-> [RRType r] -> [RType RTyCon RTyVar ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RRType r]
ts
        αs :: [TyVar]
αs  = TyCon -> [TyVar]
GM.tyConTyVarsDef (RTyCon -> TyCon
rtc_tc RTyCon
rc')
        βs :: [TyVar]
βs  = TyCon -> [TyVar]
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 Arity -> Maybe Arity
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup TyCon
c      (TyConMap -> HashMap TyCon Arity
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, Arity, [Type]) -> [Char]
forall a. PPrint a => a -> [Char]
F.showpp (TyCon
c, Arity
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', Arity -> [Type] -> [Type]
forall a. Arity -> [a] -> [a]
take ([Type] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Type]
ts Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
cArity) [Type]
ts)
    Maybe (TyCon, [Type])
Nothing       -> Maybe (TyCon, [Type])
forall a. Maybe a
Nothing
    where
      cArity :: Arity
cArity      = TyCon -> Arity
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. (Eq k, 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
. LocSymbol -> FTycon
symbolFTycon (LocSymbol -> FTycon) -> (TyCon -> LocSymbol) -> TyCon -> FTycon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc (Symbol -> LocSymbol) -> (TyCon -> Symbol) -> TyCon -> LocSymbol
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 (RTypeV Symbol c tv ()), r)]
-> [PVarV Symbol (RTypeV Symbol c tv ())]
-> RType c tv r
-> RType c tv r
forall (t :: * -> *) (t1 :: * -> *) tv v c r.
(Foldable t, Foldable t1) =>
t (RTVar tv (RTypeV v c tv ()), r)
-> t1 (PVarV v (RTypeV v c tv ()))
-> RTypeV v c tv r
-> RTypeV v c tv r
mkUnivs ((RTVar tv (RTypeV Symbol c tv ())
 -> (RTVar tv (RTypeV Symbol c tv ()), r))
-> [RTVar tv (RTypeV Symbol c tv ())]
-> [(RTVar tv (RTypeV Symbol c tv ()), r)]
forall a b. (a -> b) -> [a] -> [b]
map (, r
forall a. Monoid a => a
mempty) (RType c tv r -> [RTVar tv (RTypeV Symbol c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
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]) -> (RType c tv r -> [tv]) -> RType c tv r -> [tv]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RType 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 (RTypeV Symbol c tv ()) -> tv)
-> [RTVar tv (RTypeV Symbol c tv ())] -> [tv]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RTVar tv (RTypeV Symbol c tv ()) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value ([RTVar tv (RTypeV Symbol c tv ())] -> [tv])
-> [RTVar tv (RTypeV Symbol c tv ())] -> [tv]
forall a b. (a -> b) -> a -> b
$ [RTVar tv (RTypeV Symbol c tv ())]
vs [RTVar tv (RTypeV Symbol c tv ())]
-> [RTVar tv (RTypeV Symbol c tv ())]
-> [RTVar tv (RTypeV Symbol c tv ())]
forall a. [a] -> [a] -> [a]
++ [RTVar tv (RTypeV Symbol c tv ())]
vs'
  where
    vs :: [RTVar tv (RTypeV Symbol c tv ())]
vs      = ((RTVar tv (RTypeV Symbol c tv ()), r)
 -> RTVar tv (RTypeV Symbol c tv ()))
-> [(RTVar tv (RTypeV Symbol c tv ()), r)]
-> [RTVar tv (RTypeV Symbol c tv ())]
forall a b. (a -> b) -> [a] -> [b]
map (RTVar tv (RTypeV Symbol c tv ()), r)
-> RTVar tv (RTypeV Symbol c tv ())
forall a b. (a, b) -> a
fst ([(RTVar tv (RTypeV Symbol c tv ()), r)]
 -> [RTVar tv (RTypeV Symbol c tv ())])
-> (RType c tv r -> [(RTVar tv (RTypeV Symbol c tv ()), r)])
-> RType c tv r
-> [RTVar tv (RTypeV Symbol c tv ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(RTVar tv (RTypeV Symbol c tv ()), r)],
 [PVarV Symbol (RTypeV Symbol c tv ())], RType c tv r)
-> [(RTVar tv (RTypeV Symbol c tv ()), r)]
forall a b c. (a, b, c) -> a
fst3 (([(RTVar tv (RTypeV Symbol c tv ()), r)],
  [PVarV Symbol (RTypeV Symbol c tv ())], RType c tv r)
 -> [(RTVar tv (RTypeV Symbol c tv ()), r)])
-> (RType c tv r
    -> ([(RTVar tv (RTypeV Symbol c tv ()), r)],
        [PVarV Symbol (RTypeV Symbol c tv ())], RType c tv r))
-> RType c tv r
-> [(RTVar tv (RTypeV Symbol c tv ()), r)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RType c tv r
-> ([(RTVar tv (RTypeV Symbol c tv ()), r)],
    [PVarV Symbol (RTypeV Symbol c tv ())], RType c tv r)
forall v tv c r.
RTypeV v tv c r
-> ([(RTVar c (RTypeV v tv c ()), r)],
    [PVarV v (RTypeV v tv c ())], RTypeV v tv c r)
bkUniv (RType c tv r -> [RTVar tv (RTypeV Symbol c tv ())])
-> RType c tv r -> [RTVar tv (RTypeV Symbol c tv ())]
forall a b. (a -> b) -> a -> b
$ RType c tv r
t
    vs' :: [RTVar tv (RTypeV Symbol c tv ())]
vs'     = RType c tv r -> [RTVar tv (RTypeV Symbol c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RType c tv r
t


freeTyVars :: Eq tv => RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars :: forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars (RAllP PVUV v c tv
_ RTypeV v c tv r
t)       = RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
t
freeTyVars (RAllT RTVar tv (RTypeV v c tv ())
α RTypeV v c tv r
t r
_)     = RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
t [RTVar tv (RTypeV v c tv ())]
-> [RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [RTVar tv (RTypeV v c tv ())
α]
freeTyVars (RFun Symbol
_ RFInfo
_ RTypeV v c tv r
t RTypeV v c tv r
t' r
_) = RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
t [RTVar tv (RTypeV v c tv ())]
-> [RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
t'
freeTyVars (RApp c
_ [RTypeV v c tv r]
ts [RTPropV v c tv r]
_ r
_)   = [RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())]
forall a. Eq a => [a] -> [a]
L.nub ([RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())])
-> [RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())]
forall a b. (a -> b) -> a -> b
$ (RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())])
-> [RTypeV v c tv r] -> [RTVar tv (RTypeV v c tv ())]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars [RTypeV v c tv r]
ts
freeTyVars (RVar tv
α r
_)        = [tv -> RTVar tv (RTypeV v c tv ())
forall tv s. tv -> RTVar tv s
makeRTVar tv
α]
freeTyVars (RAllE Symbol
_ RTypeV v c tv r
tx RTypeV v c tv r
t)    = RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
tx [RTVar tv (RTypeV v c tv ())]
-> [RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
t
freeTyVars (REx Symbol
_ RTypeV v c tv r
tx RTypeV v c tv r
t)      = RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
tx [RTVar tv (RTypeV v c tv ())]
-> [RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
t
freeTyVars (RExprArg Located (ExprV v)
_)      = []
freeTyVars (RAppTy RTypeV v c tv r
t RTypeV v c tv r
t' r
_)   = RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
t [RTVar tv (RTypeV v c tv ())]
-> [RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars RTypeV v c tv r
t'
freeTyVars (RHole r
_)         = []
freeTyVars (RRTy [(Symbol, RTypeV v c tv r)]
e r
_ Oblig
_ RTypeV v c tv r
t)    = [RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())]
forall a. Eq a => [a] -> [a]
L.nub ([RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())])
-> [RTVar tv (RTypeV v c tv ())] -> [RTVar tv (RTypeV v c tv ())]
forall a b. (a -> b) -> a -> b
$ (RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())])
-> [RTypeV v c tv r] -> [RTVar tv (RTypeV v c tv ())]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
forall tv v c r.
Eq tv =>
RTypeV v c tv r -> [RTVar tv (RTypeV v c tv ())]
freeTyVars (RTypeV v c tv r
tRTypeV v c tv r -> [RTypeV v c tv r] -> [RTypeV v c tv r]
forall a. a -> [a] -> [a]
:((Symbol, RTypeV v c tv r) -> RTypeV v c tv r
forall a b. (a, b) -> b
snd ((Symbol, RTypeV v c tv r) -> RTypeV v c tv r)
-> [(Symbol, RTypeV v c tv r)] -> [RTypeV v c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RTypeV 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 PVUV Symbol RTyCon tv
_ RType RTyCon tv r
t)     = RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RType RTyCon tv r
t
tyClasses (RAllT RTVUV Symbol RTyCon tv
_ RType RTyCon tv r
t r
_)   = RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RType RTyCon tv r
t
tyClasses (RAllE Symbol
_ RType RTyCon tv r
_ RType RTyCon tv r
t)   = RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RType RTyCon tv r
t
tyClasses (REx Symbol
_ RType RTyCon tv r
_ RType RTyCon tv r
t)     = RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RType RTyCon tv r
t
tyClasses (RFun Symbol
_ RFInfo
_ RType RTyCon tv r
t RType RTyCon tv r
t' r
_) = RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RType RTyCon tv r
t [(Class, [RType RTyCon tv r])]
-> [(Class, [RType RTyCon tv r])] -> [(Class, [RType RTyCon tv r])]
forall a. [a] -> [a] -> [a]
++ RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RType RTyCon tv r
t'
tyClasses (RAppTy RType RTyCon tv r
t RType RTyCon tv r
t' r
_) = RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RType RTyCon tv r
t [(Class, [RType RTyCon tv r])]
-> [(Class, [RType RTyCon tv r])] -> [(Class, [RType RTyCon tv r])]
forall a. [a] -> [a] -> [a]
++ RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RType RTyCon tv r
t'
tyClasses (RApp RTyCon
c [RType RTyCon tv r]
ts [RTPropV 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, [RType RTyCon tv r]
ts)]
  | Bool
otherwise
  = []
tyClasses (RVar tv
_ r
_)      = []
tyClasses (RRTy [(Symbol, RType RTyCon tv r)]
_ r
_ Oblig
_ RType RTyCon tv r
t)  = RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
forall tv r.
OkRT RTyCon tv r =>
RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses RType RTyCon tv r
t
tyClasses (RHole r
_)       = []
tyClasses RType RTyCon tv r
t               = Maybe SrcSpan -> [Char] -> [(Class, [RType 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]
++ RType RTyCon tv r -> [Char]
forall a. Show a => a -> [Char]
show RType RTyCon tv r
t)


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

subsTyVarsMeet
  :: (Eq tv, Foldable t, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => t (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarsMeet :: forall tv (t :: * -> *) r c.
(Eq tv, Foldable t, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
t (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarsMeet        = Bool
-> t (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv (t :: * -> *) r c.
(Eq tv, Foldable t, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> t (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsTyVars Bool
True

subsTyVarsNoMeet
  :: (Eq tv, Foldable t, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => t (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarsNoMeet :: forall tv (t :: * -> *) r c.
(Eq tv, Foldable t, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
t (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarsNoMeet      = Bool
-> t (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv (t :: * -> *) r c.
(Eq tv, Foldable t, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> t (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsTyVars Bool
False

subsTyVarNoMeet
  :: (Eq tv, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarNoMeet :: forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
(tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarNoMeet       = Bool
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsTyVar Bool
False

subsTyVarMeet
  :: (Eq tv, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet :: forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
(tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet         = Bool
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsTyVar Bool
True

subsTyVarMeet'
  :: (Eq tv, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => (tv, RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet' :: forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
(tv, RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet' (tv
α, RType c tv r
t) = (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
(tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet (tv
α, RType c tv r -> RType c tv ()
forall v c tv r. RTypeV v c tv r -> RTypeV v c tv ()
toRSort RType c tv r
t, RType c tv r
t)

subsTyVars
  :: (Eq tv, Foldable t, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => Bool
  -> t (tv, RType c tv (), RType c tv r)
  -> RType c tv r
  -> RType c tv r
subsTyVars :: forall tv (t :: * -> *) r c.
(Eq tv, Foldable t, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> t (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsTyVars Bool
meet' t (tv, RType c tv (), RType c tv r)
ats RType c tv r
t = (RType c tv r -> (tv, RType c tv (), RType c tv r) -> RType c tv r)
-> RType c tv r
-> t (tv, RType c tv (), RType c tv r)
-> RType 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, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r)
-> RType c tv r
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsTyVar Bool
meet')) RType c tv r
t t (tv, RType c tv (), RType c tv r)
ats

subsTyVar
  :: (Eq tv, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => Bool
  -> (tv, RType c tv (), RType c tv r)
  -> RType c tv r
  -> RType c tv r
subsTyVar :: forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsTyVar Bool
meet'        = Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
meet' HashSet tv
forall a. HashSet a
S.empty

subsFree
  :: (Eq tv, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => Bool
  -> S.HashSet tv
  -> (tv, RType c tv (), RType c tv r)
  -> RType c tv r
  -> RType c tv r
subsFree :: forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s z :: (tv, RType c tv (), RType c tv r)
z@(tv
α, RType c tv ()
τ,RType c tv r
_) (RAllP PVUV Symbol c tv
π RType c tv r
t)
  = PVUV Symbol c tv -> RType c tv r -> RType c tv r
forall v c tv r. PVUV v c tv -> RTypeV v c tv r -> RTypeV v c tv r
RAllP ((tv, RType c tv ()) -> PVUV Symbol c tv -> PVUV Symbol c tv
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RType c tv ()
τ) PVUV Symbol c tv
π) (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t)
subsFree Bool
m HashSet tv
s z :: (tv, RType c tv (), RType c tv r)
z@(tv
a, RType c tv ()
τ, RType c tv r
_) (RAllT RTVar tv (RType c tv ())
α RType c tv r
t r
r)
  -- subt inside the type variable instantiates the kind of the variable
  = RTVar tv (RType c tv ()) -> RType c tv r -> r -> RType c tv r
forall v c tv r.
RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAllT ((tv, RType c tv ())
-> RTVar tv (RType c tv ()) -> RTVar tv (RType c tv ())
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
a, RType c tv ()
τ) RTVar tv (RType c tv ())
α) (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m (RTVar tv (RType c tv ()) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value RTVar tv (RType c tv ())
α tv -> HashSet tv -> HashSet tv
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
`S.insert` HashSet tv
s) (tv, RType c tv (), RType c tv r)
z RType c tv r
t) ((tv, RType c tv ()) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
a, RType c tv ()
τ) r
r)
subsFree Bool
m HashSet tv
s z :: (tv, RType c tv (), RType c tv r)
z@(tv
α, RType c tv ()
τ, RType c tv r
_) (RFun Symbol
x RFInfo
i RType c tv r
t RType c tv r
t' r
r)
  = Symbol
-> RFInfo -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall v c tv r.
Symbol
-> RFInfo
-> RTypeV v c tv r
-> RTypeV v c tv r
-> r
-> RTypeV v c tv r
RFun Symbol
x RFInfo
i (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t) (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t') ((tv, RType c tv ()) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RType c tv ()
τ) r
r)
subsFree Bool
m HashSet tv
s z :: (tv, RType c tv (), RType c tv r)
z@(tv
α, RType c tv ()
τ, RType c tv r
_) (RApp c
c [RType c tv r]
ts [RTPropV Symbol c tv r]
rs r
r)
  = c -> [RType c tv r] -> [RTPropV Symbol c tv r] -> r -> RType c tv r
forall v c tv r.
c
-> [RTypeV v c tv r] -> [RTPropV v c tv r] -> r -> RTypeV v c tv r
RApp c
c' (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z (RType c tv r -> RType c tv r) -> [RType c tv r] -> [RType c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RType c tv r]
ts) (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RTPropV Symbol c tv r
-> RTPropV Symbol c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RTProp c tv r
-> RTProp c tv r
subsFreeRef Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z (RTPropV Symbol c tv r -> RTPropV Symbol c tv r)
-> [RTPropV Symbol c tv r] -> [RTPropV Symbol c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RTPropV Symbol c tv r]
rs) ((tv, RType c tv ()) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RType c tv ()
τ) r
r)
    where z' :: (tv, RType c tv ())
z' = (tv
α, RType c tv ()
τ) -- UNIFY: why instantiating INSIDE parameters?
          c' :: c
c' = if tv
α tv -> HashSet tv -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet tv
s then c
c else (tv, RType c tv ()) -> c -> c
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, RType c tv ())
z' c
c
subsFree Bool
meet' HashSet tv
s (tv
α', RType c tv ()
τ, RType 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. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet tv
s)
  = if Bool
meet' then RType c tv r
t' RType c tv r -> r -> RType c tv r
forall r v c tv.
Reftable r =>
RTypeV v c tv r -> r -> RTypeV v c tv r
`strengthen` (tv, RType c tv ()) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RType c tv ()
τ) r
r else RType c tv r
t'
  | Bool
otherwise
  = tv -> r -> RType c tv r
forall v c tv r. tv -> r -> RTypeV v c tv r
RVar ((tv, RType c tv ()) -> tv -> tv
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α', RType c tv ()
τ) tv
α) r
r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z (RAllE Symbol
x RType c tv r
t RType c tv r
t')
  = Symbol -> RType c tv r -> RType c tv r -> RType c tv r
forall v c tv r.
Symbol -> RTypeV v c tv r -> RTypeV v c tv r -> RTypeV v c tv r
RAllE Symbol
x (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t) (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t')
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z (REx Symbol
x RType c tv r
t RType c tv r
t')
  = Symbol -> RType c tv r -> RType c tv r -> RType c tv r
forall v c tv r.
Symbol -> RTypeV v c tv r -> RTypeV v c tv r -> RTypeV v c tv r
REx Symbol
x (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t) (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t')
subsFree Bool
m HashSet tv
s z :: (tv, RType c tv (), RType c tv r)
z@(tv
α, RType c tv ()
τ, RType c tv r
_) (RAppTy RType c tv r
t RType c tv r
t' r
r)
  = Bool
-> HashSet tv -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv -> RType c tv r -> RType c tv r -> r -> RType c tv r
subsFreeRAppTy Bool
m HashSet tv
s (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t) (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t') ((tv, RType c tv ()) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RType c tv ()
τ) r
r)
subsFree Bool
_ HashSet tv
_ (tv, RType c tv (), RType c tv r)
_ t :: RType c tv r
t@(RExprArg Located Expr
_)
  = RType c tv r
t
subsFree Bool
m HashSet tv
s z :: (tv, RType c tv (), RType c tv r)
z@(tv
α, RType c tv ()
τ, RType c tv r
_) (RRTy [(Symbol, RType c tv r)]
e r
r Oblig
o RType c tv r
t)
  = [(Symbol, RType c tv r)]
-> r -> Oblig -> RType c tv r -> RType c tv r
forall v c tv r.
[(Symbol, RTypeV v c tv r)]
-> r -> Oblig -> RTypeV v c tv r -> RTypeV v c tv r
RRTy ((RType c tv r -> RType c tv r)
-> (Symbol, RType c tv r) -> (Symbol, RType c tv r)
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z) ((Symbol, RType c tv r) -> (Symbol, RType c tv r))
-> [(Symbol, RType c tv r)] -> [(Symbol, RType c tv r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv r)]
e) ((tv, RType c tv ()) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RType c tv ()
τ) r
r) Oblig
o (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv, RType c tv (), RType c tv r)
z RType c tv r
t)
subsFree Bool
_ HashSet tv
_ (tv
α, RType c tv ()
τ, RType c tv r
_) (RHole r
r)
  = r -> RType c tv r
forall v c tv r. r -> RTypeV v c tv r
RHole ((tv, RType c tv ()) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RType c tv ()
τ) r
r)

subsFrees
  :: (Eq tv, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => Bool
  -> S.HashSet tv
  -> [(tv, RType c tv (), RType c tv r)]
  -> RType c tv r
  -> RType c tv r
subsFrees :: forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> [(tv, RType c tv (), RType c tv r)]
-> RType c tv r
-> RType c tv r
subsFrees Bool
m HashSet tv
s [(tv, RType c tv (), RType c tv r)]
zs RType c tv r
t = (RType c tv r -> (tv, RType c tv (), RType c tv r) -> RType c tv r)
-> RType c tv r
-> [(tv, RType c tv (), RType c tv r)]
-> RType 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, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r)
-> RType c tv r
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s)) RType c tv r
t [(tv, RType c tv (), RType c tv r)]
zs

-- GHC INVARIANT: RApp is Type Application to something other than TYCon
subsFreeRAppTy
  :: (Eq tv, Hashable tv, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()),
      FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => Bool
  -> S.HashSet tv
  -> RType c tv r
  -> RType c tv r
  -> r
  -> RType c tv r
subsFreeRAppTy :: forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv -> RType c tv r -> RType c tv r -> r -> RType c tv r
subsFreeRAppTy Bool
m HashSet tv
s (RApp c
c [RTypeV Symbol c tv r]
ts [RTPropV Symbol c tv r]
rs r
r) RTypeV Symbol c tv r
t' r
r'
  = Bool
-> HashSet tv
-> c
-> [RTypeV Symbol c tv r]
-> [RTPropV Symbol c tv r]
-> r
-> r
-> RTypeV Symbol c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> c
-> [RType c tv r]
-> [RTProp c tv r]
-> r
-> r
-> RType c tv r
mkRApp Bool
m HashSet tv
s c
c ([RTypeV Symbol c tv r]
ts [RTypeV Symbol c tv r]
-> [RTypeV Symbol c tv r] -> [RTypeV Symbol c tv r]
forall a. [a] -> [a] -> [a]
++ [RTypeV Symbol c tv r
t']) [RTPropV Symbol c tv r]
rs r
r r
r'
subsFreeRAppTy Bool
_ HashSet tv
_ RTypeV Symbol c tv r
t RTypeV Symbol c tv r
t' r
r'
  = RTypeV Symbol c tv r
-> RTypeV Symbol c tv r -> r -> RTypeV Symbol c tv r
forall v c tv r.
RTypeV v c tv r -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAppTy RTypeV Symbol c tv r
t RTypeV Symbol 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, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => Bool
  -> S.HashSet tv
  -> c
  -> [RType c tv r]
  -> [RTProp c tv r]
  -> r
  -> r
  -> RType c tv r
mkRApp :: forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> c
-> [RType c tv r]
-> [RTProp c tv r]
-> r
-> r
-> RType c tv r
mkRApp Bool
m HashSet tv
s c
c [RType c tv r]
ts [RTProp c tv r]
rs r
r r
r'
  | c -> Bool
forall c. TyConable c => c -> Bool
isFun c
c, [RType c tv r
_m, RType c tv r
_rep1, RType c tv r
_rep2, RType c tv r
t1, RType c tv r
t2] <- [RType c tv r]
ts
  = Symbol
-> RFInfo -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall v c tv r.
Symbol
-> RFInfo
-> RTypeV v c tv r
-> RTypeV v c tv r
-> r
-> RTypeV v c tv r
RFun Symbol
dummySymbol RFInfo
defRFInfo RType c tv r
t1 RType c tv r
t2 (r -> r
forall r. Reftable r => r -> r
refAppTyToFun r
r')
  | Bool
otherwise
  = Bool
-> HashSet tv
-> [(tv, RType c tv (), RType c tv r)]
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> [(tv, RType c tv (), RType c tv r)]
-> RType c tv r
-> RType c tv r
subsFrees Bool
m HashSet tv
s [(tv, RType c tv (), RType c tv r)]
zs (c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
forall v c tv r.
c
-> [RTypeV v c tv r] -> [RTPropV v c tv r] -> r -> RTypeV v c tv r
RApp c
c [RType c tv r]
ts [RTProp c tv r]
rs (r
r r -> r -> r
forall r. Reftable r => r -> r -> r
`meet` r
r'))
  where
    zs :: [(tv, RType c tv (), RType c tv r)]
zs = [(tv
tv, RType c tv r -> RType c tv ()
forall v c tv r. RTypeV v c tv r -> RTypeV v c tv ()
toRSort RType c tv r
t, RType c tv r
t) | (tv
tv, RType c tv r
t) <- [tv] -> [RType c tv r] -> [(tv, RType c tv r)]
forall a b. [a] -> [b] -> [(a, b)]
zip (c -> [tv]
forall a v. FreeVar a v => a -> [v]
freeVars c
c) [RType 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 :: Reftable r => r -> r
refAppTyToFun :: forall r. Reftable r => r -> r
refAppTyToFun r
r
  | r -> Bool
forall r. Reftable 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, Reftable r, TyConable c,
      SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
      SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
      SubsTy tv (RType c tv ()) tv,
      SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ())))
  => Bool
  -> S.HashSet tv
  -> (tv, RType c tv (), RType c tv r)
  -> RTProp c tv r
  -> RTProp c tv r
subsFreeRef :: forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RTProp c tv r
-> RTProp c tv r
subsFreeRef Bool
_ HashSet tv
_ (tv
α', RType c tv ()
τ', RType c tv r
_) (RProp [(Symbol, RType c tv ())]
ss (RHole r
r))
  = [(Symbol, RType c tv ())]
-> RType c tv r -> Ref (RType c tv ()) (RType c tv r)
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp ((RType c tv () -> RType c tv ())
-> (Symbol, RType c tv ()) -> (Symbol, RType c tv ())
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((tv, RType c tv ()) -> RType c tv () -> RType c tv ()
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α', RType c tv ()
τ')) ((Symbol, RType c tv ()) -> (Symbol, RType c tv ()))
-> [(Symbol, RType c tv ())] -> [(Symbol, RType c tv ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv ())]
ss) (r -> RType c tv r
forall v c tv r. r -> RTypeV v c tv r
RHole r
r)
subsFreeRef Bool
m HashSet tv
s (tv
α', RType c tv ()
τ', RType c tv r
t')  (RProp [(Symbol, RType c tv ())]
ss RType c tv r
t)
  = [(Symbol, RType c tv ())]
-> RType c tv r -> Ref (RType c tv ()) (RType c tv r)
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp ((RType c tv () -> RType c tv ())
-> (Symbol, RType c tv ()) -> (Symbol, RType c tv ())
forall a b. (a -> b) -> (Symbol, a) -> (Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((tv, RType c tv ()) -> RType c tv () -> RType c tv ()
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α', RType c tv ()
τ')) ((Symbol, RType c tv ()) -> (Symbol, RType c tv ()))
-> [(Symbol, RType c tv ())] -> [(Symbol, RType c tv ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv ())]
ss) (RType c tv r -> Ref (RType c tv ()) (RType c tv r))
-> RType c tv r -> Ref (RType c tv ()) (RType c tv r)
forall a b. (a -> b) -> a -> b
$ Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
Bool
-> HashSet tv
-> (tv, RType c tv (), RType c tv r)
-> RType c tv r
-> RType c tv r
subsFree Bool
m HashSet tv
s (tv
α', RType c tv ()
τ', (r -> r) -> RType c tv r -> RType c tv r
forall a b.
(a -> b) -> RTypeV Symbol c tv a -> RTypeV Symbol c tv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> r
forall r. Reftable r => r -> r
top RType c tv r
t') RType 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 ()) RTyVar where
  subt :: (RTyVar, RType RTyCon RTyVar ()) -> RTyVar -> RTyVar
subt (RTV TyVar
x, RType RTyCon RTyVar ()
t) (RTV TyVar
z) | TyVar -> Bool
isTyVar TyVar
z, TyVar -> Type
tyVarKind TyVar
z Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== TyVar -> Type
TyVarTy TyVar
x
    = TyVar -> RTyVar
RTV (TyVar -> Type -> TyVar
setVarType TyVar
z (Type -> TyVar) -> Type -> TyVar
forall a b. (a -> b) -> a -> b
$ Bool -> RType RTyCon RTyVar () -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
False RType RTyCon RTyVar ()
t)
  subt (RTyVar, RType RTyCon RTyVar ())
_ RTyVar
v
    = RTyVar
v

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


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

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

instance SubsTy tv ty ()   where
  subt :: (tv, ty) -> () -> ()
subt (tv, ty)
_ = () -> ()
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) -> Reft -> Reft
subt (tv, ty)
su (Reft (Symbol
x, Expr
e)) = (Symbol, Expr) -> Reft
forall v. (Symbol, ExprV v) -> ReftV 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 LocSymbol
v) r
r)
    | Symbol
x Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
v = BTyVar -> r -> BRType r
forall v c tv r. tv -> r -> RTypeV v c tv r
RVar (LocSymbol -> BTyVar
BTV (Symbol
y Symbol -> LocSymbol -> LocSymbol
forall a b. a -> Located b -> Located a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LocSymbol
v)) r
r
    | Bool
otherwise  = BTyVar -> r -> BRType r
forall v c tv r. tv -> r -> RTypeV v c tv r
RVar (LocSymbol -> BTyVar
BTV LocSymbol
v) r
r
  subt (Symbol
x, Symbol
y) (RAllT (RTVar (BTV LocSymbol
v) RTVInfo (RType BTyCon BTyVar ())
i) BRType r
t r
r)
    | Symbol
x Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
v = RTVar BTyVar (RType BTyCon BTyVar ()) -> BRType r -> r -> BRType r
forall v c tv r.
RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAllT (BTyVar
-> RTVInfo (RType BTyCon BTyVar ())
-> RTVar BTyVar (RType BTyCon BTyVar ())
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar (LocSymbol -> BTyVar
BTV LocSymbol
v) RTVInfo (RType BTyCon BTyVar ())
i) BRType r
t r
r
    | Bool
otherwise  = RTVar BTyVar (RType BTyCon BTyVar ()) -> BRType r -> r -> BRType r
forall v c tv r.
RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAllT (BTyVar
-> RTVInfo (RType BTyCon BTyVar ())
-> RTVar BTyVar (RType BTyCon BTyVar ())
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar (LocSymbol -> BTyVar
BTV LocSymbol
v) RTVInfo (RType BTyCon BTyVar ())
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 v c tv r.
Symbol
-> RFInfo
-> RTypeV v c tv r
-> RTypeV v c tv r
-> r
-> RTypeV 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 PVUV Symbol BTyCon BTyVar
p BRType r
t)       = PVUV Symbol BTyCon BTyVar -> BRType r -> BRType r
forall v c tv r. PVUV v c tv -> RTypeV v c tv r -> RTypeV v c tv r
RAllP PVUV 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 [RTPropV Symbol BTyCon BTyVar r]
ps r
r)  = BTyCon
-> [BRType r] -> [RTPropV Symbol BTyCon BTyVar r] -> r -> BRType r
forall v c tv r.
c
-> [RTypeV v c tv r] -> [RTPropV v c tv r] -> r -> RTypeV 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)
-> RTPropV Symbol BTyCon BTyVar r -> RTPropV Symbol BTyCon BTyVar r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su (RTPropV Symbol BTyCon BTyVar r -> RTPropV Symbol BTyCon BTyVar r)
-> [RTPropV Symbol BTyCon BTyVar r]
-> [RTPropV Symbol BTyCon BTyVar r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RTPropV Symbol BTyCon BTyVar 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 v c tv r.
Symbol -> RTypeV v c tv r -> RTypeV v c tv r -> RTypeV 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 v c tv r.
Symbol -> RTypeV v c tv r -> RTypeV v c tv r -> RTypeV 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 v c tv r. Located (ExprV v) -> RTypeV 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 v c tv r.
RTypeV v c tv r -> RTypeV v c tv r -> r -> RTypeV 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 v c tv r.
[(Symbol, RTypeV v c tv r)]
-> r -> Oblig -> RTypeV v c tv r -> RTypeV 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 v c tv r. r -> RTypeV 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, RType BTyCon BTyVar ())]
e RTypeV Symbol BTyCon BTyVar r
t) =  [(Symbol, RType BTyCon BTyVar ())]
-> RTypeV Symbol BTyCon BTyVar r -> RTProp BTyCon BTyVar r
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol
x, (Symbol, Symbol)
-> RType BTyCon BTyVar () -> RType BTyCon BTyVar ()
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su RType BTyCon BTyVar ()
xt) | (Symbol
x,RType BTyCon BTyVar ()
xt) <- [(Symbol, RType BTyCon BTyVar ())]
e] ((Symbol, Symbol)
-> RTypeV Symbol BTyCon BTyVar r -> RTypeV Symbol BTyCon BTyVar r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su RTypeV 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 v. (Symbol, Sort) -> ExprV v -> ExprV 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 v. ExprV v -> ExprV v -> ExprV 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 v. ExprV v -> ExprV 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 v. ExprV v -> ExprV 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 v. Bop -> ExprV v -> ExprV v -> ExprV 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 v. ExprV v -> ExprV v -> ExprV v -> ExprV 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 v. ExprV v -> Sort -> ExprV 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 v. ExprV v -> Sort -> ExprV 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 v. ExprV v -> Symbol -> ExprV 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 v. [ExprV v] -> ExprV 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 v. [ExprV v] -> ExprV 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 v. ExprV v -> ExprV v -> ExprV 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 v. ExprV v -> ExprV v -> ExprV 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 v. Brel -> ExprV v -> ExprV v -> ExprV 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 v. [(Symbol, Sort)] -> ExprV v -> ExprV 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 v. [(Symbol, Sort)] -> ExprV v -> ExprV 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 ()) Sort where
  subt :: (BTyVar, RType BTyCon BTyVar ()) -> Sort -> Sort
subt (BTyVar
v, RVar BTyVar
α ()
_) (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, RType BTyCon BTyVar ())
_ Sort
s          = Sort
s


instance SubsTy Symbol RSort Sort where
  subt :: (Symbol, RType RTyCon RTyVar ()) -> Sort -> Sort
subt (Symbol
v, RVar RTyVar
α ()
_) (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 ())
_ Sort
s          = Sort
s


instance SubsTy RTyVar RSort Sort where
  subt :: (RTyVar, RType RTyCon RTyVar ()) -> Sort -> Sort
subt (RTyVar
v, RType RTyCon RTyVar ()
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 () -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
True RType RTyCon RTyVar ()
sv)
    | Bool
otherwise     = Symbol -> Sort
FObj Symbol
s
  subt (RTyVar, RType RTyCon RTyVar ())
_ Sort
s          = Sort
s

instance (SubsTy tv ty ty) => SubsTy tv ty (PVar ty) where
  subt :: (tv, ty) -> PVar ty -> PVar ty
subt (tv, ty)
su (PV Symbol
n ty
pvk Symbol
v [(ty, Symbol, Expr)]
xts) = Symbol -> ty -> Symbol -> [(ty, Symbol, Expr)] -> PVar ty
forall v t.
Symbol -> t -> Symbol -> [(t, Symbol, ExprV v)] -> PVarV v t
PV Symbol
n ((tv, ty) -> ty -> ty
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su ty
pvk) Symbol
v [((tv, ty) -> ty -> ty
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su ty
t, Symbol
x, Expr
y) | (ty
t,Symbol
x,Expr
y) <- [(ty, Symbol, Expr)]
xts]

instance SubsTy RTyVar RSort RTyCon where
   subt :: (RTyVar, RType RTyCon RTyVar ()) -> RTyCon -> RTyCon
subt (RTyVar, RType RTyCon RTyVar ())
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 ()) -> RPVar -> RPVar
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (RTyVar, RType RTyCon RTyVar ())
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 ()) -> SpecType -> SpecType
subt (RTyVar
α, RType RTyCon RTyVar ()
τ) = (RTyVar, RType RTyCon RTyVar (), SpecType) -> SpecType -> SpecType
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
(tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet (RTyVar
α, RType RTyCon RTyVar ()
τ, RType RTyCon RTyVar () -> SpecType
forall r c tv. Reftable r => RType c tv () -> RType c tv r
ofRSort RType RTyCon RTyVar ()
τ)

instance SubsTy TyVar Type SpecType where
  subt :: (TyVar, Type) -> SpecType -> SpecType
subt (TyVar
α, Type
τ) = (RTyVar, RType RTyCon RTyVar (), SpecType) -> SpecType -> SpecType
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
(tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet (TyVar -> RTyVar
RTV TyVar
α, Type -> RType RTyCon RTyVar ()
forall r. Monoid r => Type -> RRType r
ofType Type
τ, Type -> SpecType
forall r. Monoid 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 ()) -> SpecType -> SpecType
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (RTyVar
α, RTyVar -> () -> RType RTyCon RTyVar ()
forall v c tv r. tv -> r -> RTypeV v c tv r
RVar RTyVar
a () :: RSort)


instance SubsTy RTyVar RSort RSort where
  subt :: (RTyVar, RType RTyCon RTyVar ())
-> RType RTyCon RTyVar () -> RType RTyCon RTyVar ()
subt (RTyVar
α, RType RTyCon RTyVar ()
τ) = (RTyVar, RType RTyCon RTyVar (), RType RTyCon RTyVar ())
-> RType RTyCon RTyVar () -> RType RTyCon RTyVar ()
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
(tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet (RTyVar
α, RType RTyCon RTyVar ()
τ, RType RTyCon RTyVar () -> RType RTyCon RTyVar ()
forall r c tv. Reftable r => RType c tv () -> RType c tv r
ofRSort RType RTyCon RTyVar ()
τ)

instance SubsTy tv RSort Predicate where
  subt :: (tv, RType RTyCon RTyVar ())
-> PredicateV Symbol -> PredicateV Symbol
subt (tv, RType RTyCon RTyVar ())
_ = PredicateV Symbol -> PredicateV 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, RType BTyCon BTyVar ()) -> BTyCon -> BTyCon
subt (BTyVar, RType BTyCon BTyVar ())
_ BTyCon
t = BTyCon
t

instance SubsTy BTyVar BSort BSort where
  subt :: (BTyVar, RType BTyCon BTyVar ())
-> RType BTyCon BTyVar () -> RType BTyCon BTyVar ()
subt (BTyVar
α, RType BTyCon BTyVar ()
τ) = (BTyVar, RType BTyCon BTyVar (), RType BTyCon BTyVar ())
-> RType BTyCon BTyVar () -> RType BTyCon BTyVar ()
forall tv r c.
(Eq tv, Hashable tv, Reftable r, TyConable c,
 SubsTy tv (RType c tv ()) c, SubsTy tv (RType c tv ()) r,
 SubsTy tv (RType c tv ()) (RType c tv ()), FreeVar c tv,
 SubsTy tv (RType c tv ()) tv,
 SubsTy tv (RType c tv ()) (RTVar tv (RType c tv ()))) =>
(tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVarMeet (BTyVar
α, RType BTyCon BTyVar ()
τ, RType BTyCon BTyVar () -> RType BTyCon BTyVar ()
forall r c tv. Reftable r => RType c tv () -> RType c tv r
ofRSort RType BTyCon BTyVar ()
τ)

instance (SubsTy tv ty (UReft r), SubsTy tv ty (RType c tv ())) => 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 ())]
ss (RHole UReft r
p)) = [(Symbol, RType c tv ())]
-> RTypeV Symbol c tv (UReft r) -> RTProp c tv (UReft r)
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp ((RType c tv () -> RType c tv ())
-> (Symbol, RType c tv ()) -> (Symbol, RType c tv ())
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 () -> RType c tv ()
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
m) ((Symbol, RType c tv ()) -> (Symbol, RType c tv ()))
-> [(Symbol, RType c tv ())] -> [(Symbol, RType c tv ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv ())]
ss) (RTypeV Symbol c tv (UReft r) -> RTProp c tv (UReft r))
-> RTypeV Symbol c tv (UReft r) -> RTProp c tv (UReft r)
forall a b. (a -> b) -> a -> b
$ UReft r -> RTypeV Symbol c tv (UReft r)
forall v c tv r. r -> RTypeV v c tv r
RHole (UReft r -> RTypeV Symbol c tv (UReft r))
-> UReft r -> RTypeV 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 ())]
ss RTypeV Symbol c tv (UReft r)
t) = [(Symbol, RType c tv ())]
-> RTypeV Symbol c tv (UReft r) -> RTProp c tv (UReft r)
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp ((RType c tv () -> RType c tv ())
-> (Symbol, RType c tv ()) -> (Symbol, RType c tv ())
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 () -> RType c tv ()
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
m) ((Symbol, RType c tv ()) -> (Symbol, RType c tv ()))
-> [(Symbol, RType c tv ())] -> [(Symbol, RType c tv ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv ())]
ss) (RTypeV Symbol c tv (UReft r) -> RTProp c tv (UReft r))
-> RTypeV Symbol c tv (UReft r) -> RTProp c tv (UReft r)
forall a b. (a -> b) -> a -> b
$ (UReft r -> UReft r)
-> RTypeV Symbol c tv (UReft r) -> RTypeV Symbol c tv (UReft r)
forall a b.
(a -> b) -> RTypeV Symbol c tv a -> RTypeV 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) RTypeV Symbol c tv (UReft r)
t

subvUReft     :: (UsedPVar -> UsedPVar) -> UReft Reft -> UReft Reft
subvUReft :: (UsedPVar -> UsedPVar) -> RReft -> RReft
subvUReft UsedPVar -> UsedPVar
f (MkUReft Reft
r PredicateV Symbol
p) = Reft -> PredicateV Symbol -> RReft
forall v r. r -> PredicateV v -> UReftV v r
MkUReft Reft
r ((UsedPVar -> UsedPVar) -> PredicateV Symbol -> PredicateV Symbol
subvPredicate UsedPVar -> UsedPVar
f PredicateV Symbol
p)

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

--------------------------------------------------------------------------------
ofType :: Monoid r => Type -> RRType r
--------------------------------------------------------------------------------
ofType :: forall r. Monoid r => Type -> RRType r
ofType      = TyConv RTyCon RTyVar r -> Type -> RType RTyCon RTyVar r
forall r c tv. Monoid 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 :: TyVar -> RType RTyCon RTyVar r
tcFVar  = TyVar -> RType RTyCon RTyVar r
forall r c. Monoid r => TyVar -> RType c RTyVar r
rVar
  , tcFTVar :: TyVar -> RTVar RTyVar (RType RTyCon RTyVar ())
tcFTVar = TyVar -> RTVar RTyVar (RType RTyCon RTyVar ())
forall r. Monoid r => TyVar -> 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 a. Monoid a => a
mempty
  , 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.
Monoid 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 :: Monoid r => Type -> BRType r
--------------------------------------------------------------------------------
bareOfType :: forall r. Monoid r => Type -> BRType r
bareOfType  = TyConv BTyCon BTyVar r -> Type -> RType BTyCon BTyVar r
forall r c tv. Monoid 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 :: TyVar -> RType BTyCon BTyVar r
tcFVar  = (BTyVar -> r -> RType BTyCon BTyVar r
forall v c tv r. tv -> r -> RTypeV v c tv r
`RVar` r
forall a. Monoid a => a
mempty) (BTyVar -> RType BTyCon BTyVar r)
-> (TyVar -> BTyVar) -> TyVar -> RType BTyCon BTyVar r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocSymbol -> BTyVar
BTV (LocSymbol -> BTyVar) -> (TyVar -> LocSymbol) -> TyVar -> BTyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TyVar -> Symbol) -> Located TyVar -> LocSymbol
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Located TyVar -> LocSymbol)
-> (TyVar -> Located TyVar) -> TyVar -> LocSymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> Located TyVar
forall a. NamedThing a => a -> Located a
GM.locNamedThing
  , tcFTVar :: TyVar -> RTVar BTyVar (RType BTyCon BTyVar ())
tcFTVar = TyVar -> RTVar BTyVar (RType BTyCon BTyVar ())
forall r. Monoid r => TyVar -> 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 a. Monoid a => a
mempty
  , 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.
Monoid 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_ :: Monoid r => TyConv c tv r -> Type -> RType c tv r
--------------------------------------------------------------------------------
ofType_ :: forall r c tv. Monoid r => TyConv c tv r -> Type -> RType c tv r
ofType_ TyConv c tv r
tx = Type -> RTypeV Symbol c tv r
go (Type -> RTypeV Symbol c tv r)
-> (Type -> Type) -> Type -> RTypeV Symbol c tv r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
expandTypeSynonyms
  where
    go :: Type -> RTypeV Symbol c tv r
go (TyVarTy TyVar
α)
      = TyConv c tv r -> TyVar -> RTypeV Symbol c tv r
forall c tv r. TyConv c tv r -> TyVar -> RType c tv r
tcFVar TyConv c tv r
tx TyVar
α
    go (FunTy FunTyFlag
_ Type
_ Type
τ Type
τ')
      = Symbol
-> RTypeV Symbol c tv r
-> RTypeV Symbol c tv r
-> RTypeV Symbol c tv r
forall r v c tv.
Monoid r =>
Symbol -> RTypeV v c tv r -> RTypeV v c tv r -> RTypeV v c tv r
rFun Symbol
dummySymbol (Type -> RTypeV Symbol c tv r
go Type
τ) (Type -> RTypeV Symbol c tv r
go Type
τ')
    go (ForAllTy (Bndr TyVar
α ForAllTyFlag
_) Type
τ)
      = RTVUV Symbol c tv
-> RTypeV Symbol c tv r -> r -> RTypeV Symbol c tv r
forall v c tv r.
RTVUV v c tv -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAllT (TyConv c tv r -> TyVar -> RTVUV Symbol c tv
forall c tv r. TyConv c tv r -> TyVar -> RTVar tv (RType c tv ())
tcFTVar TyConv c tv r
tx TyVar
α) (Type -> RTypeV Symbol c tv r
go Type
τ) r
forall a. Monoid a => a
mempty
    go (TyConApp TyCon
c [Type]
τs)
      | Just ([TyVar]
αs, Type
τ) <- TyCon -> Maybe ([TyVar], Type)
Ghc.synTyConDefn_maybe TyCon
c
      = Type -> RTypeV Symbol c tv r
go ([TyVar] -> [Type] -> Type -> Type
HasDebugCallStack => [TyVar] -> [Type] -> Type -> Type
substTyWith [TyVar]
αs [Type]
τs Type
τ)
      | Bool
otherwise
      = TyConv c tv r
-> TyCon -> [RTypeV Symbol c tv r] -> RTypeV 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 -> RTypeV Symbol c tv r
go (Type -> RTypeV Symbol c tv r) -> [Type] -> [RTypeV 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)
      = RTypeV Symbol c tv r
-> RTypeV Symbol c tv r -> r -> RTypeV Symbol c tv r
forall v c tv r.
RTypeV v c tv r -> RTypeV v c tv r -> r -> RTypeV v c tv r
RAppTy (Type -> RTypeV Symbol c tv r
go Type
t1) (TyConv c tv r -> Type -> RTypeV Symbol c tv r
forall r c tv. Monoid r => TyConv c tv r -> Type -> RType c tv r
ofType_ TyConv c tv r
tx Type
t2) r
forall a. Monoid a => a
mempty
    go (LitTy TyLit
x)
      = TyConv c tv r -> TyLit -> RTypeV 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 -> RTypeV Symbol c tv r
go Type
t
    go (CoercionTy KindCoercion
_)
      = [Char] -> RTypeV Symbol c tv r
forall a. HasCallStack => [Char] -> a
errorstar [Char]
"Coercion is currently not supported"

ofLitType :: (Monoid r) => (TyCon -> [RType c tv r] -> [p] -> r -> RType c tv r) -> TyLit -> RType c tv r
ofLitType :: forall r c tv p.
Monoid 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 a. Monoid a => a
mempty
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 v c tv r. r -> RTypeV v c tv r
RHole r
forall a. Monoid a => a
mempty
  | 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 a. Monoid a => a
mempty] [] r
forall a. Monoid a => a
mempty

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 -> TyVar -> RType c tv r
tcFVar  :: TyVar -> RType c tv r
  , forall c tv r. TyConv c tv r -> TyVar -> RTVar tv (RType c tv ())
tcFTVar :: TyVar -> RTVar tv (RType c tv ())
  , 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 :: TyVar -> Expr
expr   = TyVar -> Expr
forall a. Symbolic a => a -> Expr
eVar

-- TODO: turn this into a map lookup?
dataConReft ::  DataCon -> [Symbol] -> Reft
dataConReft :: DataCon -> [Symbol] -> Reft
dataConReft DataCon
c []
  | DataCon
c DataCon -> DataCon -> Bool
forall a. Eq a => a -> a -> Bool
== DataCon
trueDataCon
  = Expr -> Reft
forall a. Predicate a => a -> Reft
predReft (Expr -> Reft) -> Expr -> Reft
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 -> Reft
forall a. Predicate a => a -> Reft
predReft (Expr -> Reft) -> Expr -> Reft
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
forall v. ExprV v -> ExprV 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 -> Reft
forall a. Symbolic a => a -> Reft
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
  = Reft
forall a. Monoid a => a
mempty
dataConReft DataCon
c [Symbol]
xs
  = Expr -> Reft
forall a. Expression a => a -> Reft
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
&& [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataCon -> [TyVar]
dataConUnivTyVars DataCon
c)
      = Symbol -> Expr
forall v. v -> ExprV 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
      = LocSymbol -> [Expr] -> Expr
mkEApp (Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc (Symbol -> LocSymbol) -> Symbol -> LocSymbol
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 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Type -> Bool
isBaseTy (Type -> Bool) -> [Type] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map 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 TyVar
_)      = Bool
True
isBaseTy (AppTy Type
_ Type
_)      = Bool
False
isBaseTy (TyConApp TyCon
_ [Type]
ts)  = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Type -> Bool
isBaseTy (Type -> Bool) -> [Type] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
ts
isBaseTy FunTy{}          = Bool
False
isBaseTy (ForAllTy VarBndr TyVar ForAllTyFlag
_ Type
_)   = Bool
False
isBaseTy (LitTy TyLit
_)        = Bool
True
isBaseTy (CastTy Type
_ KindCoercion
_)     = Bool
False
isBaseTy (CoercionTy KindCoercion
_)   = Bool
False


dataConMsReft :: Reftable r => RType c tv r -> [Symbol] -> Reft
dataConMsReft :: forall r c tv. Reftable r => RType c tv r -> [Symbol] -> Reft
dataConMsReft RType c tv r
ty [Symbol]
ys  = Subst -> Reft -> Reft
forall a. Subable a => Subst -> a -> a
subst Subst
su (RType c tv r -> Reft
forall r c tv. Reftable r => RType c tv r -> Reft
rTypeReft (RType c tv r -> RType c tv r
forall t t1 t2. RType t t1 t2 -> RType t t1 t2
ignoreOblig (RType c tv r -> RType c tv r) -> RType c tv r -> RType c tv r
forall a b. (a -> b) -> a -> b
$ RTypeRepV Symbol c tv r -> RType c tv r
forall v c tv r. RTypeRepV v c tv r -> RTypeV v c tv r
ty_res RTypeRepV Symbol c tv r
trep))
  where
    trep :: RTypeRepV Symbol c tv r
trep = RType c tv r -> RTypeRepV Symbol c tv r
forall v c tv r. RTypeV v c tv r -> RTypeRepV v c tv r
toRTypeRep RType c tv r
ty
    xs :: [Symbol]
xs   = RTypeRepV Symbol c tv r -> [Symbol]
forall v c tv r. RTypeRepV v c tv r -> [Symbol]
ty_binds RTypeRepV Symbol c tv r
trep
    ts :: [RType c tv r]
ts   = RTypeRepV Symbol c tv r -> [RType c tv r]
forall v c tv r. RTypeRepV v c tv r -> [RTypeV v c tv r]
ty_args  RTypeRepV Symbol c tv r
trep
    su :: Subst
su   = [(Symbol, Expr)] -> Subst
mkSubst ([(Symbol, Expr)] -> Subst) -> [(Symbol, Expr)] -> Subst
forall a b. (a -> b) -> a -> b
$ [(Symbol
x, Symbol -> Expr
forall v. v -> ExprV v
EVar Symbol
y) | ((Symbol
x, RType c tv r
_), Symbol
y) <- [(Symbol, RType c tv r)]
-> [Symbol] -> [((Symbol, RType c tv r), Symbol)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Symbol] -> [RType c tv r] -> [(Symbol, RType c tv r)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
xs [RType c tv r]
ts) [Symbol]
ys]

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

type ToTypeable r = (Reftable r, PPrint r, SubsTy RTyVar (RRType ()) r, Reftable (RTProp RTyCon RTyVar 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 :: RRType r
t@(RApp RTyCon
c [RRType r]
_ [RTProp RTyCon RTyVar r]
_ r
_) RRType r
t' r
_)
  | Bool
useRFInfo Bool -> Bool -> Bool
&& RTyCon -> Bool
isErasable RTyCon
c = Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t'
  | Bool
otherwise
  = FunTyFlag -> Type -> Type -> Type -> Type
FunTy FunTyFlag
FTF_T_T Type
ManyTy (Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t) (Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType 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
_ RRType r
t RRType r
t' r
_)
  = FunTyFlag -> Type -> Type -> Type -> Type
FunTy FunTyFlag
FTF_T_T Type
ManyTy (Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t) (Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t')
toType Bool
useRFInfo (RAllT RTVar RTyVar (RType RTyCon RTyVar ())
a RRType r
t r
_) | RTV TyVar
α <- RTVar RTyVar (RType RTyCon RTyVar ()) -> RTyVar
forall tv s. RTVar tv s -> tv
ty_var_value RTVar RTyVar (RType RTyCon RTyVar ())
a
  = VarBndr TyVar ForAllTyFlag -> Type -> Type
ForAllTy (TyVar -> ForAllTyFlag -> VarBndr TyVar ForAllTyFlag
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
α ForAllTyFlag
Required) (Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t)
toType Bool
useRFInfo (RAllP RPVar
_ RRType r
t)
  = Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t
toType Bool
_ (RVar (RTV TyVar
α) r
_)
  = TyVar -> Type
TyVarTy TyVar
α
toType Bool
useRFInfo (RApp RTyCon{rtc_tc :: RTyCon -> TyCon
rtc_tc = TyCon
c} [RRType r]
ts [RTProp RTyCon RTyVar r]
_ r
_)
  = TyCon -> [Type] -> Type
TyConApp TyCon
c (Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo (RRType r -> Type) -> [RRType r] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RRType r -> Bool) -> [RRType r] -> [RRType r]
forall a. (a -> Bool) -> [a] -> [a]
filter RRType r -> Bool
forall {v} {c} {tv} {r}. RTypeV v c tv r -> Bool
notExprArg [RRType r]
ts)
  where
    notExprArg :: RTypeV v c tv r -> Bool
notExprArg (RExprArg Located (ExprV v)
_) = Bool
False
    notExprArg RTypeV v c tv r
_            = Bool
True
toType Bool
useRFInfo (RAllE Symbol
_ RRType r
_ RRType r
t)
  = Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t
toType Bool
useRFInfo (REx Symbol
_ RRType r
_ RRType r
t)
  = Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t
toType Bool
useRFInfo (RAppTy RRType r
t (RExprArg Located Expr
_) r
_)
  = Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t
toType Bool
useRFInfo (RAppTy RRType r
t RRType r
t' r
_)
  = Type -> Type -> Type
AppTy (Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t) (Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType r
t')
toType Bool
_ t :: RRType 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]
++ RRType r -> [Char]
forall a. Show a => a -> [Char]
show RRType r
t
toType Bool
useRFInfo (RRTy [(Symbol, RRType r)]
_ r
_ Oblig
_ RRType r
t)
  = Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
useRFInfo RRType 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, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r, Reftable (RTProp RTyCon RTyVar r))
                => TCEmb TyCon -> RRType r -> SortedReft
rTypeSortedReft :: forall r.
(PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar r)) =>
TCEmb TyCon -> RRType r -> SortedReft
rTypeSortedReft TCEmb TyCon
emb RRType r
t = Sort -> Reft -> SortedReft
RR (TCEmb TyCon -> RRType r -> Sort
forall r.
(PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar r)) =>
TCEmb TyCon -> RRType r -> Sort
rTypeSort TCEmb TyCon
emb RRType r
t) (RRType r -> Reft
forall r c tv. Reftable r => RType c tv r -> Reft
rTypeReft RRType r
t)

rTypeSort     ::  (PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r, Reftable (RTProp RTyCon RTyVar r))
              => TCEmb TyCon -> RRType r -> Sort
rTypeSort :: forall r.
(PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar r)) =>
TCEmb TyCon -> RRType r -> Sort
rTypeSort TCEmb TyCon
tce = TCEmb TyCon -> Type -> Sort
typeSort TCEmb TyCon
tce (Type -> Sort) -> (RRType r -> Type) -> RRType r -> Sort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RRType r -> Type
forall r. ToTypeable r => Bool -> RRType r -> Type
toType Bool
True

--------------------------------------------------------------------------------
applySolution :: (Functor f) => FixSolution -> f SpecType -> f SpecType
--------------------------------------------------------------------------------
applySolution :: forall (f :: * -> *).
Functor f =>
FixSolution -> f SpecType -> f SpecType
applySolution = (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)
-> (FixSolution -> SpecType -> SpecType)
-> FixSolution
-> f SpecType
-> f SpecType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RReft -> RReft) -> SpecType -> SpecType
forall a b.
(a -> b)
-> RTypeV Symbol RTyCon RTyVar a -> RTypeV Symbol RTyCon RTyVar b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RReft -> RReft) -> SpecType -> SpecType)
-> (FixSolution -> RReft -> RReft)
-> FixSolution
-> SpecType
-> SpecType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Expr) -> RReft -> RReft
forall {v} {v} {v}.
(ExprV v -> ExprV v) -> UReftV v (ReftV v) -> UReftV v (ReftV v)
mapReft' ((Expr -> Expr) -> RReft -> RReft)
-> (FixSolution -> Expr -> Expr) -> FixSolution -> RReft -> RReft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixSolution -> Expr -> Expr
forall t. Visitable t => FixSolution -> t -> t
appSolRefa
  where
    mapReft' :: (ExprV v -> ExprV v) -> UReftV v (ReftV v) -> UReftV v (ReftV v)
mapReft' ExprV v -> ExprV v
f (MkUReft (Reft (Symbol
x, ExprV v
z)) PredicateV v
p) = ReftV v -> PredicateV v -> UReftV v (ReftV v)
forall v r. r -> PredicateV v -> UReftV v r
MkUReft ((Symbol, ExprV v) -> ReftV v
forall v. (Symbol, ExprV v) -> ReftV v
Reft (Symbol
x, ExprV v -> ExprV v
f ExprV v
z)) PredicateV v
p

appSolRefa :: Visitable t
           => M.HashMap KVar Expr -> t -> t
appSolRefa :: forall t. Visitable t => FixSolution -> t -> t
appSolRefa FixSolution
s t
p = (KVar -> Maybe Expr) -> t -> t
forall t. Visitable t => (KVar -> Maybe Expr) -> t -> t
mapKVars KVar -> Maybe Expr
f t
p
  where
    f :: KVar -> Maybe Expr
f KVar
k        = Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ Expr -> KVar -> FixSolution -> Expr
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault Expr
forall v. ExprV v
PTop KVar
k FixSolution
s

--------------------------------------------------------------------------------
-- shiftVV :: Int -- SpecType -> Symbol -> SpecType
shiftVV :: (TyConable c, Reftable (f Reft), Functor f)
        => RType c tv (f Reft) -> Symbol -> RType c tv (f Reft)
--------------------------------------------------------------------------------
shiftVV :: forall c (f :: * -> *) tv.
(TyConable c, Reftable (f Reft), Functor f) =>
RType c tv (f Reft) -> Symbol -> RType c tv (f Reft)
shiftVV t :: RTypeV Symbol c tv (f Reft)
t@(RApp c
_ [RTypeV Symbol c tv (f Reft)]
ts [RTPropV Symbol c tv (f Reft)]
rs f Reft
r) Symbol
vv'
  = RTypeV Symbol c tv (f Reft)
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 :: RTypeV Symbol c tv (f Reft)
t@(RFun Symbol
_ RFInfo
_ RTypeV Symbol c tv (f Reft)
_ RTypeV Symbol c tv (f Reft)
_ f Reft
r) Symbol
vv'
  = RTypeV Symbol c tv (f Reft)
t { rt_reft = (`F.shiftVV` vv') <$> r }

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

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

shiftVV RTypeV Symbol c tv (f Reft)
t Symbol
_
  = RTypeV Symbol c tv (f Reft)
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 Symbol
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
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 TyVar 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] -> Arity -> Bool
forall a. [a] -> Arity -> Bool
`lengthAtLeast` TyCon -> Arity
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 TyVar
tv)     = TyVar -> Sort
tyVarSort TyVar
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
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             = LocSymbol -> Bool -> Bool -> FTycon
symbolNumInfoFTyCon (Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc (Symbol -> LocSymbol) -> Symbol -> LocSymbol
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 :: TyVar -> Sort
tyVarSort = Symbol -> Sort
FObj (Symbol -> Sort) -> (TyVar -> Symbol) -> TyVar -> Sort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> 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 -> Arity -> Sort) -> Sort -> [Arity] -> Sort
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Arity -> Sort -> Sort) -> Sort -> Arity -> Sort
forall a b c. (a -> b -> c) -> b -> a -> c
flip Arity -> Sort -> Sort
FAbs) (SortSubst -> Sort -> Sort
sortSubst SortSubst
su Sort
t) [Arity
i..Arity
nArity -> Arity -> Arity
forall a. Num a => a -> a -> a
+Arity
iArity -> Arity -> Arity
forall a. Num a => a -> a -> a
-Arity
1]
    ([TyVar]
as, Type
tbody)       = [Char] -> ([TyVar], Type) -> ([TyVar], 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 -> ([TyVar], Type)
splitForAllTyCoVars Type
τ)
    su :: SortSubst
su                = [(Symbol, Sort)] -> SortSubst
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Symbol, Sort)] -> SortSubst) -> [(Symbol, Sort)] -> SortSubst
forall a b. (a -> b) -> a -> b
$ [Symbol] -> [Sort] -> [(Symbol, Sort)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
sas (Arity -> Sort
FVar (Arity -> Sort) -> [Arity] -> [Sort]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  [Arity
i..])
    sas :: [Symbol]
sas               = TyVar -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (TyVar -> Symbol) -> [TyVar] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyVar]
as
    n :: Arity
n                 = [TyVar] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [TyVar]
as
    i :: Arity
i                 = Sort -> Arity
sortAbs Sort
sbody Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ Arity
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]
++ Arity -> [Char]
forall a. Show a => a -> [Char]
show (TyCon -> Arity
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 = Arity -> [Sort] -> Sort
mkFFunc Arity
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, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r, Reftable (RTProp RTyCon RTyVar r))
                  => Var -> RType RTyCon RTyVar r -> RType RTyCon RTyVar r
expandProductType :: forall r.
(PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar r)) =>
TyVar -> RType RTyCon RTyVar r -> RType RTyCon RTyVar r
expandProductType TyVar
x RType RTyCon RTyVar r
t
  | Bool
isTrivial'      = RType RTyCon RTyVar r
t
  | Bool
otherwise       = RTypeRepV Symbol RTyCon RTyVar r -> RType RTyCon RTyVar r
forall v c tv r. RTypeRepV v c tv r -> RTypeV v c tv r
fromRTypeRep (RTypeRepV Symbol RTyCon RTyVar r -> RType RTyCon RTyVar r)
-> RTypeRepV Symbol RTyCon RTyVar r -> RType RTyCon RTyVar r
forall a b. (a -> b) -> a -> b
$ RTypeRepV 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 ()
forall r. Monoid r => Type -> RRType r
ofType (TyVar -> Type
varType TyVar
x) RType RTyCon RTyVar () -> RType RTyCon RTyVar () -> Bool
forall a. Eq a => a -> a -> Bool
== RType RTyCon RTyVar r -> RType RTyCon RTyVar ()
forall v c tv r. RTypeV v c tv r -> RTypeV v c tv ()
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
$ ([TyVar], Type) -> Type
forall a b. (a, b) -> b
snd (([TyVar], Type) -> Type) -> ([TyVar], Type) -> Type
forall a b. (a -> b) -> a -> b
$ Type -> ([TyVar], Type)
splitForAllTyCoVars (Type -> ([TyVar], Type)) -> Type -> ([TyVar], 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 :: RTypeRepV Symbol RTyCon RTyVar r
trep          = RType RTyCon RTyVar r -> RTypeRepV Symbol RTyCon RTyVar r
forall v c tv r. RTypeV v c tv r -> RTypeRepV 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.
(Monoid t, Monoid 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 (RTypeRepV Symbol RTyCon RTyVar r -> [Symbol]
forall v c tv r. RTypeRepV v c tv r -> [Symbol]
ty_binds RTypeRepV Symbol RTyCon RTyVar r
trep) (RTypeRepV Symbol RTyCon RTyVar r -> [RFInfo]
forall v c tv r. RTypeRepV v c tv r -> [RFInfo]
ty_info RTypeRepV Symbol RTyCon RTyVar r
trep) (RTypeRepV Symbol RTyCon RTyVar r -> [RType RTyCon RTyVar r]
forall v c tv r. RTypeRepV v c tv r -> [RTypeV v c tv r]
ty_args RTypeRepV Symbol RTyCon RTyVar r
trep) (RTypeRepV Symbol RTyCon RTyVar r -> [r]
forall v c tv r. RTypeRepV v c tv r -> [r]
ty_refts RTypeRepV 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. (Monoid t, Monoid r)
            => (Type, Symbol, RFInfo, RType RTyCon RTyVar r, t)
            -> [(Symbol, RFInfo, RType RTyCon RTyVar r, t)]
mkProductTy :: forall t r.
(Monoid t, Monoid 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 a. Monoid a => a
mempty) (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. Monoid 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, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar 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, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RTProp RTyCon RTyVar 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.isEqPrimPred 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} {v} {a} {r}. TyConable c => RTypeV v c a r -> [a]
go
  where
    go :: RTypeV v c a r -> [a]
go (RApp c
c [RTypeV v c a r]
ts [RTPropV 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
_) <- [RTypeV v c a r]
ts]
    go RTypeV 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 v c tv.
Reftable r =>
RTypeV v c tv r -> r -> RTypeV v c tv r
`strengthen` RReft
tr)
  where
    tr :: RReft
tr  = Reft -> RReft
forall r v. r -> UReftV v r
uTop (Reft -> RReft) -> Reft -> RReft
forall a b. (a -> b) -> a -> b
$ (Symbol, Expr) -> Reft
forall v. (Symbol, ExprV v) -> ReftV v
Reft (Symbol
forall {a}. IsString a => a
vv', [Expr] -> Expr
forall v. (Fixpoint v, Ord v) => ListNE (ExprV v) -> ExprV 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. (Eq 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 [RTypeV Symbol RTyCon t t1]
_ [RTPropV 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 -> LocSymbol -> [Expr] -> Expr
F.mkEApp LocSymbol
lenLocSymbol [Symbol -> Expr
forall v. v -> ExprV v
F.EVar Symbol
v]
mkDecrFun HashSet TyCon
_ (RVar t
_ t1
_)
  = Symbol -> Expr
forall v. v -> ExprV v
EVar
mkDecrFun HashSet TyCon
_ RTypeV 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 v. (Fixpoint v, Ord v) => ListNE (ExprV v) -> ExprV v
pAnd [Brel -> Expr -> Expr -> Expr
forall v. Brel -> ExprV v -> ExprV v -> ExprV v
PAtom Brel
Lt (t -> Expr
g t
x) (t -> Expr
g t
v), Brel -> Expr -> Expr -> Expr
forall v. Brel -> ExprV v -> ExprV v -> ExprV v
PAtom Brel
Ge (t -> Expr
g t
x) Expr
forall v. ExprV v
zero]
  where zero :: ExprV v
zero = Constant -> ExprV v
forall v. Constant -> ExprV v
ECon (Constant -> ExprV v) -> Constant -> ExprV 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 = Reft -> RReft
forall r v. r -> UReftV v r
uTop (Reft -> RReft) -> Reft -> RReft
forall a b. (a -> b) -> a -> b
$ (Symbol, Expr) -> Reft
forall v. (Symbol, ExprV v) -> ReftV v
Reft (Symbol
forall {a}. IsString a => a
vv', Expr -> Expr -> Expr
forall v. ExprV v -> ExprV v -> ExprV v
PIff (Symbol -> Expr
forall v. v -> ExprV v
EVar Symbol
forall {a}. IsString a => a
vv') (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
forall v. (Fixpoint v, Ord v) => ListNE (ExprV v) -> ExprV 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 v. (Fixpoint v, Ord v) => ListNE (ExprV v) -> ExprV v
pAnd ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$   Brel -> Expr -> Expr -> Expr
forall v. Brel -> ExprV v -> ExprV v -> ExprV v
PAtom Brel
Lt Expr
e' Expr
e
                Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:   Brel -> Expr -> Expr -> Expr
forall v. Brel -> ExprV v -> ExprV v -> ExprV v
PAtom Brel
Ge Expr
e' Expr
forall v. ExprV v
zero
                Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:  [Brel -> Expr -> Expr -> Expr
forall v. Brel -> ExprV v -> ExprV v -> ExprV 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 v. Brel -> ExprV v -> ExprV v -> ExprV v
PAtom Brel
Ge Expr
o' Expr
forall v. ExprV v
zero | (Expr
_,Expr
o') <- [(Expr, Expr)]
old]
    zero :: ExprV v
zero = Constant -> ExprV v
forall v. Constant -> ExprV v
ECon (Constant -> ExprV v) -> Constant -> ExprV 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 -> RTypeV Symbol RTyCon tv r -> Positions tv
forall {v} {a} {r}.
Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
  where
    go :: Maybe Bool -> RTypeV 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 Symbol
_ RFInfo
_ RTypeV v RTyCon a r
t1 RTypeV v RTyCon a r
t2 r
_) = Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go (Maybe Bool -> Maybe Bool
forall {f :: * -> *}. Functor f => f Bool -> f Bool
flip' Maybe Bool
p) RTypeV v RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV v RTyCon a r
t2
    go Maybe Bool
p (RAllT RTVUV v RTyCon a
_ RTypeV v RTyCon a r
t r
_)      = Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV v RTyCon a r
t
    go Maybe Bool
p (RAllP PVUV v RTyCon a
_ RTypeV v RTyCon a r
t)        = Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV v RTyCon a r
t
    go Maybe Bool
p (RApp RTyCon
c [RTypeV v RTyCon a r]
ts [RTPropV v RTyCon a r]
_ r
_)    = [Positions a] -> Positions a
forall a. Monoid a => [a] -> a
mconcat ((Maybe Bool -> RTypeV v RTyCon a r -> Positions a)
-> [Maybe Bool] -> [RTypeV v RTyCon a r] -> [Positions a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Maybe Bool -> RTypeV 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)) [RTypeV v RTyCon a r]
ts)
    go Maybe Bool
p (RAllE Symbol
_ RTypeV v RTyCon a r
t1 RTypeV v RTyCon a r
t2)    = Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV v RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV v RTyCon a r
t2
    go Maybe Bool
p (REx Symbol
_ RTypeV v RTyCon a r
t1 RTypeV v RTyCon a r
t2)      = Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV v RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV v RTyCon a r
t2
    go Maybe Bool
_ (RExprArg Located (ExprV v)
_)       = Positions a
forall a. Monoid a => a
mempty
    go Maybe Bool
p (RAppTy RTypeV v RTyCon a r
t1 RTypeV v RTyCon a r
t2 r
_)   = Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV v RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV v RTyCon a r
t2
    go Maybe Bool
p (RRTy [(Symbol, RTypeV v RTyCon a r)]
_ r
_ Oblig
_ RTypeV v RTyCon a r
t)     = Maybe Bool -> RTypeV v RTyCon a r -> Positions a
go Maybe Bool
p RTypeV 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)