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

-- | 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, 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
  , subsTyVar_meet, subsTyVar_meet', subsTyVar_nomeet
  , subsTyVars_nomeet, subsTyVars_meet

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

  -- * Manipulating Refinements in RTypes
  , strengthen
  , 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 WwLib
import FamInstEnv (emptyFamInstEnv)
import Name             hiding (varName)
import Var
import DataCon
import qualified TyCon  as TC
import           Data.Maybe               (fromMaybe, isJust, fromJust)
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 ((<>)) 
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.Types hiding (R, DataConP (..))
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           Language.Haskell.Liquid.GHC.API        as Ghc hiding (Expr, Located, mapType, tyConName)
import           Language.Haskell.Liquid.GHC.TypeRep () -- Eq Type instance
import Data.List (foldl')



 



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


dataConArgs :: SpecRep -> ([Symbol], [SpecType])
dataConArgs :: RTypeRep RTyCon RTyVar RReft -> ([Symbol], [SpecType])
dataConArgs RTypeRep 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           = RTypeRep RTyCon RTyVar RReft -> [Symbol]
forall c tv r. RTypeRep c tv r -> [Symbol]
ty_binds RTypeRep RTyCon RTyVar RReft
trep
    ts :: [SpecType]
ts           = RTypeRep RTyCon RTyVar RReft -> [SpecType]
forall c tv r. RTypeRep c tv r -> [RType c tv r]
ty_args RTypeRep 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
. RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType


pdVar :: PVar t -> Predicate
pdVar :: PVar t -> Predicate
pdVar PVar t
v        = [UsedPVar] -> Predicate
Pr [PVar t -> UsedPVar
forall t. PVar t -> UsedPVar
uPVar PVar t
v]

findPVar :: [PVar (RType c tv ())] -> UsedPVar -> PVar (RType c tv ())
findPVar :: [PVar (RType c tv ())] -> UsedPVar -> PVar (RType c tv ())
findPVar [PVar (RType c tv ())]
ps UsedPVar
p = Symbol
-> PVKind (RType c tv ())
-> Symbol
-> [(RType c tv (), Symbol, Expr)]
-> PVar (RType c tv ())
forall t.
Symbol -> PVKind t -> Symbol -> [(t, Symbol, Expr)] -> PVar t
PV Symbol
name PVKind (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 t. PVar t -> [(t, Symbol, Expr)]
pargs UsedPVar
p) [(RType c tv (), Symbol, Expr)]
args)
  where
    PV Symbol
name PVKind (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
p) (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 t. PVar t -> Symbol
pname UsedPVar
p) (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 t. PVar t -> Symbol
pname) [PVar (RType c tv ())]
ps
    msg :: a -> a
msg a
p = Maybe SrcSpan -> String -> a
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"RefType.findPVar" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. PPrint a => a -> String
showpp a
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"not found"

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

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

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

uRTypeGen       :: Reftable b => RType c tv a -> RType c tv b
uRTypeGen :: RType c tv a -> RType c tv b
uRTypeGen       = (a -> b) -> RType c tv a -> RType c tv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> RType c tv a -> RType c tv b)
-> (a -> b) -> RType c tv a -> RType 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           :: PVar t -> UsedPVar
uPVar :: PVar t -> UsedPVar
uPVar           = PVar t -> UsedPVar
forall (f :: * -> *) a. Functor f => f a -> f ()
void

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

uTop            ::  r -> UReft r
uTop :: r -> UReft r
uTop r
r          = r -> Predicate -> UReft r
forall r. r -> Predicate -> UReft r
MkUReft r
r Predicate
forall a. Monoid a => a
mempty

--------------------------------------------------------------------
-------------- (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 -> String -> RType c tv r
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"mempty: RType"
  mappend :: RType c tv r -> RType c tv r -> RType c tv r
mappend = 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

-- 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 c tv r. r -> RType 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 c tv r. r -> RType 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 c tv r. r -> RType 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
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
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 -> String -> RTProp c tv r
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 -> String -> RTProp RTyCon RTyVar RReft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 c tv. (r1 -> r2) -> RType c tv r1 -> RType 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 -> String -> Doc
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp RTyCon RTyVar RReft -> Reft
toReft                      = Maybe SrcSpan -> String -> RTProp RTyCon RTyVar RReft -> Reft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable toReft"
  params :: RTProp RTyCon RTyVar RReft -> [Symbol]
params                      = Maybe SrcSpan -> String -> RTProp RTyCon RTyVar RReft -> [Symbol]
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable params for Ref"
  bot :: RTProp RTyCon RTyVar RReft -> RTProp RTyCon RTyVar RReft
bot                         = Maybe SrcSpan
-> String
-> RTProp RTyCon RTyVar RReft
-> RTProp RTyCon RTyVar RReft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable bot    for Ref"
  ofReft :: Reft -> RTProp RTyCon RTyVar RReft
ofReft                      = Maybe SrcSpan -> String -> Reft -> RTProp RTyCon RTyVar RReft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 -> String -> RTProp RTyCon RTyVar ()
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 c tv. (r1 -> r2) -> RType c tv r1 -> RType 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 -> String -> Doc
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp RTyCon RTyVar () -> Reft
toReft                      = Maybe SrcSpan -> String -> RTProp RTyCon RTyVar () -> Reft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable toReft"
  params :: RTProp RTyCon RTyVar () -> [Symbol]
params                      = Maybe SrcSpan -> String -> RTProp RTyCon RTyVar () -> [Symbol]
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable params for Ref"
  bot :: RTProp RTyCon RTyVar () -> RTProp RTyCon RTyVar ()
bot                         = Maybe SrcSpan
-> String -> RTProp RTyCon RTyVar () -> RTProp RTyCon RTyVar ()
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable bot    for Ref"
  ofReft :: Reft -> RTProp RTyCon RTyVar ()
ofReft                      = Maybe SrcSpan -> String -> Reft -> RTProp RTyCon RTyVar ()
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 ())]
_ RType BTyCon BTyVar RReft
t)         = RType BTyCon BTyVar RReft -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial RType BTyCon BTyVar RReft
t
  top :: RTProp BTyCon BTyVar RReft -> RTProp BTyCon BTyVar RReft
top (RProp [(Symbol, RType BTyCon BTyVar ())]
_ (RHole RReft
_))     = Maybe SrcSpan -> String -> RTProp BTyCon BTyVar RReft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable top called on (RProp _ (RHole _))"
  top (RProp [(Symbol, RType BTyCon BTyVar ())]
xs RType BTyCon BTyVar RReft
t)            = [(Symbol, RType BTyCon BTyVar ())]
-> RType BTyCon BTyVar RReft -> RTProp BTyCon BTyVar RReft
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType BTyCon BTyVar ())]
xs (RType BTyCon BTyVar RReft -> RTProp BTyCon BTyVar RReft)
-> RType BTyCon BTyVar RReft -> RTProp BTyCon BTyVar RReft
forall a b. (a -> b) -> a -> b
$ (RReft -> RReft)
-> RType BTyCon BTyVar RReft -> RType BTyCon BTyVar RReft
forall r1 r2 c tv. (r1 -> r2) -> RType c tv r1 -> RType c tv r2
mapReft RReft -> RReft
forall r. Reftable r => r -> r
top RType 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 ())]
_ RType BTyCon BTyVar RReft
_) Doc
_          = Maybe SrcSpan -> String -> Doc
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp BTyCon BTyVar RReft -> Reft
toReft                      = Maybe SrcSpan -> String -> RTProp BTyCon BTyVar RReft -> Reft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable toReft"
  params :: RTProp BTyCon BTyVar RReft -> [Symbol]
params                      = Maybe SrcSpan -> String -> RTProp BTyCon BTyVar RReft -> [Symbol]
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable params for Ref"
  bot :: RTProp BTyCon BTyVar RReft -> RTProp BTyCon BTyVar RReft
bot                         = Maybe SrcSpan
-> String
-> RTProp BTyCon BTyVar RReft
-> RTProp BTyCon BTyVar RReft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable bot    for Ref"
  ofReft :: Reft -> RTProp BTyCon BTyVar RReft
ofReft                      = Maybe SrcSpan -> String -> Reft -> RTProp BTyCon BTyVar RReft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 -> String -> RTProp BTyCon BTyVar ()
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 c tv. (r1 -> r2) -> RType c tv r1 -> RType 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 -> String -> Doc
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp BTyCon BTyVar () -> Reft
toReft                      = Maybe SrcSpan -> String -> RTProp BTyCon BTyVar () -> Reft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable toReft"
  params :: RTProp BTyCon BTyVar () -> [Symbol]
params                      = Maybe SrcSpan -> String -> RTProp BTyCon BTyVar () -> [Symbol]
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable params for Ref"
  bot :: RTProp BTyCon BTyVar () -> RTProp BTyCon BTyVar ()
bot                         = Maybe SrcSpan
-> String -> RTProp BTyCon BTyVar () -> RTProp BTyCon BTyVar ()
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable bot    for Ref"
  ofReft :: Reft -> RTProp BTyCon BTyVar ()
ofReft                      = Maybe SrcSpan -> String -> Reft -> RTProp BTyCon BTyVar ()
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 ())]
_ RType RTyCon RTyVar Reft
t)         = RType RTyCon RTyVar Reft -> Bool
forall r c tv. (Reftable r, TyConable c) => RType c tv r -> Bool
isTrivial RType RTyCon RTyVar Reft
t
  top :: RTProp RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
top (RProp [(Symbol, RType RTyCon RTyVar ())]
_ (RHole Reft
_))     = Maybe SrcSpan -> String -> RTProp RTyCon RTyVar Reft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable top called on (RProp _ (RHole _))"
  top (RProp [(Symbol, RType RTyCon RTyVar ())]
xs RType RTyCon RTyVar Reft
t)            = [(Symbol, RType RTyCon RTyVar ())]
-> RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, RType RTyCon RTyVar ())]
xs (RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ (Reft -> Reft)
-> RType RTyCon RTyVar Reft -> RType RTyCon RTyVar Reft
forall r1 r2 c tv. (r1 -> r2) -> RType c tv r1 -> RType c tv r2
mapReft Reft -> Reft
forall r. Reftable r => r -> r
top RType 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 ())]
_ RType RTyCon RTyVar Reft
_) Doc
_          = Maybe SrcSpan -> String -> Doc
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable ppTy in RProp"
  toReft :: RTProp RTyCon RTyVar Reft -> Reft
toReft                      = Maybe SrcSpan -> String -> RTProp RTyCon RTyVar Reft -> Reft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable toReft"
  params :: RTProp RTyCon RTyVar Reft -> [Symbol]
params                      = Maybe SrcSpan -> String -> RTProp RTyCon RTyVar Reft -> [Symbol]
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable params for Ref"
  bot :: RTProp RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
bot                         = Maybe SrcSpan
-> String -> RTProp RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType: Reftable bot    for Ref"
  ofReft :: Reft -> RTProp RTyCon RTyVar Reft
ofReft                      = Maybe SrcSpan -> String -> Reft -> RTProp RTyCon RTyVar Reft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 RType 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]
++ RType RTyCon RTyVar Reft -> [Symbol]
forall a. Subable a => a -> [Symbol]
syms RType 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 ())]
-> RType 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (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) (RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ Reft -> RType RTyCon RTyVar Reft
forall c tv r. r -> RType c tv r
RHole (Reft -> RType RTyCon RTyVar Reft)
-> Reft -> RType 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 RType RTyCon RTyVar Reft
r)  = [(Symbol, RType RTyCon RTyVar ())]
-> RType 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (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) (RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ Subst -> RType RTyCon RTyVar Reft -> RType RTyCon RTyVar Reft
forall a. Subable a => Subst -> a -> a
subst Subst
su RType 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 ())]
-> RType 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((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) (RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ Reft -> RType RTyCon RTyVar Reft
forall c tv r. r -> RType c tv r
RHole (Reft -> RType RTyCon RTyVar Reft)
-> Reft -> RType 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 RType RTyCon RTyVar Reft
r) = [(Symbol, RType RTyCon RTyVar ())]
-> RType 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((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) (RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ (Symbol -> Expr)
-> RType RTyCon RTyVar Reft -> RType RTyCon RTyVar Reft
forall a. Subable a => (Symbol -> Expr) -> a -> a
substf Symbol -> Expr
f RType 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 ())]
-> RType 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((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) (RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ Reft -> RType RTyCon RTyVar Reft
forall c tv r. r -> RType c tv r
RHole (Reft -> RType RTyCon RTyVar Reft)
-> Reft -> RType 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 RType RTyCon RTyVar Reft
r) = [(Symbol, RType RTyCon RTyVar ())]
-> RType 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((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) (RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft)
-> RType RTyCon RTyVar Reft -> RTProp RTyCon RTyVar Reft
forall a b. (a -> b) -> a -> b
$ (Symbol -> Symbol)
-> RType RTyCon RTyVar Reft -> RType RTyCon RTyVar Reft
forall a. Subable a => (Symbol -> Symbol) -> a -> a
substa Symbol -> Symbol
f RType 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 -> String -> RType RTyCon RTyVar r -> Doc -> Doc
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"ppTy RProp Reftable"
  toReft :: RType RTyCon RTyVar r -> Reft
toReft      = Maybe SrcSpan -> String -> RType RTyCon RTyVar r -> Reft
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"toReft on RType"
  params :: RType RTyCon RTyVar r -> [Symbol]
params      = Maybe SrcSpan -> String -> RType RTyCon RTyVar r -> [Symbol]
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"params on RType"
  bot :: RType RTyCon RTyVar r -> RType RTyCon RTyVar r
bot         = Maybe SrcSpan
-> String -> RType RTyCon RTyVar r -> RType RTyCon RTyVar r
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"bot on RType"
  ofReft :: Reft -> RType RTyCon RTyVar r
ofReft      = Maybe SrcSpan -> String -> Reft -> RType RTyCon RTyVar r
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"ofReft on RType"


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



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

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

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

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

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

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

-- MOVE TO TYPES
instance (Eq c, Eq tv, Hashable tv, PPrint tv, TyConable c, PPrint c, 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 :: HashMap k k -> RType a k () -> RType a k () -> Bool
eqRSort HashMap k k
m (RAllP PVU a k
_ RType a k ()
t) (RAllP PVU a k
_ RType a k ()
t')
  = HashMap k k -> RType a k () -> RType 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 RType a k ()
t RType a k ()
t'
eqRSort HashMap k k
m (RAllP PVU a k
_ RType a k ()
t) RType a k ()
t'
  = HashMap k k -> RType a k () -> RType 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 RType a k ()
t RType a k ()
t'
eqRSort HashMap k k
m (RAllT RTVU a k
a RType a k ()
t ()
_) (RAllT RTVU a k
a' RType a k ()
t' ()
_)
  | RTVU a k
a RTVU a k -> RTVU a k -> Bool
forall a. Eq a => a -> a -> Bool
== RTVU a k
a'
  = HashMap k k -> RType a k () -> RType 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 RType a k ()
t RType a k ()
t'
  | Bool
otherwise
  = HashMap k k -> RType a k () -> RType 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 (RTVU a k -> k
forall tv s. RTVar tv s -> tv
ty_var_value RTVU a k
a') (RTVU a k -> k
forall tv s. RTVar tv s -> tv
ty_var_value RTVU a k
a) HashMap k k
m) RType a k ()
t RType a k ()
t'
eqRSort HashMap k k
m (RAllT RTVU a k
_ RType a k ()
t ()
_) RType a k ()
t'
  = HashMap k k -> RType a k () -> RType 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 RType a k ()
t RType a k ()
t'
eqRSort HashMap k k
m RType a k ()
t (RAllT RTVU a k
_ RType a k ()
t' ()
_)
  = HashMap k k -> RType a k () -> RType 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 RType a k ()
t RType a k ()
t'
eqRSort HashMap k k
m (RFun Symbol
_ RType a k ()
t1 RType a k ()
t2 ()
_) (RFun Symbol
_ RType a k ()
t1' RType a k ()
t2' ()
_)
  = HashMap k k -> RType a k () -> RType 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 RType a k ()
t1 RType a k ()
t1' Bool -> Bool -> Bool
&& HashMap k k -> RType a k () -> RType 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 RType a k ()
t2 RType a k ()
t2'
eqRSort HashMap k k
m (RAppTy RType a k ()
t1 RType a k ()
t2 ()
_) (RAppTy RType a k ()
t1' RType a k ()
t2' ()
_)
  = HashMap k k -> RType a k () -> RType 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 RType a k ()
t1 RType a k ()
t1' Bool -> Bool -> Bool
&& HashMap k k -> RType a k () -> RType 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 RType a k ()
t2 RType a k ()
t2'
eqRSort HashMap k k
m (RApp a
c [RType a k ()]
ts [RTProp a k ()]
_ ()
_) (RApp a
c' [RType a k ()]
ts' [RTProp a k ()]
_ ()
_)
  = a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c' Bool -> Bool -> Bool
&& [RType a k ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RType a k ()]
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [RType a k ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RType a k ()]
ts' Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((RType a k () -> RType a k () -> Bool)
-> [RType a k ()] -> [RType a k ()] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (HashMap k k -> RType a k () -> RType 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) [RType a k ()]
ts [RType 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 ()
_) RType a k ()
_
  = Bool
True
eqRSort HashMap k k
_ RType a k ()
_         (RHole ()
_)
  = Bool
True
eqRSort HashMap k k
_ RType a k ()
_ RType 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 Var
α == :: RTyVar -> RTyVar -> Bool
== RTV Var
α' = Var
α Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
α' Bool -> Bool -> Bool
&& Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
α OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
α'

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

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

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

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

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

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

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

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

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

bTVar :: Monoid r => TyVar -> RTVar BTyVar (BRType r)
bTVar :: Var -> RTVar BTyVar (BRType r)
bTVar Var
a = BTyVar -> RTVInfo (BRType r) -> RTVar BTyVar (BRType r)
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar (Symbol -> BTyVar
BTV (Var -> Symbol
forall a. Symbolic a => a -> Symbol
symbol Var
a)) (Var -> RTVInfo (BRType r)
forall r. Monoid r => Var -> RTVInfo (BRType r)
bTVarInfo Var
a)

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

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

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

kindToRType :: Monoid r => Type -> RRType r
kindToRType :: 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 :: 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_ :: (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
typeNatKind    = Type
intTy
     | Bool
otherwise           = Type
t

isValKind :: Kind -> Bool
isValKind :: Type -> Bool
isValKind Type
x = Type
x Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
typeNatKind Bool -> Bool -> Bool
|| Type
x Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
typeSymbolKind

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

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

bareRTyVar :: BTyVar -> RTyVar
bareRTyVar :: BTyVar -> RTyVar
bareRTyVar (BTV Symbol
tv) = Symbol -> RTyVar
symbolRTyVar Symbol
tv

normalizePds :: (OkRT c tv r) => RType c tv r -> RType c tv r
normalizePds :: 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 :: PVar (RType c tv ()) -> RType c tv r -> RType c tv r
rPred     = PVar (RType c tv ()) -> RType c tv r -> RType c tv r
forall c tv r. PVU c tv -> RType c tv r -> RType c tv r
RAllP

rEx :: Foldable t
    => t (Symbol, RType c tv r) -> RType c tv r -> RType c tv r
rEx :: 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
t = ((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 (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 c tv r.
Symbol -> RType c tv r -> RType c tv r -> RType c tv r
REx Symbol
x RType c tv r
tx RType c tv r
t) RType c tv r
t t (Symbol, RType c tv r)
xts

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

gApp :: TyCon -> [RTyVar] -> [PVar a] -> SpecType
gApp :: TyCon -> [RTyVar] -> [PVar a] -> SpecType
gApp TyCon
tc [RTyVar]
αs [PVar a]
πs = TyCon
-> [SpecType] -> [RTProp RTyCon RTyVar RReft] -> RReft -> SpecType
forall tv r.
TyCon
-> [RType RTyCon tv r]
-> [RTProp RTyCon tv r]
-> r
-> RType RTyCon tv r
rApp TyCon
tc
                  [Var -> SpecType
forall r c. Monoid r => Var -> RType c RTyVar r
rVar Var
α | RTV Var
α <- [RTyVar]
αs]
                  ([(Symbol, RType RTyCon RTyVar ())]
-> RReft -> RTProp RTyCon RTyVar RReft
forall τ r c tv. [(Symbol, τ)] -> r -> Ref τ (RType 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 :: PVar t -> RReft
pdVarReft = (\Predicate
p -> Reft -> Predicate -> RReft
forall r. r -> Predicate -> UReft r
MkUReft Reft
forall a. Monoid a => a
mempty Predicate
p) (Predicate -> RReft) -> (PVar t -> Predicate) -> PVar t -> RReft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVar t -> Predicate
forall t. PVar t -> Predicate
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 :: TyCon -> [BRType r] -> [BRProp r] -> r -> BRType r
bApp TyCon
c = BTyCon -> [BRType r] -> [BRProp r] -> r -> BRType r
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp (TyCon -> BTyCon
tyConBTyCon TyCon
c)

tyConBTyCon :: TyCon -> BTyCon
tyConBTyCon :: TyCon -> BTyCon
tyConBTyCon = LocSymbol -> BTyCon
mkBTyCon (LocSymbol -> BTyCon) -> (TyCon -> LocSymbol) -> TyCon -> BTyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TyCon -> Symbol) -> Located TyCon -> LocSymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyCon -> Symbol
tyConName (Located TyCon -> LocSymbol)
-> (TyCon -> Located TyCon) -> TyCon -> LocSymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> Located TyCon
forall a. NamedThing a => a -> Located a
GM.locNamedThing
-- tyConBTyCon = mkBTyCon . fmap symbol . locNamedThing

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

addPds :: Foldable t
       => t (PVar (RType c tv ())) -> RType c tv r -> RType c tv r
addPds :: t (PVar (RType c tv ())) -> RType c tv r -> RType c tv r
addPds t (PVar (RType c tv ()))
ps (RAllT RTVU c tv
v RType c tv r
t r
r) = RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT RTVU c tv
v (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 t (PVar (RType c tv ()))
ps RType c tv r
t) r
r 
addPds t (PVar (RType c tv ()))
ps RType c tv r
t             = (RType c tv r -> PVar (RType c tv ()) -> RType c tv r)
-> RType c tv r -> t (PVar (RType c tv ())) -> RType c tv r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((PVar (RType c tv ()) -> RType c tv r -> RType c tv r)
-> RType c tv r -> PVar (RType c tv ()) -> RType c tv r
forall a b c. (a -> b -> c) -> b -> a -> c
flip PVar (RType c tv ()) -> RType c tv r -> RType c tv r
forall c tv r. PVU c tv -> RType c tv r -> RType c tv r
rPred) RType 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 :: [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 (RImpF Symbol
b RType c tv r
t1 RType c tv r
t2 r
r)
 = (Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RImpF Symbol
b 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 (RFun Symbol
b RType c tv r
t1 RType c tv r
t2 r
r)
 = (Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RFun Symbol
b 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 c tv r. RType c tv r -> RType c tv r -> r -> RType 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 RTVU c tv
v RType c tv r
t r
r)
 = (RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT RTVU 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 c
_ [RType c tv r]
_ [RTProp c tv r]
_ r
_)
 = (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 Symbol
_ RType c tv r
_ RType c tv r
_)
 = (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 Symbol
_ RType c tv r
_ RType c tv r
_)
 = (RType c tv r
t, [PVar (RType c tv ())]
ps)
nlzP [PVar (RType c tv ())]
_ RType c tv r
t
 = Maybe SrcSpan -> String -> (RType c tv r, [PVar (RType c tv ())])
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing (String -> (RType c tv r, [PVar (RType c tv ())]))
-> String -> (RType c tv r, [PVar (RType c tv ())])
forall a b. (a -> b) -> a -> b
$ String
"RefType.nlzP: cannot handle " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RType c tv r -> String
forall a. Show a => a -> String
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 :: RType c tv r -> RType c tv r -> RType c tv r
strengthenRefTypeGen RType c tv r
t1 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
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 ()), Eq tv, Eq tv, Hashable tv,
 Hashable tv) =>
RType c tv r -> RType c tv r -> RType c tv r
f RType c tv r
t1 RType c tv r
t2
  where
    f :: RType c tv r -> RType c tv r -> RType c tv r
f (RVar tv
v1 r
r1) RType c tv r
t  = tv -> r -> RType c tv r
forall c tv r. tv -> r -> RType 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 RType c tv r
t (RVar tv
_ r
r1)  = RType c tv r
t RType c tv r -> r -> RType c tv r
forall r c tv. Reftable r => RType c tv r -> r -> RType c tv r
`strengthen` r
r1
    f RType c tv r
t1 RType c tv r
t2           = Maybe SrcSpan -> String -> RType c tv r
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing (String -> RType c tv r) -> String -> RType c tv r
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"strengthenRefTypeGen on differently shaped types \nt1 = %s [shape = %s]\nt2 = %s [shape = %s]"
                         (RType c tv r -> String
forall c tv r. OkRT c tv r => RType c tv r -> String
pprt_raw RType c tv r
t1) (RType c tv () -> String
forall a. PPrint a => a -> String
showpp (RType c tv r -> RType c tv ()
forall c tv r. RType c tv r -> RType c tv ()
toRSort RType c tv r
t1)) (RType c tv r -> String
forall c tv r. OkRT c tv r => RType c tv r -> String
pprt_raw RType c tv r
t2) (RType c tv () -> String
forall a. PPrint a => a -> String
showpp (RType c tv r -> RType c tv ()
forall c tv r. RType c tv r -> RType c tv ()
toRSort RType c tv r
t2))

pprt_raw :: (OkRT c tv r) => RType c tv r -> String
pprt_raw :: RType c tv r -> String
pprt_raw = Doc -> String
render (Doc -> String) -> (RType c tv r -> Doc) -> RType c tv r -> String
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 :: RType c tv r -> RType c tv r -> RType c tv r
strengthenRefType RType c tv r
t1 RType c tv r
t2
  | Bool
True -- _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
x RType c tv r
_ -> RType c tv r
x) RType c tv r
t1 RType c tv r
t2
  | Bool
otherwise
  = Maybe SrcSpan -> String -> RType c tv r
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
msg
  where
    msg :: String
msg = String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"strengthen on differently shaped reftypes \nt1 = %s [shape = %s]\nt2 = %s [shape = %s]"
            (RType c tv r -> String
forall a. PPrint a => a -> String
showpp RType c tv r
t1) (RType c tv () -> String
forall a. PPrint a => a -> String
showpp (RType c tv r -> RType c tv ()
forall c tv r. RType c tv r -> RType c tv ()
toRSort RType c tv r
t1)) (RType c tv r -> String
forall a. PPrint a => a -> String
showpp RType c tv r
t2) (RType c tv () -> String
forall a. PPrint a => a -> String
showpp (RType c tv r -> RType c tv ()
forall c tv r. RType c tv r -> RType c tv ()
toRSort RType c tv r
t2))

_meetable :: (OkRT c tv r) => RType c tv r -> RType c tv r -> Bool
_meetable :: RType c tv r -> RType c tv r -> Bool
_meetable RType c tv r
t1 RType c tv r
t2 = RType c tv r -> RType c tv ()
forall c tv r. RType c tv r -> RType c tv ()
toRSort RType c tv r
t1 RType c tv () -> RType c tv () -> Bool
forall a. Eq a => a -> a -> Bool
== RType c tv r -> RType c tv ()
forall c tv r. RType c tv r -> RType c tv ()
toRSort RType c tv r
t2

strengthenRefType_ :: (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 RTVU c tv
a1 RType c tv r
t1 r
r1) (RAllT RTVU c tv
a2 RType c tv r
t2 r
r2)
  = RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT RTVU 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
subsTyVar_meet (RTVU c tv -> tv
forall tv s. RTVar tv s -> tv
ty_var_value RTVU c tv
a2, RType c tv r -> RType c tv ()
forall c tv r. RType c tv r -> RType 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 c tv r. tv -> r -> RType c tv r
RVar (RTVU c tv -> tv
forall tv s. RTVar tv s -> tv
ty_var_value RTVU 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 RTVU c tv
a RType c tv r
t1 r
r1) RType c tv r
t2
  = RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT RTVU 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 RTVU c tv
a RType c tv r
t2 r
r2)
  = RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT RTVU 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 PVU c tv
p1 RType c tv r
t1) (RAllP PVU c tv
_ RType c tv r
t2)
  = PVU c tv -> RType c tv r -> RType c tv r
forall c tv r. PVU c tv -> RType c tv r -> RType c tv r
RAllP PVU 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 PVU c tv
p RType c tv r
t1) RType c tv r
t2
  = PVU c tv -> RType c tv r -> RType c tv r
forall c tv r. PVU c tv -> RType c tv r -> RType c tv r
RAllP PVU 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 PVU c tv
p RType c tv r
t2)
  = PVU c tv -> RType c tv r -> RType c tv r
forall c tv r. PVU c tv -> RType c tv r -> RType c tv r
RAllP PVU 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 c tv r.
Symbol -> RType c tv r -> RType c tv r -> RType 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 c tv r.
Symbol -> RType c tv r -> RType c tv r -> RType 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 c tv r.
Symbol -> RType c tv r -> RType c tv r -> RType 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 c tv r. RType c tv r -> RType c tv r -> r -> RType 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 (RImpF Symbol
x1 RType c tv r
t1 RType c tv r
t1' r
r1) (RImpF Symbol
x2 RType c tv r
t2 RType c tv r
t2' r
r2)
  = Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RImpF Symbol
x2 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 -> (Symbol, Expr) -> RType c tv r
forall a. Subable a => a -> (Symbol, Expr) -> a
subst1 RType c tv r
t1' (Symbol
x1, Symbol -> Expr
EVar Symbol
x2)) RType c tv r
t2'

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RFun Symbol
x1 RType c tv r
t1 RType c tv r
t1' r
r1) (RFun Symbol
x2 RType c tv r
t2 RType c tv r
t2' r
r2)
  = Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RFun Symbol
x2 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 -> (Symbol, Expr) -> RType c tv r
forall a. Subable a => a -> (Symbol, Expr) -> a
subst1 RType c tv r
t1' (Symbol
x1, Symbol -> Expr
EVar Symbol
x2)) RType c tv r
t2'

strengthenRefType_ RType c tv r -> RType c tv r -> RType c tv r
f (RApp c
tid [RType c tv r]
t1s [RTProp c tv r]
rs1 r
r1) (RApp c
_ [RType c tv r]
t2s [RTProp c tv r]
rs2 r
r2)
  = c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp c
tid [RType c tv r]
ts [RTProp 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 :: [RTProp c tv r]
rs  = [RTProp c tv r] -> [RTProp c tv r] -> [RTProp c tv r]
forall r. Reftable r => [r] -> [r] -> [r]
meets [RTProp c tv r]
rs1 [RTProp 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 c tv r. tv -> r -> RType 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 :: (F.Reftable r) => [r] -> [r] -> [r]
meets :: [r] -> [r] -> [r]
meets [] [r]
rs                 = [r]
rs
meets [r]
rs []                 = [r]
rs
meets [r]
rs [r]
rs'
  | [r] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [r]
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [r] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [r]
rs' = (r -> r -> r) -> [r] -> [r] -> [r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith r -> r -> r
forall r. Reftable r => r -> r -> r
meet [r]
rs [r]
rs'
  | Bool
otherwise               = Maybe SrcSpan -> String -> [r]
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"meets: unbalanced rs"

strengthen :: Reftable r => RType c tv r -> r -> RType c tv r
strengthen :: RType c tv r -> r -> RType c tv r
strengthen (RApp c
c [RType c tv r]
ts [RTProp c tv r]
rs r
r) r
r'  = c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType 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
`F.meet` r
r')
strengthen (RVar tv
a r
r) r
r'        = tv -> r -> RType c tv r
forall c tv r. tv -> r -> RType c tv r
RVar tv
a       (r
r r -> r -> r
forall r. Reftable r => r -> r -> r
`F.meet` r
r')
strengthen (RImpF Symbol
b RType c tv r
t1 RType c tv r
t2 r
r) r
r' = Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RImpF Symbol
b RType c tv r
t1 RType c tv r
t2 (r
r r -> r -> r
forall r. Reftable r => r -> r -> r
`F.meet` r
r')
strengthen (RFun Symbol
b RType c tv r
t1 RType c tv r
t2 r
r) r
r'  = Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RFun Symbol
b RType c tv r
t1 RType c tv r
t2 (r
r r -> r -> r
forall r. Reftable r => r -> r -> r
`F.meet` r
r')
strengthen (RAppTy RType c tv r
t1 RType c tv r
t2 r
r) r
r'  = RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r. RType c tv r -> RType c tv r -> r -> RType c tv r
RAppTy RType c tv r
t1 RType c tv r
t2 (r
r r -> r -> r
forall r. Reftable r => r -> r -> r
`F.meet` r
r')
strengthen (RAllT RTVU c tv
a RType c tv r
t r
r)    r
r'  = RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT RTVU c tv
a RType c tv r
t    (r
r r -> r -> r
forall r. Reftable r => r -> r -> r
`F.meet` r
r')
strengthen RType c tv r
t r
_                  = RType c tv r
t


quantifyRTy :: (Monoid r, Eq tv) => [RTVar tv (RType c tv ())] -> RType c tv r -> RType c tv r
quantifyRTy :: [RTVar tv (RType c tv ())] -> RType c tv r -> RType c tv r
quantifyRTy [RTVar tv (RType c tv ())]
tvs RType c tv r
ty = (RTVar tv (RType c tv ()) -> RType c tv r -> RType c tv r)
-> RType c tv r -> [RTVar tv (RType c tv ())] -> RType c tv r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RTVar tv (RType c tv ()) -> RType c tv r -> RType c tv r
forall r c tv.
Monoid r =>
RTVU c tv -> RType c tv r -> RType c tv r
rAllT RType c tv r
ty [RTVar tv (RType c tv ())]
tvs
  where rAllT :: RTVU c tv -> RType c tv r -> RType c tv r
rAllT RTVU c tv
a RType c tv r
t = RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT RTVU c tv
a RType c tv r
t r
forall a. Monoid a => a
mempty

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


-------------------------------------------------------------------------
addTyConInfo :: (PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r, Reftable (RTProp RTyCon RTyVar r))
             => TCEmb TyCon
             -> TyConMap -- (M.HashMap TyCon RTyCon)
             -> RRType r
             -> RRType r
-------------------------------------------------------------------------
addTyConInfo :: TCEmb TyCon -> TyConMap -> RRType r -> RRType r
addTyConInfo TCEmb TyCon
tce TyConMap
tyi = (RRType r -> RRType r) -> RRType r -> RRType 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 -> RRType r -> RRType r
forall r.
(PPrint r, Reftable r, SubsTy RTyVar (RType RTyCon RTyVar ()) r,
 Reftable (RRProp 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 :: TCEmb TyCon -> TyConMap -> RRType r -> RRType r
expandRApp TCEmb TyCon
tce TyConMap
tyi t :: RRType r
t@(RApp {}) = RTyCon -> [RRType r] -> [RTProp RTyCon RTyVar r] -> r -> RRType r
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp RTyCon
rc' [RRType r]
ts [RTProp RTyCon RTyVar r]
rs' r
r
  where
    RApp RTyCon
rc [RRType r]
ts [RTProp RTyCon RTyVar 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' :: [RTProp RTyCon RTyVar r]
rs'                        = [RTProp RTyCon RTyVar r]
-> ([RTProp RTyCon RTyVar r] -> [RTProp RTyCon RTyVar r])
-> [RTProp RTyCon RTyVar r]
-> [RTProp RTyCon RTyVar r]
forall b a. b -> ([a] -> b) -> [a] -> b
applyNonNull [RTProp RTyCon RTyVar r]
rs0 (RTyCon
-> [RPVar] -> [RTProp RTyCon RTyVar r] -> [RTProp RTyCon RTyVar r]
forall a r c tv.
(Fixpoint a, 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) [RTProp RTyCon RTyVar r]
rs
    rs0 :: [RTProp RTyCon RTyVar r]
rs0                        = RPVar -> RTProp RTyCon RTyVar 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 -> RTProp RTyCon RTyVar r)
-> [RPVar] -> [RTProp RTyCon RTyVar r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPVar]
pvs
    n :: Int
n                          = [Var] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Var]
fVs
    fVs :: [Var]
fVs                        = TyCon -> [Var]
GM.tyConTyVarsDef (TyCon -> [Var]) -> TyCon -> [Var]
forall a b. (a -> b) -> a -> b
$ RTyCon -> TyCon
rtc_tc RTyCon
rc
    as :: [RRType r]
as                         = Int -> [RRType r] -> [RRType r] -> [RRType r]
forall a. Int -> [a] -> [a] -> [a]
choosen Int
n [RRType r]
ts (Var -> RRType r
forall r c. Monoid r => Var -> RType c RTyVar r
rVar (Var -> RRType r) -> [Var] -> [RRType r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
fVs)
expandRApp TCEmb TyCon
_ TyConMap
_ RRType r
t               = RRType r
t

choosen :: Int -> [a] -> [a] -> [a]
choosen :: Int -> [a] -> [a] -> [a]
choosen Int
0 [a]
_ [a]
_           = []
choosen Int
i (a
x:[a]
xs) (a
_:[a]
ys) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:Int -> [a] -> [a] -> [a]
forall a. Int -> [a] -> [a] -> [a]
choosen (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs [a]
ys
choosen Int
i []     (a
y:[a]
ys) = a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:Int -> [a] -> [a] -> [a]
forall a. Int -> [a] -> [a] -> [a]
choosen (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [] [a]
ys
choosen Int
_ [a]
_ [a]
_           = Maybe SrcSpan -> String -> [a]
forall a. Maybe SrcSpan -> String -> a
impossible Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 :: PVar (RType c tv ()) -> Ref (RType c tv ()) (RType c tv r)
rtPropTop PVar (RType c tv ())
pv = case PVar (RType c tv ()) -> PVKind (RType c tv ())
forall t. PVar t -> PVKind t
ptype PVar (RType c tv ())
pv of
                 PVProp RType c tv ()
t -> [(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 ())]
xts (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 ()
t
                 PVKind (RType c tv ())
PVHProp  -> [(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 ())]
xts (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 r
forall a. Monoid a => a
mempty
               where
                 xts :: [(Symbol, RType c tv ())]
xts      =  PVar (RType c tv ()) -> [(Symbol, RType c tv ())]
forall t. PVar t -> [(Symbol, t)]
pvArgs 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 :: 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 :: 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 (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 t. PVar t -> t
pvType PVar (RType c tv ())
pv) RType c tv r -> r -> RType c tv r
forall r c tv. Reftable r => RType c tv r -> r -> RType 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)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PVar (RType c tv ()) -> [(RType c tv (), Symbol, Expr)]
forall t. PVar t -> [(t, Symbol, Expr)]
pargs PVar (RType c tv ())
pv) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Symbol, RType c tv ())] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
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 :: PVar t -> [(Symbol, t)]
pvArgs PVar t
pv = [(Symbol
s, t
t) | (t
t, Symbol
s, Expr
_) <- PVar t -> [(t, Symbol, Expr)]
forall t. PVar t -> [(t, Symbol, Expr)]
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 :: TCEmb TyCon
-> TyConMap -> RTyCon -> [RRType r] -> (RTyCon, [RPVar])
appRTyCon TCEmb TyCon
tce TyConMap
tyi RTyCon
rc [RRType r]
ts = String -> (RTyCon, [RPVar]) -> (RTyCon, [RPVar])
forall a. PPrint a => String -> a -> a
F.notracepp String
_msg (RTyCon
resTc, [RPVar]
ps'') 
  where
    _msg :: String
_msg  = String
"appRTyCon-family: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Bool, Int, [Type]) -> String
forall a. PPrint a => a -> String
showpp (TyCon -> Bool
Ghc.isFamilyTyCon TyCon
c, TyCon -> Int
Ghc.tyConRealArity TyCon
c, RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType (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 (Var -> RTyVar
RTV (Var -> RTyVar) -> [Var] -> [RTyVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
α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 (t :: * -> *) a. Foldable t => t a -> Bool
null [RRType r]
ts then Var -> RType RTyCon RTyVar ()
forall r c. Monoid r => Var -> RType c RTyVar r
rVar (Var -> RType RTyCon RTyVar ())
-> [Var] -> [RType RTyCon RTyVar ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
βs else RRType r -> RType RTyCon RTyVar ()
forall c tv r. RType c tv r -> RType 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 :: [Var]
αs  = TyCon -> [Var]
GM.tyConTyVarsDef (RTyCon -> TyCon
rtc_tc RTyCon
rc')
        βs :: [Var]
βs  = TyCon -> [Var]
GM.tyConTyVarsDef TyCon
c
    
    rc'' :: RTyCon
rc''  = if TCEmb TyCon -> RTyCon -> Bool
isNumeric TCEmb TyCon
tce RTyCon
rc' then RTyCon -> RTyCon
addNumSizeFun RTyCon
rc' else RTyCon
rc'

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

-- | @famInstTyConMb rc args@ uses the @RTyCon@ AND @args@ to see if 
--   this is a family instance @RTyCon@, and if so, returns it.
--   see [NOTE:FamInstPredVars]
--   eg: 'famInstTyConMb tyi Field [Blob, a]' should give 'Just R:FieldBlob' 
    
famInstTyConMb :: TyConMap -> RTyCon -> [F.Sort] -> Maybe RTyCon
famInstTyConMb :: TyConMap -> RTyCon -> [Sort] -> Maybe RTyCon
famInstTyConMb TyConMap
tyi RTyCon
rc [Sort]
ts = do 
  let c :: TyCon
c = RTyCon -> TyCon
rtc_tc RTyCon
rc
  Int
n    <- TyCon -> HashMap TyCon Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup TyCon
c      (TyConMap -> HashMap TyCon Int
tcmFtcArity TyConMap
tyi)
  (TyCon, [Sort]) -> HashMap (TyCon, [Sort]) RTyCon -> Maybe RTyCon
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (TyCon
c, Int -> [Sort] -> [Sort]
forall a. Int -> [a] -> [a]
take Int
n [Sort]
ts) (TyConMap -> HashMap (TyCon, [Sort]) RTyCon
tcmFIRTy    TyConMap
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) -> String -> Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type])
forall a. PPrint a => String -> a -> a
F.notracepp (String
"famInstArgs: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (TyCon, Int, [Type]) -> String
forall a. PPrint a => a -> String
F.showpp (TyCon
c, Int
cArity, [Type]
ts)) 
                     (Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type]))
-> Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type])
forall a b. (a -> b) -> a -> b
$ (TyCon, [Type]) -> Maybe (TyCon, [Type])
forall a. a -> Maybe a
Just (TyCon
c', Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
take ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cArity) [Type]
ts) 
    Maybe (TyCon, [Type])
Nothing       -> Maybe (TyCon, [Type])
forall a. Maybe a
Nothing
    where 
      cArity :: Int
cArity      = TyCon -> Int
Ghc.tyConRealArity TyCon
c

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

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




-- | @plainTyConPVars@ uses the @TyCon@ to return the 
--   "refined" @RTyCon@ and @RPVars@ from the refined 
--   'data' definition for the @TyCon@, e.g. will use 
--   'List Int' to return 'List<p> Int' (if List has an abs-ref).
plainRTyConPVars :: TyConMap -> RTyCon -> (RTyCon, [RPVar])
plainRTyConPVars :: TyConMap -> RTyCon -> (RTyCon, [RPVar])
plainRTyConPVars TyConMap
tyi RTyCon
rc = (RTyCon
rc', RTyCon -> [RPVar]
rTyConPVs RTyCon
rc') 
  where 
    rc' :: RTyCon
rc'                   = RTyCon -> TyCon -> HashMap TyCon RTyCon -> RTyCon
forall k v. (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 :: TyConInfo
rtc_info = (RTyCon -> TyConInfo
rtc_info RTyCon
c) {sizeFunction :: Maybe SizeFun
sizeFunction = SizeFun -> Maybe SizeFun
forall a. a -> Maybe a
Just SizeFun
IdSizeFun } }


generalize :: (Eq tv, Monoid r) => RType c tv r -> RType c tv r
generalize :: RType c tv r -> RType c tv r
generalize RType c tv r
t = [(RTVar tv (RType c tv ()), r)]
-> [PVar (RType c tv ())] -> RType c tv r -> RType c tv r
forall (t :: * -> *) (t1 :: * -> *) tv c r.
(Foldable t, Foldable t1) =>
t (RTVar tv (RType c tv ()), r)
-> t1 (PVar (RType c tv ())) -> RType c tv r -> RType c tv r
mkUnivs ([RTVar tv (RType c tv ())]
-> [r] -> [(RTVar tv (RType c tv ()), r)]
forall a b. [a] -> [b] -> [(a, b)]
zip (RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t) (r -> [r]
forall a. a -> [a]
repeat r
forall a. Monoid a => a
mempty)) [] RType c tv r
t

allTyVars :: (Ord tv) => RType c tv r -> [tv]
allTyVars :: RType c tv r -> [tv]
allTyVars RType c tv r
t = [tv] -> [tv]
forall a. Ord a => [a] -> [a]
sortNub ([tv] -> [tv])
-> ([RTVar tv (RType c tv ())] -> [tv])
-> [RTVar tv (RType c tv ())]
-> [tv]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RTVar tv (RType c tv ()) -> tv)
-> [RTVar tv (RType c tv ())] -> [tv]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RTVar tv (RType c tv ()) -> tv
forall tv s. RTVar tv s -> tv
ty_var_value ([RTVar tv (RType c tv ())] -> [tv])
-> [RTVar tv (RType c tv ())] -> [tv]
forall a b. (a -> b) -> a -> b
$ [RTVar tv (RType c tv ())]
vs [RTVar tv (RType c tv ())]
-> [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a. [a] -> [a] -> [a]
++ [RTVar tv (RType c tv ())]
vs'
  where
    vs :: [RTVar tv (RType c tv ())]
vs      = ((RTVar tv (RType c tv ()), r) -> RTVar tv (RType c tv ()))
-> [(RTVar tv (RType c tv ()), r)] -> [RTVar tv (RType c tv ())]
forall a b. (a -> b) -> [a] -> [b]
map (RTVar tv (RType c tv ()), r) -> RTVar tv (RType c tv ())
forall a b. (a, b) -> a
fst ([(RTVar tv (RType c tv ()), r)] -> [RTVar tv (RType c tv ())])
-> (RType c tv r -> [(RTVar tv (RType c tv ()), r)])
-> RType c tv r
-> [RTVar tv (RType c tv ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(RTVar tv (RType c tv ()), r)], [PVar (RType c tv ())],
 RType c tv r)
-> [(RTVar tv (RType c tv ()), r)]
forall a b c. (a, b, c) -> a
fst3 (([(RTVar tv (RType c tv ()), r)], [PVar (RType c tv ())],
  RType c tv r)
 -> [(RTVar tv (RType c tv ()), r)])
-> (RType c tv r
    -> ([(RTVar tv (RType c tv ()), r)], [PVar (RType c tv ())],
        RType c tv r))
-> RType c tv r
-> [(RTVar tv (RType c tv ()), r)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RType c tv r
-> ([(RTVar tv (RType c tv ()), r)], [PVar (RType c tv ())],
    RType c tv r)
forall tv c r.
RType tv c r
-> ([(RTVar c (RType tv c ()), r)], [PVar (RType tv c ())],
    RType tv c r)
bkUniv (RType c tv r -> [RTVar tv (RType c tv ())])
-> RType c tv r -> [RTVar tv (RType c tv ())]
forall a b. (a -> b) -> a -> b
$ RType c tv r
t
    vs' :: [RTVar tv (RType c tv ())]
vs'     = RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars    (RType c tv r -> [RTVar tv (RType c tv ())])
-> RType c tv r -> [RTVar tv (RType c tv ())]
forall a b. (a -> b) -> a -> b
$ RType c tv r
t

freeTyVars :: Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars :: RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars (RAllP PVU c tv
_ RType c tv r
t)     = RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t
freeTyVars (RAllT RTVar tv (RType c tv ())
α RType c tv r
t r
_)   = RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t [RTVar tv (RType c tv ())]
-> [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [RTVar tv (RType c tv ())
α]
freeTyVars (RImpF Symbol
_ RType c tv r
t RType c tv r
t' r
_)= RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t [RTVar tv (RType c tv ())]
-> [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t'
freeTyVars (RFun Symbol
_ RType c tv r
t RType c tv r
t' r
_) = RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t [RTVar tv (RType c tv ())]
-> [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t'
freeTyVars (RApp c
_ [RType c tv r]
ts [RTProp c tv r]
_ r
_) = [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a. Eq a => [a] -> [a]
L.nub ([RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())])
-> [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a b. (a -> b) -> a -> b
$ (RType c tv r -> [RTVar tv (RType c tv ())])
-> [RType c tv r] -> [RTVar tv (RType c tv ())]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars [RType c tv r]
ts
freeTyVars (RVar tv
α r
_)      = [tv -> RTVar tv (RType c tv ())
forall tv s. tv -> RTVar tv s
makeRTVar tv
α]
freeTyVars (RAllE Symbol
_ RType c tv r
tx RType c tv r
t)  = RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
tx [RTVar tv (RType c tv ())]
-> [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t
freeTyVars (REx Symbol
_ RType c tv r
tx RType c tv r
t)    = RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
tx [RTVar tv (RType c tv ())]
-> [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t
freeTyVars (RExprArg Located Expr
_)    = []
freeTyVars (RAppTy RType c tv r
t RType c tv r
t' r
_) = RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t [RTVar tv (RType c tv ())]
-> [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a. Eq a => [a] -> [a] -> [a]
`L.union` RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars RType c tv r
t'
freeTyVars (RHole r
_)       = []
freeTyVars (RRTy [(Symbol, RType c tv r)]
e r
_ Oblig
_ RType c tv r
t)  = [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a. Eq a => [a] -> [a]
L.nub ([RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())])
-> [RTVar tv (RType c tv ())] -> [RTVar tv (RType c tv ())]
forall a b. (a -> b) -> a -> b
$ (RType c tv r -> [RTVar tv (RType c tv ())])
-> [RType c tv r] -> [RTVar tv (RType c tv ())]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RType c tv r -> [RTVar tv (RType c tv ())]
forall tv c r. Eq tv => RType c tv r -> [RTVar tv (RType c tv ())]
freeTyVars (RType c tv r
tRType c tv r -> [RType c tv r] -> [RType c tv r]
forall a. a -> [a] -> [a]
:((Symbol, RType c tv r) -> RType c tv r
forall a b. (a, b) -> b
snd ((Symbol, RType c tv r) -> RType c tv r)
-> [(Symbol, RType c tv r)] -> [RType c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv r)]
e))


tyClasses :: (OkRT RTyCon tv r) => RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses :: RType RTyCon tv r -> [(Class, [RType RTyCon tv r])]
tyClasses (RAllP PVU 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 RTVU 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 (RImpF Symbol
_ 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 (RFun Symbol
_ 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 [RTProp 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 -> String -> [(Class, [RType RTyCon tv r])]
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing (String
"RefType.tyClasses cannot handle" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RType RTyCon tv r -> String
forall a. Show a => a -> String
show RType RTyCon tv r
t)


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

subsTyVars_meet
  :: (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
subsTyVars_meet :: t (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVars_meet        = 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

subsTyVars_nomeet
  :: (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
subsTyVars_nomeet :: t (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVars_nomeet      = 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

subsTyVar_nomeet
  :: (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
subsTyVar_nomeet :: (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVar_nomeet       = 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

subsTyVar_meet
  :: (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
subsTyVar_meet :: (tv, RType c tv (), RType c tv r) -> RType c tv r -> RType c tv r
subsTyVar_meet         = 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

subsTyVar_meet'
  :: (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
subsTyVar_meet' :: (tv, RType c tv r) -> RType c tv r -> RType c tv r
subsTyVar_meet' (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
subsTyVar_meet (tv
α, RType c tv r -> RType c tv ()
forall c tv r. RType c tv r -> RType 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 :: 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 (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 :: 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 :: 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 PVU c tv
π RType c tv r
t)
  = PVU c tv -> RType c tv r -> RType c tv r
forall c tv r. PVU c tv -> RType c tv r -> RType c tv r
RAllP ((tv, RType c tv ()) -> PVU c tv -> PVU c tv
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
α, RType c tv ()
τ) PVU 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 RTVU c tv
α RType c tv r
t r
r)
  -- subt inside the type variable instantiates the kind of the variable
  = RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT ((tv, RType c tv ()) -> RTVU c tv -> RTVU c tv
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv
a, RType c tv ()
τ) RTVU 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 (RTVU c tv -> tv
forall tv s. RTVar tv s -> tv
ty_var_value RTVU 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
_) (RImpF Symbol
x RType c tv r
t RType c tv r
t' r
r)
  = Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RImpF 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') ((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
_) (RFun Symbol
x RType c tv r
t RType c tv r
t' r
r)
  = Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RFun 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') ((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 [RTProp c tv r]
rs r
r)
  = c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType 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)
-> RTProp c tv r
-> RTProp 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 (RTProp c tv r -> RTProp c tv r)
-> [RTProp c tv r] -> [RTProp c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RTProp 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 c tv. Reftable r => RType c tv r -> r -> RType 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 c tv r. tv -> r -> RType 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 c tv r.
Symbol -> RType c tv r -> RType c tv r -> RType 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 c tv r.
Symbol -> RType c tv r -> RType c tv r -> RType 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 c tv r.
[(Symbol, RType c tv r)]
-> r -> Oblig -> RType c tv r -> RType c tv r
RRTy ((RType c tv r -> RType c tv r)
-> (Symbol, RType c tv r) -> (Symbol, RType c tv r)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (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 c tv r. r -> RType 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 :: 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 (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 :: 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 [RType c tv r]
ts [RTProp c tv r]
rs r
r) RType c tv r
t' r
r'
  = Bool
-> HashSet tv
-> c
-> [RType c tv r]
-> [RTProp c tv r]
-> 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
-> 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 [RType c tv r] -> [RType c tv r] -> [RType c tv r]
forall a. [a] -> [a] -> [a]
++ [RType c tv r
t']) [RTProp c tv r]
rs r
r r
r'
subsFreeRAppTy Bool
_ HashSet tv
_ RType c tv r
t RType c tv r
t' r
r'
  = RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r. RType c tv r -> RType c tv r -> r -> RType c tv r
RAppTy RType c tv r
t RType 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 :: 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
_rep1, RType c tv r
_rep2, RType c tv r
t1, RType c tv r
t2] <- [RType c tv r]
ts
  = Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RFun Symbol
dummySymbol 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 c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType 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 c tv r. RType c tv r -> RType 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 :: r -> r
refAppTyToFun r
r
  | r -> Bool
forall r. Reftable r => r -> Bool
isTauto r
r = r
r
  | Bool
otherwise = Maybe SrcSpan -> String -> r
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 :: 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 -> RTProp 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((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 c tv r. r -> RType 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 -> RTProp 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((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 -> RTProp c tv r) -> RType c tv r -> RTProp 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 (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 :: [(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 (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 Var
x, RType RTyCon RTyVar ()
t) (RTV Var
z) | Var -> Bool
isTyVar Var
z, Var -> Type
tyVarKind Var
z Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Var -> Type
TyVarTy Var
x
    = Var -> RTyVar
RTV (Var -> Type -> Var
setVarType Var
z (Type -> Var) -> Type -> Var
forall a b. (a -> b) -> a -> b
$ RType RTyCon RTyVar () -> Type
forall r. ToTypeable r => RRType r -> Type
toType 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 :: RTyVar
ty_var_value = (RTyVar, RType RTyCon RTyVar ()) -> RTyVar -> RTyVar
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (RTyVar, RType RTyCon RTyVar ())
su (RTyVar -> RTyVar) -> RTyVar -> RTyVar
forall a b. (a -> b) -> a -> b
$ RTVar RTyVar (RType RTyCon RTyVar ()) -> RTyVar
forall tv s. RTVar tv s -> tv
ty_var_value RTVar RTyVar (RType RTyCon RTyVar ())
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
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 BTyVar
v r
r)
    | Symbol -> BTyVar
BTV Symbol
x BTyVar -> BTyVar -> Bool
forall a. Eq a => a -> a -> Bool
== BTyVar
v = BTyVar -> r -> BRType r
forall c tv r. tv -> r -> RType c tv r
RVar (Symbol -> BTyVar
BTV Symbol
y) r
r 
    | Bool
otherwise  = BTyVar -> r -> BRType r
forall c tv r. tv -> r -> RType c tv r
RVar BTyVar
v r
r 
  subt (Symbol
x, Symbol
y) (RAllT (RTVar BTyVar
v RTVInfo (RType BTyCon BTyVar ())
i) BRType r
t r
r)
    | Symbol -> BTyVar
BTV Symbol
x BTyVar -> BTyVar -> Bool
forall a. Eq a => a -> a -> Bool
== BTyVar
v = RTVar BTyVar (RType BTyCon BTyVar ()) -> BRType r -> r -> BRType r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT (BTyVar
-> RTVInfo (RType BTyCon BTyVar ())
-> RTVar BTyVar (RType BTyCon BTyVar ())
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar BTyVar
v RTVInfo (RType BTyCon BTyVar ())
i) BRType r
t r
r
    | Bool
otherwise  = RTVar BTyVar (RType BTyCon BTyVar ()) -> BRType r -> r -> BRType r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT (BTyVar
-> RTVInfo (RType BTyCon BTyVar ())
-> RTVar BTyVar (RType BTyCon BTyVar ())
forall tv s. tv -> RTVInfo s -> RTVar tv s
RTVar BTyVar
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 BRType r
t1 BRType r
t2 r
r)  = Symbol -> BRType r -> BRType r -> r -> BRType r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RFun 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) r
r 
  subt (Symbol, Symbol)
su (RImpF Symbol
x BRType r
t1 BRType r
t2 r
r) = Symbol -> BRType r -> BRType r -> r -> BRType r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RImpF 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) r
r
  subt (Symbol, Symbol)
su (RAllP PVU BTyCon BTyVar
p BRType r
t)       = PVU BTyCon BTyVar -> BRType r -> BRType r
forall c tv r. PVU c tv -> RType c tv r -> RType c tv r
RAllP PVU 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 [RTProp BTyCon BTyVar r]
ps r
r)  = BTyCon -> [BRType r] -> [RTProp BTyCon BTyVar r] -> r -> BRType r
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType 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)
-> RTProp BTyCon BTyVar r -> RTProp BTyCon BTyVar r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su (RTProp BTyCon BTyVar r -> RTProp BTyCon BTyVar r)
-> [RTProp BTyCon BTyVar r] -> [RTProp BTyCon BTyVar r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RTProp 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 c tv r.
Symbol -> RType c tv r -> RType c tv r -> RType 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 c tv r.
Symbol -> RType c tv r -> RType c tv r -> RType 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 c tv r. Located Expr -> RType 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 c tv r. RType c tv r -> RType c tv r -> r -> RType 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 c tv r.
[(Symbol, RType c tv r)]
-> r -> Oblig -> RType c tv r -> RType 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 c tv r. r -> RType 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 RType BTyCon BTyVar r
t) =  [(Symbol, RType BTyCon BTyVar ())]
-> RType 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) -> RType BTyCon BTyVar r -> RType BTyCon BTyVar r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (Symbol, Symbol)
su RType 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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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 (RType RTyCon RTyVar () -> Type
forall r. ToTypeable r => RRType r -> Type
toType 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 (PVKind ty) where
  subt :: (tv, ty) -> PVKind ty -> PVKind ty
subt (tv, ty)
su (PVProp ty
t) = ty -> PVKind ty
forall t. t -> PVKind t
PVProp ((tv, ty) -> ty -> ty
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su ty
t)
  subt (tv, ty)
_   PVKind ty
PVHProp   = PVKind ty
forall t. PVKind t
PVHProp

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 PVKind ty
t Symbol
v [(ty, Symbol, Expr)]
xts) = Symbol -> PVKind ty -> Symbol -> [(ty, Symbol, Expr)] -> PVar ty
forall t.
Symbol -> PVKind t -> Symbol -> [(t, Symbol, Expr)] -> PVar t
PV Symbol
n ((tv, ty) -> PVKind ty -> PVKind ty
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su PVKind ty
t) 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

-- NOTE: This DOES NOT substitute at the binders
instance SubsTy RTyVar RSort PrType where
  subt :: (RTyVar, RType RTyCon RTyVar ()) -> PrType -> PrType
subt (RTyVar
α, RType RTyCon RTyVar ()
τ) = (RTyVar, RType RTyCon RTyVar (), PrType) -> PrType -> PrType
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
subsTyVar_meet (RTyVar
α, RType RTyCon RTyVar ()
τ, RType RTyCon RTyVar () -> PrType
forall r c tv. Reftable r => RType c tv () -> RType c tv r
ofRSort RType RTyCon RTyVar ()
τ)

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
subsTyVar_meet (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 :: (Var, Type) -> SpecType -> SpecType
subt (Var
α, 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
subsTyVar_meet (Var -> RTyVar
RTV Var
α, 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 c tv r. tv -> r -> RType 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
subsTyVar_meet (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 ()) -> Predicate -> Predicate
subt (tv, RType RTyCon RTyVar ())
_ = Predicate -> Predicate
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 :: r
ur_reft = (tv, ty) -> r -> r
forall tv ty a. SubsTy tv ty a => (tv, ty) -> a -> a
subt (tv, ty)
su (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$ UReft r -> r
forall r. UReft r -> r
ur_reft UReft r
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
subsTyVar_meet (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 ())]
-> RType 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((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) (RType c tv (UReft r) -> RTProp c tv (UReft r))
-> RType c tv (UReft r) -> RTProp c tv (UReft r)
forall a b. (a -> b) -> a -> b
$ UReft r -> RType c tv (UReft r)
forall c tv r. r -> RType c tv r
RHole (UReft r -> RType c tv (UReft r))
-> UReft r -> RType 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 RType c tv (UReft r)
t) = [(Symbol, RType c tv ())]
-> RType 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 b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((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) (RType c tv (UReft r) -> RTProp c tv (UReft r))
-> RType c tv (UReft r) -> RTProp c tv (UReft r)
forall a b. (a -> b) -> a -> b
$ (UReft r -> UReft r)
-> RType c tv (UReft r) -> RType c tv (UReft r)
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) RType c tv (UReft r)
t

subvUReft     :: (UsedPVar -> UsedPVar) -> UReft Reft -> UReft Reft
subvUReft :: (UsedPVar -> UsedPVar) -> RReft -> RReft
subvUReft UsedPVar -> UsedPVar
f (MkUReft Reft
r Predicate
p) = Reft -> Predicate -> RReft
forall r. r -> Predicate -> UReft r
MkUReft Reft
r ((UsedPVar -> UsedPVar) -> Predicate -> Predicate
subvPredicate UsedPVar -> UsedPVar
f Predicate
p)

subvPredicate :: (UsedPVar -> UsedPVar) -> Predicate -> Predicate
subvPredicate :: (UsedPVar -> UsedPVar) -> Predicate -> Predicate
subvPredicate UsedPVar -> UsedPVar
f (Pr [UsedPVar]
pvs) = [UsedPVar] -> Predicate
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 :: Type -> RRType r
ofType      = TyConv RTyCon RTyVar r -> Type -> RRType r
forall r c tv. Monoid r => TyConv c tv r -> Type -> RType c tv r
ofType_ (TyConv RTyCon RTyVar r -> Type -> RRType r)
-> TyConv RTyCon RTyVar r -> Type -> RRType r
forall a b. (a -> b) -> a -> b
$ TyConv :: forall c tv r.
(Var -> RType c tv r)
-> (Var -> RTVar tv (RType c tv ()))
-> (TyCon -> [RType c tv r] -> RType c tv r)
-> (TyLit -> RType c tv r)
-> TyConv c tv r
TyConv
  { tcFVar :: Var -> RRType r
tcFVar  = Var -> RRType r
forall r c. Monoid r => Var -> RType c RTyVar r
rVar
  , tcFTVar :: Var -> RTVar RTyVar (RType RTyCon RTyVar ())
tcFTVar = Var -> RTVar RTyVar (RType RTyCon RTyVar ())
forall r. Monoid r => Var -> RTVar RTyVar (RRType r)
rTVar
  , tcFApp :: TyCon -> [RRType r] -> RRType r
tcFApp  = \TyCon
c [RRType r]
ts -> TyCon -> [RRType r] -> [RTProp RTyCon RTyVar r] -> r -> RRType r
forall tv r.
TyCon
-> [RType RTyCon tv r]
-> [RTProp RTyCon tv r]
-> r
-> RType RTyCon tv r
rApp TyCon
c [RRType r]
ts [] r
forall a. Monoid a => a
mempty
  , tcFLit :: TyLit -> RRType r
tcFLit  = (TyCon -> [RRType r] -> [RTProp RTyCon RTyVar r] -> r -> RRType r)
-> TyLit -> RRType 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 -> [RRType r] -> [RTProp RTyCon RTyVar r] -> r -> RRType 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 :: Type -> BRType r
bareOfType  = TyConv BTyCon BTyVar r -> Type -> BRType r
forall r c tv. Monoid r => TyConv c tv r -> Type -> RType c tv r
ofType_ (TyConv BTyCon BTyVar r -> Type -> BRType r)
-> TyConv BTyCon BTyVar r -> Type -> BRType r
forall a b. (a -> b) -> a -> b
$ TyConv :: forall c tv r.
(Var -> RType c tv r)
-> (Var -> RTVar tv (RType c tv ()))
-> (TyCon -> [RType c tv r] -> RType c tv r)
-> (TyLit -> RType c tv r)
-> TyConv c tv r
TyConv
  { tcFVar :: Var -> BRType r
tcFVar  = (BTyVar -> r -> BRType r
forall c tv r. tv -> r -> RType c tv r
`RVar` r
forall a. Monoid a => a
mempty) (BTyVar -> BRType r) -> (Var -> BTyVar) -> Var -> BRType r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> BTyVar
BTV (Symbol -> BTyVar) -> (Var -> Symbol) -> Var -> BTyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Symbol
forall a. Symbolic a => a -> Symbol
symbol
  , tcFTVar :: Var -> RTVar BTyVar (RType BTyCon BTyVar ())
tcFTVar = Var -> RTVar BTyVar (RType BTyCon BTyVar ())
forall r. Monoid r => Var -> RTVar BTyVar (BRType r)
bTVar
  , tcFApp :: TyCon -> [BRType r] -> BRType r
tcFApp  = \TyCon
c [BRType r]
ts -> TyCon -> [BRType r] -> [BRProp r] -> r -> BRType r
forall r. TyCon -> [BRType r] -> [BRProp r] -> r -> BRType r
bApp TyCon
c [BRType r]
ts [] r
forall a. Monoid a => a
mempty
  , tcFLit :: TyLit -> BRType r
tcFLit  = (TyCon -> [BRType r] -> [BRProp r] -> r -> BRType r)
-> TyLit -> BRType 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 -> [BRType r] -> [BRProp r] -> r -> BRType 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_ :: TyConv c tv r -> Type -> RType c tv r
ofType_ TyConv c tv r
tx = Type -> RType c tv r
go (Type -> RType c tv r) -> (Type -> Type) -> Type -> RType c tv r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
expandTypeSynonyms
  where
    go :: Type -> RType c tv r
go (TyVarTy Var
α)
      = TyConv c tv r -> Var -> RType c tv r
forall c tv r. TyConv c tv r -> Var -> RType c tv r
tcFVar TyConv c tv r
tx Var
α
    go (FunTy AnonArgFlag
_ Type
τ Type
τ')
      = Symbol -> RType c tv r -> RType c tv r -> RType c tv r
forall r c tv.
Monoid r =>
Symbol -> RType c tv r -> RType c tv r -> RType c tv r
rFun Symbol
dummySymbol (Type -> RType c tv r
go Type
τ) (Type -> RType c tv r
go Type
τ')
    go (ForAllTy (Bndr Var
α ArgFlag
_) Type
τ)
      = RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT (TyConv c tv r -> Var -> RTVU c tv
forall c tv r. TyConv c tv r -> Var -> RTVar tv (RType c tv ())
tcFTVar TyConv c tv r
tx Var
α) (Type -> RType c tv r
go Type
τ) r
forall a. Monoid a => a
mempty
    go (TyConApp TyCon
c [Type]
τs)
      | Just ([Var]
αs, Type
τ) <- TyCon -> Maybe ([Var], Type)
TC.synTyConDefn_maybe TyCon
c
      = Type -> RType c tv r
go (HasCallStack => [Var] -> [Type] -> Type -> Type
[Var] -> [Type] -> Type -> Type
substTyWith [Var]
αs [Type]
τs Type
τ)
      | Bool
otherwise
      = TyConv c tv r -> TyCon -> [RType c tv r] -> RType 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 -> RType c tv r
go (Type -> RType c tv r) -> [Type] -> [RType c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
τs) -- [] mempty
    go (AppTy Type
t1 Type
t2)
      = RType c tv r -> RType c tv r -> r -> RType c tv r
forall c tv r. RType c tv r -> RType c tv r -> r -> RType c tv r
RAppTy (Type -> RType c tv r
go Type
t1) (TyConv c tv r -> Type -> RType 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 -> RType 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 -> RType c tv r
go Type
t
    go (CoercionTy KindCoercion
_)
      = String -> RType c tv r
forall a. HasCallStack => String -> a
errorstar String
"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 :: (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 c tv r. r -> RType 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
  { TyConv c tv r -> Var -> RType c tv r
tcFVar  :: TyVar -> RType c tv r
  , TyConv c tv r -> Var -> RTVar tv (RType c tv ())
tcFTVar :: TyVar -> RTVar tv (RType c tv ())
  , TyConv c tv r -> TyCon -> [RType c tv r] -> RType c tv r
tcFApp  :: TyCon -> [RType c tv r] -> RType c tv r
  , TyConv c tv r -> TyLit -> RType c tv r
tcFLit  :: TyLit -> RType c tv r
  }

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


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

-- TODO: turn this into a map lookup?
dataConReft ::  DataCon -> [Symbol] -> Reft
dataConReft :: DataCon -> [Symbol] -> 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
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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Symbol]
xs Bool -> Bool -> Bool
&& [Var] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataCon -> [Var]
dataConUnivTyVars DataCon
c)
      = Symbol -> Expr
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
<$> DataCon -> [Type]
dataConOrigArgTys DataCon
c [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ DataCon -> [Type]
dataConRepArgTys DataCon
c

isBaseTy :: Type -> Bool
isBaseTy :: Type -> Bool
isBaseTy (TyVarTy Var
_)     = Bool
True
isBaseTy (AppTy Type
_ Type
_)     = Bool
False
isBaseTy (TyConApp TyCon
_ [Type]
ts) = [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  AnonArgFlag
_ Type
_ Type
_)  = Bool
False
isBaseTy (ForAllTy VarBndr Var ArgFlag
_ 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 :: 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
$ RTypeRep c tv r -> RType c tv r
forall c tv r. RTypeRep c tv r -> RType c tv r
ty_res RTypeRep c tv r
trep))
  where
    trep :: RTypeRep c tv r
trep = RType c tv r -> RTypeRep c tv r
forall c tv r. RType c tv r -> RTypeRep c tv r
toRTypeRep RType c tv r
ty
    xs :: [Symbol]
xs   = RTypeRep c tv r -> [Symbol]
forall c tv r. RTypeRep c tv r -> [Symbol]
ty_binds RTypeRep c tv r
trep
    ts :: [RType c tv r]
ts   = RTypeRep c tv r -> [RType c tv r]
forall c tv r. RTypeRep c tv r -> [RType c tv r]
ty_args  RTypeRep 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
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
toType  :: (ToTypeable r) => RRType r -> Type
toType :: RRType r -> Type
toType (RImpF Symbol
x RRType r
t RRType r
t' r
r)
 = RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType (Symbol -> RRType r -> RRType r -> r -> RRType r
forall c tv r.
Symbol -> RType c tv r -> RType c tv r -> r -> RType c tv r
RFun Symbol
x RRType r
t RRType r
t' r
r)
toType (RFun Symbol
_ RRType r
t RRType r
t' r
_)
  = AnonArgFlag -> Type -> Type -> Type
FunTy AnonArgFlag
VisArg (RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t) (RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t') -- FIXME(adinapoli) Is 'VisArg' correct here?
toType (RAllT RTVar RTyVar (RType RTyCon RTyVar ())
a RRType r
t r
_) | RTV Var
α <- RTVar RTyVar (RType RTyCon RTyVar ()) -> RTyVar
forall tv s. RTVar tv s -> tv
ty_var_value RTVar RTyVar (RType RTyCon RTyVar ())
a
  = VarBndr Var ArgFlag -> Type -> Type
ForAllTy (Var -> ArgFlag -> VarBndr Var ArgFlag
forall var argf. var -> argf -> VarBndr var argf
Bndr Var
α ArgFlag
Required) (RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t)
toType (RAllP RPVar
_ RRType r
t)
  = RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t
toType (RVar (RTV Var
α) r
_)
  = Var -> Type
TyVarTy Var
α
toType (RApp (RTyCon {rtc_tc :: RTyCon -> TyCon
rtc_tc = TyCon
c}) [RRType r]
ts [RTProp RTyCon RTyVar r]
_ r
_)
  = TyCon -> [Type] -> Type
TyConApp TyCon
c (RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType (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 c tv r. RType c tv r -> Bool
notExprArg [RRType r]
ts)
  where
    notExprArg :: RType c tv r -> Bool
notExprArg (RExprArg Located Expr
_) = Bool
False
    notExprArg RType c tv r
_            = Bool
True
toType (RAllE Symbol
_ RRType r
_ RRType r
t)
  = RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t
toType (REx Symbol
_ RRType r
_ RRType r
t)
  = RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t
toType (RAppTy RRType r
t (RExprArg Located Expr
_) r
_)
  = RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t
toType (RAppTy RRType r
t RRType r
t' r
_)
  = Type -> Type -> Type
AppTy (RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t) (RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t')
toType t :: RRType r
t@(RExprArg Located Expr
_)
  = Maybe SrcSpan -> String -> Type
forall a. Maybe SrcSpan -> String -> a
impossible Maybe SrcSpan
forall a. Maybe a
Nothing (String -> Type) -> String -> Type
forall a b. (a -> b) -> a -> b
$ String
"CANNOT HAPPEN: RefType.toType called with: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RRType r -> String
forall a. Show a => a -> String
show RRType r
t
toType (RRTy [(Symbol, RRType r)]
_ r
_ Oblig
_ RRType r
t)
  = RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RRType r
t
toType (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 :: 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 :: 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
. RRType r -> Type
forall r. ToTypeable r => RRType r -> Type
toType

--------------------------------------------------------------------------------
applySolution :: (Functor f) => FixSolution -> f SpecType -> f SpecType
--------------------------------------------------------------------------------
applySolution :: FixSolution -> f SpecType -> f SpecType
applySolution = (SpecType -> SpecType) -> f SpecType -> f SpecType
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 (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
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 :: (Expr -> Expr) -> RReft -> RReft
mapReft Expr -> Expr
f (MkUReft (Reft (Symbol
x, Expr
z)) Predicate
p) = Reft -> Predicate -> RReft
forall r. r -> Predicate -> UReft r
MkUReft ((Symbol, Expr) -> Reft
Reft (Symbol
x, Expr -> Expr
f Expr
z)) Predicate
p

appSolRefa :: Visitable t
           => M.HashMap KVar Expr -> t -> t
appSolRefa :: 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
PTop KVar
k FixSolution
s

--------------------------------------------------------------------------------
-- shiftVV :: Int -- SpecType -> Symbol -> SpecType
shiftVV :: (TyConable c, F.Reftable (f Reft), Functor f) 
        => RType c tv (f Reft) -> Symbol -> RType c tv (f Reft) 
--------------------------------------------------------------------------------
shiftVV :: RType c tv (f Reft) -> Symbol -> RType c tv (f Reft)
shiftVV t :: RType c tv (f Reft)
t@(RApp c
_ [RType c tv (f Reft)]
ts [RTProp c tv (f Reft)]
rs f Reft
r) Symbol
vv'
  = RType c tv (f Reft)
t { rt_args :: [RType c tv (f Reft)]
rt_args  = [RType c tv (f Reft)] -> (Symbol, Expr) -> [RType c tv (f Reft)]
forall a. Subable a => a -> (Symbol, Expr) -> a
subst1 [RType c tv (f Reft)]
ts (RType c tv (f Reft) -> Symbol
forall r c tv. Reftable r => RType c tv r -> Symbol
rTypeValueVar RType c tv (f Reft)
t, Symbol -> Expr
EVar Symbol
vv') }
      { rt_pargs :: [RTProp c tv (f Reft)]
rt_pargs = [RTProp c tv (f Reft)] -> (Symbol, Expr) -> [RTProp c tv (f Reft)]
forall a. Subable a => a -> (Symbol, Expr) -> a
subst1 [RTProp c tv (f Reft)]
rs (RType c tv (f Reft) -> Symbol
forall r c tv. Reftable r => RType c tv r -> Symbol
rTypeValueVar RType c tv (f Reft)
t, Symbol -> Expr
EVar Symbol
vv') }
      { rt_reft :: f Reft
rt_reft  = (Reft -> Symbol -> Reft
`F.shiftVV` Symbol
vv') (Reft -> Reft) -> f Reft -> f Reft
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Reft
r }

shiftVV t :: RType c tv (f Reft)
t@(RImpF Symbol
_ RType c tv (f Reft)
_ RType c tv (f Reft)
_ f Reft
r) Symbol
vv'
  = RType c tv (f Reft)
t { rt_reft :: f Reft
rt_reft = (Reft -> Symbol -> Reft
`F.shiftVV` Symbol
vv') (Reft -> Reft) -> f Reft -> f Reft
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Reft
r }

shiftVV t :: RType c tv (f Reft)
t@(RFun Symbol
_ RType c tv (f Reft)
_ RType c tv (f Reft)
_ f Reft
r) Symbol
vv'
  = RType c tv (f Reft)
t { rt_reft :: f Reft
rt_reft = (Reft -> Symbol -> Reft
`F.shiftVV` Symbol
vv') (Reft -> Reft) -> f Reft -> f Reft
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Reft
r }

shiftVV t :: RType c tv (f Reft)
t@(RAppTy RType c tv (f Reft)
_ RType c tv (f Reft)
_ f Reft
r) Symbol
vv'
  = RType c tv (f Reft)
t { rt_reft :: f Reft
rt_reft = (Reft -> Symbol -> Reft
`F.shiftVV` Symbol
vv') (Reft -> Reft) -> f Reft -> f Reft
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Reft
r }

shiftVV t :: RType c tv (f Reft)
t@(RVar tv
_ f Reft
r) Symbol
vv'
  = RType c tv (f Reft)
t { rt_reft :: f Reft
rt_reft = (Reft -> Symbol -> Reft
`F.shiftVV` Symbol
vv') (Reft -> Reft) -> f Reft -> f Reft
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Reft
r }

shiftVV RType c tv (f Reft)
t Symbol
_
  = RType 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 -> String
show (RTA Symbol
n [tv]
as [Symbol]
xs ty
t) =
    String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"type %s %s %s = %s" (Symbol -> String
symbolString Symbol
n)
      ([String] -> String
unwords (tv -> String
forall a. Show a => a -> String
show (tv -> String) -> [tv] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [tv]
as))
      ([String] -> String
unwords (Symbol -> String
forall a. Show a => a -> String
show (Symbol -> String) -> [Symbol] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
xs))
      (ty -> String
forall a. Show a => a -> String
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  AnonArgFlag
_ Type
_ Type
_) = TCEmb TyCon -> Type -> Sort
typeSortFun TCEmb TyCon
tce Type
t
    go τ :: Type
τ@(ForAllTy VarBndr Var ArgFlag
_ 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 -> Sort
go (TyCon -> [Type] -> Type
Ghc.newTyConInstRhs TyCon
c [Type]
τs)
      | Bool
otherwise  
      = TCEmb TyCon -> TyCon -> [Sort] -> Sort
tyConFTyCon TCEmb TyCon
tce TyCon
c (Type -> Sort
go (Type -> Sort) -> [Type] -> [Sort]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
τs)
    go (AppTy Type
t1 Type
t2)    = Sort -> [Sort] -> Sort
fApp (Type -> Sort
go Type
t1) [Type -> Sort
go Type
t2]
    go (TyVarTy Var
tv)     = Var -> Sort
tyVarSort Var
tv
    go (CastTy Type
t KindCoercion
_)     = Type -> Sort
go Type
t
    go Type
τ                = Symbol -> Sort
FObj (Type -> Symbol
typeUniqueSymbol Type
τ)

tyConFTyCon :: TCEmb TyCon -> TyCon -> [Sort] -> Sort
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, TC.isFamInstTyCon c)

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

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

typeSortForAll :: TCEmb TyCon -> Type -> Sort
typeSortForAll :: TCEmb TyCon -> Type -> Sort
typeSortForAll TCEmb TyCon
tce Type
τ  = String -> Sort -> Sort
forall a. PPrint a => String -> a -> a
F.notracepp (String
"typeSortForall " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. PPrint a => a -> String
showpp Type
τ) (Sort -> Sort) -> Sort -> Sort
forall a b. (a -> b) -> a -> b
$ Sort -> Sort
genSort Sort
sbody
  where
    sbody :: Sort
sbody             = TCEmb TyCon -> Type -> Sort
typeSort TCEmb TyCon
tce Type
tbody
    genSort :: Sort -> Sort
genSort Sort
t         = (Sort -> Int -> Sort) -> Sort -> [Int] -> Sort
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Int -> Sort -> Sort) -> Sort -> Int -> Sort
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Sort -> Sort
FAbs) (SortSubst -> Sort -> Sort
sortSubst SortSubst
su Sort
t) [Int
i..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
    ([Var]
as, Type
tbody)       = String -> ([Var], Type) -> ([Var], Type)
forall a. PPrint a => String -> a -> a
F.notracepp (String
"splitForallTys" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Outputable a => a -> String
GM.showPpr Type
τ) (Type -> ([Var], Type)
splitForAllTys 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 (Int -> Sort
FVar (Int -> Sort) -> [Int] -> [Sort]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  [Int
i..])
    sas :: [Symbol]
sas               = Var -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Var -> Symbol) -> [Var] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
as
    n :: Int
n                 = [Var] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Var]
as
    i :: Int
i                 = Sort -> Int
sortAbs Sort
sbody Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- RJ: why not make this the Symbolic instance?
tyConName :: TyCon -> Symbol
tyConName :: TyCon -> Symbol
tyConName TyCon
c
  | TyCon
listTyCon TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
c    = Symbol
listConName
  | TyCon -> Bool
TC.isTupleTyCon TyCon
c = Symbol
tupConName
  | Bool
otherwise         = TyCon -> Symbol
forall a. Symbolic a => a -> Symbol
symbol TyCon
c

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

grabArgs :: [Type] -> Type -> [Type]
grabArgs :: [Type] -> Type -> [Type]
grabArgs [Type]
τs (FunTy AnonArgFlag
_ 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)
  | Bool -> Bool
not ( String -> Bool -> Bool
forall a. PPrint a => String -> a -> a
F.notracepp (String
"isNonArg: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Outputable a => a -> String
GM.showPpr Type
τ1) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Type -> Bool
isNonValueTy Type
τ1)
  = [Type] -> Type -> [Type]
grabArgs (Type
τ1Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:[Type]
τs) Type
τ2
  | Bool
otherwise
  = [Type] -> Type -> [Type]
grabArgs [Type]
τs Type
τ2
grabArgs [Type]
τs Type
τ
  = [Type] -> [Type]
forall a. [a] -> [a]
reverse (Type
τType -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:[Type]
τs)

isNonValueTy :: Type -> Bool
isNonValueTy :: Type -> Bool
isNonValueTy = Type -> Bool
GM.isPredType


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 :: Var -> RType RTyCon RTyVar r -> RType RTyCon RTyVar r
expandProductType Var
x RType RTyCon RTyVar r
t
  | Bool
isTrivial       = RType RTyCon RTyVar r
t
  | Bool
otherwise       = RTypeRep RTyCon RTyVar r -> RType RTyCon RTyVar r
forall c tv r. RTypeRep c tv r -> RType c tv r
fromRTypeRep (RTypeRep RTyCon RTyVar r -> RType RTyCon RTyVar r)
-> RTypeRep RTyCon RTyVar r -> RType RTyCon RTyVar r
forall a b. (a -> b) -> a -> b
$ RTypeRep RTyCon RTyVar r
trep {ty_binds :: [Symbol]
ty_binds = [Symbol]
xs', ty_args :: [RType RTyCon RTyVar r]
ty_args = [RType RTyCon RTyVar r]
ts', ty_refts :: [r]
ty_refts = [r]
rs'}
     where
      isTrivial :: Bool
isTrivial     = Type -> RType RTyCon RTyVar ()
forall r. Monoid r => Type -> RRType r
ofType (Var -> Type
varType Var
x) RType RTyCon RTyVar () -> RType RTyCon RTyVar () -> Bool
forall a. Eq a => a -> a -> Bool
== RType RTyCon RTyVar r -> RType RTyCon RTyVar ()
forall c tv r. RType c tv r -> RType c tv ()
toRSort RType RTyCon RTyVar r
t
      τs :: [Type]
τs            = ([Type], Type) -> [Type]
forall a b. (a, b) -> a
fst (([Type], Type) -> [Type]) -> ([Type], Type) -> [Type]
forall a b. (a -> b) -> a -> b
$ Type -> ([Type], Type)
splitFunTys (Type -> ([Type], Type)) -> Type -> ([Type], Type)
forall a b. (a -> b) -> a -> b
$ ([Var], Type) -> Type
forall a b. (a, b) -> b
snd (([Var], Type) -> Type) -> ([Var], Type) -> Type
forall a b. (a -> b) -> a -> b
$ Type -> ([Var], Type)
splitForAllTys (Type -> ([Var], Type)) -> Type -> ([Var], Type)
forall a b. (a -> b) -> a -> b
$ RType RTyCon RTyVar r -> Type
forall r. ToTypeable r => RRType r -> Type
toType RType RTyCon RTyVar r
t
      trep :: RTypeRep RTyCon RTyVar r
trep          = RType RTyCon RTyVar r -> RTypeRep RTyCon RTyVar r
forall c tv r. RType c tv r -> RTypeRep c tv r
toRTypeRep RType RTyCon RTyVar r
t
      ([Symbol]
xs',[RType RTyCon RTyVar r]
ts',[r]
rs') = [(Symbol, RType RTyCon RTyVar r, r)]
-> ([Symbol], [RType RTyCon RTyVar r], [r])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Symbol, RType RTyCon RTyVar r, r)]
 -> ([Symbol], [RType RTyCon RTyVar r], [r]))
-> [(Symbol, RType RTyCon RTyVar r, r)]
-> ([Symbol], [RType RTyCon RTyVar r], [r])
forall a b. (a -> b) -> a -> b
$ ((Type, Symbol, RType RTyCon RTyVar r, r)
 -> [(Symbol, RType RTyCon RTyVar r, r)])
-> [(Type, Symbol, RType RTyCon RTyVar r, r)]
-> [(Symbol, RType RTyCon RTyVar r, r)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Type, Symbol, RType RTyCon RTyVar r, r)
-> [(Symbol, RType RTyCon RTyVar r, r)]
forall t r.
(Monoid t, Monoid r) =>
(Type, Symbol, RType RTyCon RTyVar r, t)
-> [(Symbol, RType RTyCon RTyVar r, t)]
mkProductTy ([(Type, Symbol, RType RTyCon RTyVar r, r)]
 -> [(Symbol, RType RTyCon RTyVar r, r)])
-> [(Type, Symbol, RType RTyCon RTyVar r, r)]
-> [(Symbol, RType RTyCon RTyVar r, r)]
forall a b. (a -> b) -> a -> b
$ [Type]
-> [Symbol]
-> [RType RTyCon RTyVar r]
-> [r]
-> [(Type, Symbol, RType RTyCon RTyVar r, r)]
forall t t1 t2 t3. [t] -> [t1] -> [t2] -> [t3] -> [(t, t1, t2, t3)]
zip4 [Type]
τs (RTypeRep RTyCon RTyVar r -> [Symbol]
forall c tv r. RTypeRep c tv r -> [Symbol]
ty_binds RTypeRep RTyCon RTyVar r
trep) (RTypeRep RTyCon RTyVar r -> [RType RTyCon RTyVar r]
forall c tv r. RTypeRep c tv r -> [RType c tv r]
ty_args RTypeRep RTyCon RTyVar r
trep) (RTypeRep RTyCon RTyVar r -> [r]
forall c tv r. RTypeRep c tv r -> [r]
ty_refts RTypeRep RTyCon RTyVar r
trep)

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


mkProductTy :: (Monoid t, Monoid r)
            => (Type, Symbol, RType RTyCon RTyVar r, t)
            -> [(Symbol, RType RTyCon RTyVar r, t)]
mkProductTy :: (Type, Symbol, RType RTyCon RTyVar r, t)
-> [(Symbol, RType RTyCon RTyVar r, t)]
mkProductTy (Type
τ, Symbol
x, RType RTyCon RTyVar r
t, t
r) = [(Symbol, RType RTyCon RTyVar r, t)]
-> ((DataCon, [Type], [(Type, StrictnessMark)], KindCoercion)
    -> [(Symbol, RType RTyCon RTyVar r, t)])
-> Maybe (DataCon, [Type], [(Type, StrictnessMark)], KindCoercion)
-> [(Symbol, RType RTyCon RTyVar r, t)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Symbol
x, RType RTyCon RTyVar r
t, t
r)] (DataCon, [Type], [(Type, StrictnessMark)], KindCoercion)
-> [(Symbol, RType RTyCon RTyVar r, t)]
forall t r t t1 b t3.
(Monoid t, Monoid r) =>
(t, t1, [(Type, b)], t3) -> [(Symbol, RRType r, t)]
f (Maybe (DataCon, [Type], [(Type, StrictnessMark)], KindCoercion)
 -> [(Symbol, RType RTyCon RTyVar r, t)])
-> Maybe (DataCon, [Type], [(Type, StrictnessMark)], KindCoercion)
-> [(Symbol, RType RTyCon RTyVar r, t)]
forall a b. (a -> b) -> a -> b
$ FamInstEnvs
-> Type
-> Maybe (DataCon, [Type], [(Type, StrictnessMark)], KindCoercion)
deepSplitProductType_maybe FamInstEnvs
menv Type
τ
  where
    f :: (t, t1, [(Type, b)], t3) -> [(Symbol, RRType r, t)]
f    = ((Type, b) -> (Symbol, RRType r, t))
-> [(Type, b)] -> [(Symbol, RRType r, t)]
forall a b. (a -> b) -> [a] -> [b]
map ((Symbol
dummySymbol, , t
forall a. Monoid a => a
mempty) (RRType r -> (Symbol, RRType r, t))
-> ((Type, b) -> RRType r) -> (Type, b) -> (Symbol, RRType r, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> RRType r
forall r. Monoid r => Type -> RRType r
ofType (Type -> RRType r) -> ((Type, b) -> Type) -> (Type, b) -> RRType r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, b) -> Type
forall a b. (a, b) -> a
fst) ([(Type, b)] -> [(Symbol, RRType r, t)])
-> ((t, t1, [(Type, b)], t3) -> [(Type, b)])
-> (t, t1, [(Type, b)], t3)
-> [(Symbol, RRType r, t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t, t1, [(Type, b)], t3) -> [(Type, b)]
forall t t1 t2 t3. (t, t1, t2, t3) -> t2
third4
    menv :: FamInstEnvs
menv = (FamInstEnv
emptyFamInstEnv, FamInstEnv
emptyFamInstEnv)

-----------------------------------------------------------------------------------------
-- | 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 
  = String -> [(Symbol, SortedReft)] -> [(Symbol, SortedReft)]
forall a. PPrint a => String -> a -> a
notracepp (String
"CLASSBINDS-0: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RTyCon -> String
forall a. PPrint a => a -> String
showpp RTyCon
c) [] 
classBinds TCEmb TyCon
_ SpecType
t
  = String -> [(Symbol, SortedReft)] -> [(Symbol, SortedReft)]
forall a. PPrint a => String -> a -> a
notracepp (String
"CLASSBINDS-1: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Type, Bool) -> String
forall a. PPrint a => a -> String
showpp (SpecType -> Type
forall r. ToTypeable r => RRType r -> Type
toType SpecType
t, SpecType -> Bool
isEqualityConstr SpecType
t)) []

isEqualityConstr :: SpecType -> Bool
isEqualityConstr :: SpecType -> Bool
isEqualityConstr (SpecType -> Type
forall r. ToTypeable r => RRType r -> Type
toType -> 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 :: 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 a r. TyConable c => RType c a r -> [a]
go
  where
    go :: RType c a r -> [a]
go (RApp c
c [RType c a r]
ts [RTProp 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
_) <- [RType c a r]
ts]
    go RType 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 (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
             -> [(a, (Symbol, RType RTyCon t (UReft Reft)))]
             -> Either (Symbol, RType RTyCon t (UReft Reft)) String 
makeDecrType :: HashSet TyCon
-> [(a, (Symbol, RType RTyCon t RReft))]
-> Either (Symbol, RType RTyCon t RReft) String
makeDecrType HashSet TyCon
autoenv = HashSet TyCon
-> [(Symbol, Symbol, Symbol -> Expr)]
-> [Expr]
-> [(a, (Symbol, RType RTyCon t RReft))]
-> Either (Symbol, RType RTyCon t RReft) String
forall a t.
Symbolic a =>
HashSet TyCon
-> [(Symbol, Symbol, Symbol -> Expr)]
-> [Expr]
-> [(a, (Symbol, RType RTyCon t RReft))]
-> Either (Symbol, RType RTyCon t RReft) String
mkDType HashSet TyCon
autoenv [] []

mkDType :: Symbolic a
        => S.HashSet TyCon
        -> [(Symbol, Symbol, Symbol -> Expr)]
        -> [Expr]
        -> [(a, (Symbol, RType RTyCon t (UReft Reft)))]
        -> Either (Symbol, RType RTyCon t (UReft Reft)) String 
mkDType :: HashSet TyCon
-> [(Symbol, Symbol, Symbol -> Expr)]
-> [Expr]
-> [(a, (Symbol, RType RTyCon t RReft))]
-> Either (Symbol, RType RTyCon t RReft) String
mkDType HashSet TyCon
autoenv [(Symbol, Symbol, Symbol -> Expr)]
xvs [Expr]
acc [(a
v, (Symbol
x, RType RTyCon t RReft
t))]
  = (Symbol, RType RTyCon t RReft)
-> Either (Symbol, RType RTyCon t RReft) String
forall a b. a -> Either a b
Left ((Symbol
x, ) (RType RTyCon t RReft -> (Symbol, RType RTyCon t RReft))
-> RType RTyCon t RReft -> (Symbol, RType RTyCon t RReft)
forall a b. (a -> b) -> a -> b
$ RType RTyCon t RReft
t RType RTyCon t RReft -> RReft -> RType RTyCon t RReft
forall r c tv. Reftable r => RType c tv r -> r -> RType c tv r
`strengthen` RReft
tr)
  where
    tr :: RReft
tr = Reft -> RReft
forall r. r -> UReft r
uTop (Reft -> RReft) -> Reft -> RReft
forall a b. (a -> b) -> a -> b
$ (Symbol, Expr) -> Reft
Reft (Symbol
forall p. IsString p => p
vv, [Expr] -> Expr
pOr (Expr
rExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
acc))
    r :: Expr
r  = [(Symbol, Symbol, Symbol -> Expr)]
-> (Symbol, Symbol, Symbol -> Expr) -> Expr
forall t1 t. [(t1, t1, t1 -> Expr)] -> (t, t, t -> Expr) -> Expr
cmpLexRef [(Symbol, Symbol, Symbol -> Expr)]
xvs (Symbol
v', Symbol
forall p. IsString p => p
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 :: p
vv = p
"vvRec"

mkDType HashSet TyCon
autoenv [(Symbol, Symbol, Symbol -> Expr)]
xvs [Expr]
acc ((a
v, (Symbol
x, RType RTyCon t RReft
t)):[(a, (Symbol, RType RTyCon t RReft))]
vxts)
  = HashSet TyCon
-> [(Symbol, Symbol, Symbol -> Expr)]
-> [Expr]
-> [(a, (Symbol, RType RTyCon t RReft))]
-> Either (Symbol, RType RTyCon t RReft) String
forall a t.
Symbolic a =>
HashSet TyCon
-> [(Symbol, Symbol, Symbol -> Expr)]
-> [Expr]
-> [(a, (Symbol, RType RTyCon t RReft))]
-> Either (Symbol, RType RTyCon t RReft) String
mkDType HashSet TyCon
autoenv ((Symbol
v', Symbol
x, Symbol -> Expr
f)(Symbol, Symbol, Symbol -> Expr)
-> [(Symbol, Symbol, Symbol -> Expr)]
-> [(Symbol, Symbol, Symbol -> Expr)]
forall a. a -> [a] -> [a]
:[(Symbol, Symbol, Symbol -> Expr)]
xvs) (Expr
rExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
acc) [(a, (Symbol, RType RTyCon t RReft))]
vxts
  where
    r :: Expr
r  = [(Symbol, Symbol, Symbol -> Expr)]
-> (Symbol, Symbol, Symbol -> Expr) -> Expr
forall t1 t. [(t1, t1, t1 -> Expr)] -> (t, t, t -> Expr) -> Expr
cmpLexRef [(Symbol, Symbol, Symbol -> Expr)]
xvs  (Symbol
v', Symbol
x, 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


mkDType HashSet TyCon
_ [(Symbol, Symbol, Symbol -> Expr)]
_ [Expr]
_ [(a, (Symbol, RType RTyCon t RReft))]
_
  = String -> Either (Symbol, RType RTyCon t RReft) String
forall a b. b -> Either a b
Right String
"RefType.mkDType 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 --   TC.isAlgTyCon tc -- && TC.isRecursiveTyCon tc

mkDecrFun :: S.HashSet TyCon -> RType RTyCon t t1 -> Symbol -> Expr
mkDecrFun :: HashSet TyCon -> RType RTyCon t t1 -> Symbol -> Expr
mkDecrFun HashSet TyCon
autoenv (RApp RTyCon
c [RType RTyCon t t1]
_ [RTProp 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
F.EVar Symbol
v]
mkDecrFun HashSet TyCon
_ (RVar t
_ t1
_)
  = Symbol -> Expr
EVar
mkDecrFun HashSet TyCon
_ RType RTyCon t t1
_
  = Maybe SrcSpan -> String -> Symbol -> Expr
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"RefType.mkDecrFun called on invalid input"

-- | [NOTE]: THIS IS WHERE THE TERMINATION METRIC REFINEMENTS ARE CREATED.
cmpLexRef :: [(t1, t1, t1 -> Expr)] -> (t, t, t -> Expr) -> Expr
cmpLexRef :: [(t1, t1, t1 -> Expr)] -> (t, t, t -> Expr) -> Expr
cmpLexRef [(t1, t1, t1 -> Expr)]
vxs (t
v, t
x, t -> Expr
g)
  = [Expr] -> Expr
pAnd ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$  (Brel -> Expr -> Expr -> Expr
PAtom Brel
Lt (t -> Expr
g t
x) (t -> Expr
g t
v)) Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: (Brel -> Expr -> Expr -> Expr
PAtom Brel
Ge (t -> Expr
g t
x) Expr
zero)
         Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:  [Brel -> Expr -> Expr -> Expr
PAtom Brel
Eq (t1 -> Expr
f t1
y) (t1 -> Expr
f t1
z) | (t1
y, t1
z, t1 -> Expr
f) <- [(t1, t1, t1 -> Expr)]
vxs]
         [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Brel -> Expr -> Expr -> Expr
PAtom Brel
Ge (t1 -> Expr
f t1
y) Expr
zero  | (t1
y, t1
_, t1 -> Expr
f) <- [(t1, t1, t1 -> Expr)]
vxs]
  where zero :: Expr
zero = Constant -> Expr
ECon (Constant -> Expr) -> Constant -> Expr
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. r -> UReft r
uTop (Reft -> RReft) -> Reft -> RReft
forall a b. (a -> b) -> a -> b
$ (Symbol, Expr) -> Reft
Reft (Symbol
forall p. IsString p => p
vv, Expr -> Expr -> Expr
PIff (Symbol -> Expr
EVar Symbol
forall p. IsString p => p
vv) (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
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 :: p
vv = p
"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
pAnd ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$  (Brel -> Expr -> Expr -> Expr
PAtom Brel
Lt Expr
e' Expr
e)
                Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:  (Brel -> Expr -> Expr -> Expr
PAtom Brel
Ge Expr
e' Expr
zero)
                Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:  [Brel -> Expr -> Expr -> Expr
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
PAtom Brel
Ge Expr
o' Expr
zero | (Expr
_,Expr
o') <- [(Expr, Expr)]
old]
    zero :: Expr
zero = Constant -> Expr
ECon (Constant -> Expr) -> Constant -> Expr
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
I Integer
0
makeLexReft [(Expr, Expr)]
_ [Expr]
_ [Expr]
_ [Expr]
_
  = Maybe SrcSpan -> String -> [Expr]
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"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 (t :: * -> *) a. Foldable t => t a -> Bool
null VarianceInfo
userTv then VarianceInfo
defTv else VarianceInfo
userTv
    defTv :: VarianceInfo
defTv                     = TyCon -> VarianceInfo
makeTyConVariance TyCon
c


makeTyConVariance :: TyCon -> VarianceInfo
makeTyConVariance :: TyCon -> VarianceInfo
makeTyConVariance TyCon
c = Var -> Variance
varSignToVariance (Var -> Variance) -> [Var] -> VarianceInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
tvs
  where
    tvs :: [Var]
tvs = TyCon -> [Var]
GM.tyConTyVarsDef TyCon
c

    varsigns :: [(Var, Bool)]
varsigns = if TyCon -> Bool
TC.isTypeSynonymTyCon TyCon
c
                  then Bool -> Type -> [(Var, Bool)]
go Bool
True (Maybe Type -> Type
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Type -> Type) -> Maybe Type -> Type
forall a b. (a -> b) -> a -> b
$ TyCon -> Maybe Type
TC.synTyConRhs_maybe TyCon
c)
                  else [(Var, Bool)] -> [(Var, Bool)]
forall a. Eq a => [a] -> [a]
L.nub ([(Var, Bool)] -> [(Var, Bool)]) -> [(Var, Bool)] -> [(Var, Bool)]
forall a b. (a -> b) -> a -> b
$ (DataCon -> [(Var, Bool)]) -> [DataCon] -> [(Var, Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DataCon -> [(Var, Bool)]
goDCon ([DataCon] -> [(Var, Bool)]) -> [DataCon] -> [(Var, Bool)]
forall a b. (a -> b) -> a -> b
$ TyCon -> [DataCon]
TC.tyConDataCons TyCon
c

    varSignToVariance :: Var -> Variance
varSignToVariance Var
v = case ((Var, Bool) -> Bool) -> [(Var, Bool)] -> [(Var, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Var, Bool)
p -> Var -> String
forall a. Outputable a => a -> String
GM.showPpr ((Var, Bool) -> Var
forall a b. (a, b) -> a
fst (Var, Bool)
p) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Var -> String
forall a. Outputable a => a -> String
GM.showPpr Var
v) [(Var, Bool)]
varsigns of
                            []       -> Variance
Invariant
                            [(Var
_, Bool
b)] -> if Bool
b then Variance
Covariant else Variance
Contravariant
                            [(Var, Bool)]
_        -> Variance
Bivariant


    goDCon :: DataCon -> [(Var, Bool)]
goDCon DataCon
dc = (Type -> [(Var, Bool)]) -> [Type] -> [(Var, Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Type -> [(Var, Bool)]
go Bool
True) (DataCon -> [Type]
DataCon.dataConOrigArgTys DataCon
dc)

    go :: Bool -> Type -> [(Var, Bool)]
go Bool
pos (FunTy AnonArgFlag
_ Type
t1 Type
t2) = Bool -> Type -> [(Var, Bool)]
go (Bool -> Bool
not Bool
pos) Type
t1 [(Var, Bool)] -> [(Var, Bool)] -> [(Var, Bool)]
forall a. [a] -> [a] -> [a]
++ Bool -> Type -> [(Var, Bool)]
go Bool
pos Type
t2
    go Bool
pos (ForAllTy VarBndr Var ArgFlag
_ Type
t)  = Bool -> Type -> [(Var, Bool)]
go Bool
pos Type
t
    go Bool
pos (TyVarTy Var
v)     = [(Var
v, Bool
pos)]
    go Bool
pos (AppTy Type
t1 Type
t2)   = Bool -> Type -> [(Var, Bool)]
go Bool
pos Type
t1 [(Var, Bool)] -> [(Var, Bool)] -> [(Var, Bool)]
forall a. [a] -> [a] -> [a]
++ Bool -> Type -> [(Var, Bool)]
go Bool
pos Type
t2
    go Bool
pos (TyConApp TyCon
c' [Type]
ts)
       | TyCon
c TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
c'
       = []

-- NV fix that: what happens if we have mutually recursive data types?
-- now just provide "default" Bivariant for mutually rec types.
-- but there should be a finer solution
       | TyCon -> TyCon -> Bool
mutuallyRecursive TyCon
c TyCon
c'
       = (Type -> [(Var, Bool)]) -> [Type] -> [(Var, Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Variance -> Type -> [(Var, Bool)]
goTyConApp Bool
pos Variance
Bivariant) [Type]
ts
       | Bool
otherwise
       = [[(Var, Bool)]] -> [(Var, Bool)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Var, Bool)]] -> [(Var, Bool)])
-> [[(Var, Bool)]] -> [(Var, Bool)]
forall a b. (a -> b) -> a -> b
$ (Variance -> Type -> [(Var, Bool)])
-> VarianceInfo -> [Type] -> [[(Var, Bool)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Bool -> Variance -> Type -> [(Var, Bool)]
goTyConApp Bool
pos) (TyCon -> VarianceInfo
makeTyConVariance TyCon
c') [Type]
ts

    go Bool
_   (LitTy TyLit
_)       = []
    go Bool
_   (CoercionTy KindCoercion
_)  = []
    go Bool
pos (CastTy Type
t KindCoercion
_)    = Bool -> Type -> [(Var, Bool)]
go Bool
pos Type
t

    goTyConApp :: Bool -> Variance -> Type -> [(Var, Bool)]
goTyConApp Bool
_   Variance
Invariant     Type
_ = []
    goTyConApp Bool
pos Variance
Bivariant     Type
t = Bool -> Variance -> Type -> [(Var, Bool)]
goTyConApp Bool
pos Variance
Contravariant Type
t [(Var, Bool)] -> [(Var, Bool)] -> [(Var, Bool)]
forall a. [a] -> [a] -> [a]
++ Bool -> Variance -> Type -> [(Var, Bool)]
goTyConApp Bool
pos Variance
Covariant Type
t
    goTyConApp Bool
pos Variance
Covariant     Type
t = Bool -> Type -> [(Var, Bool)]
go Bool
pos       Type
t
    goTyConApp Bool
pos Variance
Contravariant Type
t = Bool -> Type -> [(Var, Bool)]
go (Bool -> Bool
not Bool
pos) Type
t

    mutuallyRecursive :: TyCon -> TyCon -> Bool
mutuallyRecursive TyCon
c TyCon
c' = TyCon
c TyCon -> HashSet TyCon -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` (TyCon -> HashSet TyCon
dataConsOfTyCon TyCon
c')


dataConsOfTyCon :: TyCon -> S.HashSet TyCon
dataConsOfTyCon :: TyCon -> HashSet TyCon
dataConsOfTyCon = HashSet TyCon -> TyCon -> HashSet TyCon
dcs HashSet TyCon
forall a. HashSet a
S.empty
  where
    dcs :: HashSet TyCon -> TyCon -> HashSet TyCon
dcs HashSet TyCon
vis TyCon
c               = [HashSet TyCon] -> HashSet TyCon
forall a. Monoid a => [a] -> a
mconcat ([HashSet TyCon] -> HashSet TyCon)
-> [HashSet TyCon] -> HashSet TyCon
forall a b. (a -> b) -> a -> b
$ HashSet TyCon -> Type -> HashSet TyCon
go HashSet TyCon
vis (Type -> HashSet TyCon) -> [Type] -> [HashSet TyCon]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type
t | DataCon
dc <- TyCon -> [DataCon]
TC.tyConDataCons TyCon
c, Type
t <- DataCon -> [Type]
DataCon.dataConOrigArgTys DataCon
dc]
    go :: HashSet TyCon -> Type -> HashSet TyCon
go  HashSet TyCon
vis (FunTy AnonArgFlag
_ Type
t1 Type
t2) = HashSet TyCon -> Type -> HashSet TyCon
go HashSet TyCon
vis Type
t1 HashSet TyCon -> HashSet TyCon -> HashSet TyCon
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`S.union` HashSet TyCon -> Type -> HashSet TyCon
go HashSet TyCon
vis Type
t2
    go  HashSet TyCon
vis (ForAllTy VarBndr Var ArgFlag
_ Type
t)  = HashSet TyCon -> Type -> HashSet TyCon
go HashSet TyCon
vis Type
t
    go  HashSet TyCon
_   (TyVarTy Var
_)     = HashSet TyCon
forall a. HashSet a
S.empty
    go  HashSet TyCon
vis (AppTy Type
t1 Type
t2)   = HashSet TyCon -> Type -> HashSet TyCon
go HashSet TyCon
vis Type
t1 HashSet TyCon -> HashSet TyCon -> HashSet TyCon
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`S.union` HashSet TyCon -> Type -> HashSet TyCon
go HashSet TyCon
vis Type
t2
    go  HashSet TyCon
vis (TyConApp TyCon
c [Type]
ts)
      | TyCon
c TyCon -> HashSet TyCon -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet TyCon
vis
      = HashSet TyCon
forall a. HashSet a
S.empty
      | Bool
otherwise
      = (TyCon -> HashSet TyCon -> HashSet TyCon
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
S.insert TyCon
c (HashSet TyCon -> HashSet TyCon) -> HashSet TyCon -> HashSet TyCon
forall a b. (a -> b) -> a -> b
$ [HashSet TyCon] -> HashSet TyCon
forall a. Monoid a => [a] -> a
mconcat ([HashSet TyCon] -> HashSet TyCon)
-> [HashSet TyCon] -> HashSet TyCon
forall a b. (a -> b) -> a -> b
$ HashSet TyCon -> Type -> HashSet TyCon
go HashSet TyCon
vis (Type -> HashSet TyCon) -> [Type] -> [HashSet TyCon]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
ts) HashSet TyCon -> HashSet TyCon -> HashSet TyCon
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`S.union` HashSet TyCon -> TyCon -> HashSet TyCon
dcs (TyCon -> HashSet TyCon -> HashSet TyCon
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
S.insert TyCon
c HashSet TyCon
vis) TyCon
c
    go  HashSet TyCon
_   (LitTy TyLit
_)       = HashSet TyCon
forall a. HashSet a
S.empty
    go  HashSet TyCon
_   (CoercionTy KindCoercion
_)  = HashSet TyCon
forall a. HashSet a
S.empty
    go  HashSet TyCon
vis (CastTy Type
t KindCoercion
_)    = HashSet TyCon -> Type -> HashSet TyCon
go HashSet TyCon
vis Type
t

--------------------------------------------------------------------------------
-- | Printing Refinement Types -------------------------------------------------
--------------------------------------------------------------------------------

instance Show RTyVar where
  show :: RTyVar -> String
show = RTyVar -> String
forall a. PPrint a => a -> String
showpp

instance PPrint (UReft r) => Show (UReft r) where
  show :: UReft r -> String
show = UReft r -> String
forall a. PPrint a => a -> String
showpp

instance PPrint DataDecl where
  pprintTidy :: Tidy -> DataDecl -> Doc
pprintTidy Tidy
k DataDecl
dd = Doc
"data" Doc -> Doc -> Doc
<+> DataName -> Doc
forall a. PPrint a => a -> Doc
pprint (DataDecl -> DataName
tycName DataDecl
dd) Doc -> Doc -> Doc
<+> Maybe SizeFun -> Doc
ppMbSizeFun (DataDecl -> Maybe SizeFun
tycSFun DataDecl
dd) Doc -> Doc -> Doc
<+> [Symbol] -> Doc
forall a. PPrint a => a -> Doc
pprint (DataDecl -> [Symbol]
tycTyVars DataDecl
dd) Doc -> Doc -> Doc
<+> Doc
"="
                    Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
4 ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ Doc
"|" Doc -> Doc -> Doc
<+> Tidy -> DataCtor -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k DataCtor
c | DataCtor
c <- DataDecl -> [DataCtor]
tycDCons DataDecl
dd ])

instance PPrint DataCtor where
  -- pprintTidy k (DataCtor c as _   xts Nothing)  = pprintTidy k c <+> dcolon ppVars as <+> braces (ppFields k ", " xts)
  -- pprintTidy k (DataCtor c as ths xts (Just t)) = pprintTidy k c <+> dcolon <+> ppVars as <+> ppThetas ths <+> (ppFields k " ->" xts) <+> "->" <+> pprintTidy k t
  pprintTidy :: Tidy -> DataCtor -> Doc
pprintTidy Tidy
k (DataCtor LocSymbol
c [Symbol]
as [RType BTyCon BTyVar RReft]
ths [(Symbol, RType BTyCon BTyVar RReft)]
xts Maybe (RType BTyCon BTyVar RReft)
t) = Tidy -> LocSymbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k LocSymbol
c Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Tidy -> [Symbol] -> Doc
forall a. PPrint a => Tidy -> [a] -> Doc
ppVars Tidy
k [Symbol]
as Doc -> Doc -> Doc
<+> [RType BTyCon BTyVar RReft] -> Doc
ppThetas [RType BTyCon BTyVar RReft]
ths Doc -> Doc -> Doc
<+> (Tidy -> Doc -> [(Symbol, RType BTyCon BTyVar RReft)] -> Doc
forall k v. (PPrint k, PPrint v) => Tidy -> Doc -> [(k, v)] -> Doc
ppFields Tidy
k Doc
" ->" [(Symbol, RType BTyCon BTyVar RReft)]
xts) Doc -> Doc -> Doc
<+> Doc
"->" Doc -> Doc -> Doc
<+> Doc
res 
    where
      res :: Doc
res         = Doc
-> (RType BTyCon BTyVar RReft -> Doc)
-> Maybe (RType BTyCon BTyVar RReft)
-> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"*" (Tidy -> RType BTyCon BTyVar RReft -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k) Maybe (RType BTyCon BTyVar RReft)
t 
      ppThetas :: [RType BTyCon BTyVar RReft] -> Doc
ppThetas [] = Doc
empty
      ppThetas [RType BTyCon BTyVar RReft]
ts = Doc -> Doc
parens ([Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
", " (Tidy -> RType BTyCon BTyVar RReft -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (RType BTyCon BTyVar RReft -> Doc)
-> [RType BTyCon BTyVar RReft] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RType BTyCon BTyVar RReft]
ts)) Doc -> Doc -> Doc
<+> Doc
"=>"


ppVars :: (PPrint a) => Tidy -> [a] -> Doc
ppVars :: Tidy -> [a] -> Doc
ppVars Tidy
k [a]
as = Doc
"forall" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate Doc
" " (Tidy -> a -> Doc
forall a. PPrint a => Tidy -> a -> Doc
F.pprintTidy Tidy
k (a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as)) Doc -> Doc -> Doc
<+> Doc
"." 

ppFields :: (PPrint k, PPrint v) => Tidy -> Doc -> [(k, v)] -> Doc
ppFields :: Tidy -> Doc -> [(k, v)] -> Doc
ppFields Tidy
k Doc
sep [(k, v)]
kvs = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
sep (Tidy -> (k, v) -> Doc
forall a. PPrint a => Tidy -> a -> Doc
F.pprintTidy Tidy
k ((k, v) -> Doc) -> [(k, v)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(k, v)]
kvs)

ppMbSizeFun :: Maybe SizeFun -> Doc
ppMbSizeFun :: Maybe SizeFun -> Doc
ppMbSizeFun Maybe SizeFun
Nothing  = Doc
""
ppMbSizeFun (Just SizeFun
z) = SizeFun -> Doc
forall a. PPrint a => a -> Doc
F.pprint SizeFun
z

-- instance PPrint DataCtor where
  -- pprintTidy k (DataCtor c xts t) =
    -- pprintTidy k c <+> text "::" <+> (hsep $ punctuate (text "->")
                                          -- ((pprintTidy k <$> xts) ++ [pprintTidy k t]))

-- ppHack :: (?callStack :: CallStack) => a -> b
-- ppHack _ = errorstar "OOPS"

instance PPrint (RType c tv r) => Show (RType c tv r) where
  show :: RType c tv r -> String
show = RType c tv r -> String
forall a. PPrint a => a -> String
showpp

instance PPrint (RTProp c tv r) => Show (RTProp c tv r) where
  show :: RTProp c tv r -> String
show = RTProp c tv r -> String
forall a. PPrint a => a -> String
showpp


-------------------------------------------------------------------------------
-- | 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 :: RType RTyCon tv r -> Positions tv
tyVarsPosition = Maybe Bool -> RType RTyCon tv r -> Positions tv
forall a r. Maybe Bool -> RType RTyCon a r -> Positions a
go (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
  where 
    go :: Maybe Bool -> RType 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
_ RType RTyCon a r
t1 RType RTyCon a r
t2 r
_)  = Maybe Bool -> RType RTyCon a r -> Positions a
go (Maybe Bool -> Maybe Bool
forall (f :: * -> *). Functor f => f Bool -> f Bool
flip Maybe Bool
p) RType RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t2 
    go Maybe Bool
p (RImpF Symbol
_ RType RTyCon a r
t1 RType RTyCon a r
t2 r
_) = Maybe Bool -> RType RTyCon a r -> Positions a
go (Maybe Bool -> Maybe Bool
forall (f :: * -> *). Functor f => f Bool -> f Bool
flip Maybe Bool
p) RType RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t2 
    go Maybe Bool
p (RAllT RTVU RTyCon a
_ RType RTyCon a r
t r
_)     = Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t 
    go Maybe Bool
p (RAllP PVU RTyCon a
_ RType RTyCon a r
t)       = Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t 
    go Maybe Bool
p (RApp RTyCon
c [RType RTyCon a r]
ts [RTProp RTyCon a r]
_ r
_)   = [Positions a] -> Positions a
forall a. Monoid a => [a] -> a
mconcat ((Maybe Bool -> RType RTyCon a r -> Positions a)
-> [Maybe Bool] -> [RType RTyCon a r] -> [Positions a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Maybe Bool -> RType 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)) [RType RTyCon a r]
ts)
    go Maybe Bool
p (RAllE Symbol
_ RType RTyCon a r
t1 RType RTyCon a r
t2)   = Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t2 
    go Maybe Bool
p (REx Symbol
_ RType RTyCon a r
t1 RType RTyCon a r
t2)     = Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t2
    go Maybe Bool
_ (RExprArg Located Expr
_)      = Positions a
forall a. Monoid a => a
mempty
    go Maybe Bool
p (RAppTy RType RTyCon a r
t1 RType RTyCon a r
t2 r
_)  = Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t1 Positions a -> Positions a -> Positions a
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType RTyCon a r
t2 
    go Maybe Bool
p (RRTy [(Symbol, RType RTyCon a r)]
_ r
_ Oblig
_ RType RTyCon a r
t)    = Maybe Bool -> RType RTyCon a r -> Positions a
go Maybe Bool
p RType 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 Maybe Bool
Nothing a
v      = ([a] -> [a] -> [a] -> Positions a
forall a. [a] -> [a] -> [a] -> Positions a
Pos [] [] [a
v])
    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] [])
    flip :: f Bool -> f Bool
flip = (Bool -> Bool) -> f Bool -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not

data Positions a = Pos {Positions a -> [a]
ppos :: [a], Positions a -> [a]
pneg ::  [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)