{-# LANGUAGE DeriveFunctor, FlexibleContexts, PatternGuards #-}
{-# OPTIONS_GHC -fwarn-unused-imports #-}
module Idris.AbsSyntax(
module Idris.AbsSyntax
, module Idris.AbsSyntaxTree
) where
import Idris.AbsSyntaxTree
import Idris.Colours
import Idris.Core.Evaluate
import Idris.Core.TT
import Idris.Docstrings
import Idris.IdeMode hiding (Opt(..))
import Idris.Options
import IRTS.CodegenCommon
import System.Directory (canonicalizePath, doesFileExist)
import System.IO
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Prelude hiding (Applicative, Foldable, Traversable, (<$>))
import Data.Char
import Data.Either
import Data.List hiding (insert, union)
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Set as S
import qualified Data.Text as T
import System.IO.Error (tryIOError)
import Data.Generics.Uniplate.Data (descend, descendM)
import Util.DynamicLinker
import Util.Pretty
import Util.System
getContext :: Idris Context
getContext :: Idris Context
getContext = do IState
i <- Idris IState
getIState; Context -> Idris Context
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> Context
tt_ctxt IState
i)
forCodegen :: Codegen -> [(Codegen, a)] -> [a]
forCodegen :: forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt [(Codegen, a)]
xs = [a
x | (Codegen
tgt', a
x) <- [(Codegen, a)]
xs, Codegen -> Codegen -> Bool
eqLang Codegen
tgt Codegen
tgt']
where
eqLang :: Codegen -> Codegen -> Bool
eqLang (Via IRFormat
_ FilePath
x) (Via IRFormat
_ FilePath
y) = FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
y
eqLang Codegen
Bytecode Codegen
Bytecode = Bool
True
eqLang Codegen
_ Codegen
_ = Bool
False
getObjectFiles :: Codegen -> Idris [FilePath]
getObjectFiles :: Codegen -> Idris [FilePath]
getObjectFiles Codegen
tgt = do IState
i <- Idris IState
getIState; [FilePath] -> Idris [FilePath]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Codegen -> [(Codegen, FilePath)] -> [FilePath]
forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt ([(Codegen, FilePath)] -> [FilePath])
-> [(Codegen, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, FilePath)]
idris_objs IState
i)
addObjectFile :: Codegen -> FilePath -> Idris ()
addObjectFile :: Codegen -> FilePath -> Idris ()
addObjectFile Codegen
tgt FilePath
f = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_objs = nub $ idris_objs i ++ [(tgt, f)] }
getLibs :: Codegen -> Idris [String]
getLibs :: Codegen -> Idris [FilePath]
getLibs Codegen
tgt = do IState
i <- Idris IState
getIState; [FilePath] -> Idris [FilePath]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Codegen -> [(Codegen, FilePath)] -> [FilePath]
forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt ([(Codegen, FilePath)] -> [FilePath])
-> [(Codegen, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, FilePath)]
idris_libs IState
i)
addLib :: Codegen -> String -> Idris ()
addLib :: Codegen -> FilePath -> Idris ()
addLib Codegen
tgt FilePath
f = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_libs = nub $ idris_libs i ++ [(tgt, f)] }
getFlags :: Codegen -> Idris [String]
getFlags :: Codegen -> Idris [FilePath]
getFlags Codegen
tgt = do IState
i <- Idris IState
getIState; [FilePath] -> Idris [FilePath]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Codegen -> [(Codegen, FilePath)] -> [FilePath]
forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt ([(Codegen, FilePath)] -> [FilePath])
-> [(Codegen, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, FilePath)]
idris_cgflags IState
i)
addFlag :: Codegen -> String -> Idris ()
addFlag :: Codegen -> FilePath -> Idris ()
addFlag Codegen
tgt FilePath
f = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_cgflags = nub $ idris_cgflags i ++ [(tgt, f)] }
addDyLib :: [String] -> Idris (Either DynamicLib String)
addDyLib :: [FilePath] -> Idris (Either DynamicLib FilePath)
addDyLib [FilePath]
libs = do IState
i <- Idris IState
getIState
let ls :: [DynamicLib]
ls = IState -> [DynamicLib]
idris_dynamic_libs IState
i
let importdirs :: [FilePath]
importdirs = IOption -> [FilePath]
opt_importdirs (IState -> IOption
idris_options IState
i)
case (FilePath -> Maybe DynamicLib) -> [FilePath] -> [DynamicLib]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([DynamicLib] -> FilePath -> Maybe DynamicLib
findDyLib [DynamicLib]
ls) [FilePath]
libs of
DynamicLib
x:[DynamicLib]
_ -> Either DynamicLib FilePath -> Idris (Either DynamicLib FilePath)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (DynamicLib -> Either DynamicLib FilePath
forall a b. a -> Either a b
Left DynamicLib
x)
[] -> do
[Maybe DynamicLib]
handle <- ExceptT Err IO [Maybe DynamicLib]
-> StateT IState (ExceptT Err IO) [Maybe DynamicLib]
forall (m :: * -> *) a. Monad m => m a -> StateT IState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Err IO [Maybe DynamicLib]
-> StateT IState (ExceptT Err IO) [Maybe DynamicLib])
-> ([FilePath] -> ExceptT Err IO [Maybe DynamicLib])
-> [FilePath]
-> StateT IState (ExceptT Err IO) [Maybe DynamicLib]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [Maybe DynamicLib] -> ExceptT Err IO [Maybe DynamicLib]
forall (m :: * -> *) a. Monad m => m a -> ExceptT Err m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [Maybe DynamicLib] -> ExceptT Err IO [Maybe DynamicLib])
-> ([FilePath] -> IO [Maybe DynamicLib])
-> [FilePath]
-> ExceptT Err IO [Maybe DynamicLib]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(FilePath -> IO (Maybe DynamicLib))
-> [FilePath] -> IO [Maybe DynamicLib]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\FilePath
l -> IO (Maybe DynamicLib)
-> (IOError -> IO (Maybe DynamicLib)) -> IO (Maybe DynamicLib)
forall a. IO a -> (IOError -> IO a) -> IO a
catchIO ([FilePath] -> FilePath -> IO (Maybe DynamicLib)
tryLoadLib [FilePath]
importdirs FilePath
l)
(\IOError
_ -> Maybe DynamicLib -> IO (Maybe DynamicLib)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DynamicLib
forall a. Maybe a
Nothing)) ([FilePath] -> StateT IState (ExceptT Err IO) [Maybe DynamicLib])
-> [FilePath] -> StateT IState (ExceptT Err IO) [Maybe DynamicLib]
forall a b. (a -> b) -> a -> b
$ [FilePath]
libs
case [Maybe DynamicLib] -> Maybe DynamicLib
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Maybe DynamicLib]
handle of
Maybe DynamicLib
Nothing -> Either DynamicLib FilePath -> Idris (Either DynamicLib FilePath)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either DynamicLib FilePath
forall a b. b -> Either a b
Right (FilePath -> Either DynamicLib FilePath)
-> FilePath -> Either DynamicLib FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not load dynamic alternatives \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," [FilePath]
libs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"")
Just DynamicLib
x -> do IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_dynamic_libs = x:ls }
Either DynamicLib FilePath -> Idris (Either DynamicLib FilePath)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (DynamicLib -> Either DynamicLib FilePath
forall a b. a -> Either a b
Left DynamicLib
x)
where findDyLib :: [DynamicLib] -> String -> Maybe DynamicLib
findDyLib :: [DynamicLib] -> FilePath -> Maybe DynamicLib
findDyLib [] FilePath
_ = Maybe DynamicLib
forall a. Maybe a
Nothing
findDyLib (DynamicLib
lib:[DynamicLib]
libs') FilePath
l | FilePath
l FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== DynamicLib -> FilePath
lib_name DynamicLib
lib = DynamicLib -> Maybe DynamicLib
forall a. a -> Maybe a
Just DynamicLib
lib
| Bool
otherwise = [DynamicLib] -> FilePath -> Maybe DynamicLib
findDyLib [DynamicLib]
libs' FilePath
l
getAutoImports :: Idris [FilePath]
getAutoImports :: Idris [FilePath]
getAutoImports = do IState
i <- Idris IState
getIState
[FilePath] -> Idris [FilePath]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> [FilePath]
opt_autoImport (IState -> IOption
idris_options IState
i))
addAutoImport :: FilePath -> Idris ()
addAutoImport :: FilePath -> Idris ()
addAutoImport FilePath
fp = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_options = opts { opt_autoImport =
fp : opt_autoImport opts } } )
addDefinedName :: Name -> Idris ()
addDefinedName :: Name -> Idris ()
addDefinedName Name
n = do IState
ist <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_inmodule = S.insert n (idris_inmodule ist) }
getDefinedNames :: Idris [Name]
getDefinedNames :: Idris [Name]
getDefinedNames = do IState
ist <- Idris IState
getIState
[Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Name -> [Name]
forall a. Set a -> [a]
S.toList (IState -> Set Name
idris_inmodule IState
ist))
addTT :: Term -> Idris (Maybe Term)
addTT :: Term -> Idris (Maybe Term)
addTT Term
t = do IState
ist <- Idris IState
getIState
case Term -> Map Term (Int, Term) -> Maybe (Int, Term)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Term
t (IState -> Map Term (Int, Term)
idris_ttstats IState
ist) of
Maybe (Int, Term)
Nothing -> do let tt' :: Map Term (Int, Term)
tt' = Term -> (Int, Term) -> Map Term (Int, Term) -> Map Term (Int, Term)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Term
t (Int
1, Term
t) (IState -> Map Term (Int, Term)
idris_ttstats IState
ist)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_ttstats = tt' }
Maybe Term -> Idris (Maybe Term)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Term
forall a. Maybe a
Nothing
Just (Int
i, Term
t') -> do let tt' :: Map Term (Int, Term)
tt' = Term -> (Int, Term) -> Map Term (Int, Term) -> Map Term (Int, Term)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Term
t' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Term
t') (IState -> Map Term (Int, Term)
idris_ttstats IState
ist)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_ttstats = tt' }
Maybe Term -> Idris (Maybe Term)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Maybe Term
forall a. a -> Maybe a
Just Term
t')
dumpTT :: Idris ()
dumpTT :: Idris ()
dumpTT = do IState
ist <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
let sts :: [(Term, (Int, Term))]
sts = ((Term, (Int, Term)) -> (Term, (Int, Term)) -> Ordering)
-> [(Term, (Int, Term))] -> [(Term, (Int, Term))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Term, (Int, Term)) -> (Term, (Int, Term)) -> Ordering
forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
count (Map Term (Int, Term) -> [(Term, (Int, Term))]
forall k a. Map k a -> [(k, a)]
M.toList (IState -> Map Term (Int, Term)
idris_ttstats IState
ist))
((Term, (Int, Term)) -> Idris ())
-> [(Term, (Int, Term))] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term, (Int, Term)) -> Idris ()
forall {a} {a}. (Show a, Show a) => (a, a) -> Idris ()
dump [(Term, (Int, Term))]
sts
() -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
count :: (a, a) -> (a, a) -> Ordering
count (a
_,a
x) (a
_,a
y) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
y a
x
dump :: (a, a) -> Idris ()
dump (a
tm, a
val) = IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> IO () -> Idris ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (a -> FilePath
forall a. Show a => a -> FilePath
show a
val FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
tm)
addHdr :: Codegen -> String -> Idris ()
addHdr :: Codegen -> FilePath -> Idris ()
addHdr Codegen
tgt FilePath
f = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_hdrs = nub $ (tgt, f) : idris_hdrs i }
addImported :: Bool -> FilePath -> Idris ()
addImported :: Bool -> FilePath -> Idris ()
addImported Bool
pub FilePath
f
= do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_imported = nub $ (f, pub) : idris_imported i }
addLangExt :: LanguageExt -> Idris ()
addLangExt :: LanguageExt -> Idris ()
addLangExt LanguageExt
e = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i {
idris_language_extensions = e : idris_language_extensions i
}
dropLangExt :: LanguageExt -> Idris ()
dropLangExt :: LanguageExt -> Idris ()
dropLangExt LanguageExt
e = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i {
idris_language_extensions = idris_language_extensions i \\ [e]
}
addTrans :: Name -> (Term, Term) -> Idris ()
addTrans :: Name -> (Term, Term) -> Idris ()
addTrans Name
basefn (Term, Term)
t
= do IState
i <- Idris IState
getIState
let t' :: [(Term, Term)]
t' = case Name -> Ctxt [(Term, Term)] -> Maybe [(Term, Term)]
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
basefn (IState -> Ctxt [(Term, Term)]
idris_transforms IState
i) of
Just [(Term, Term)]
def -> ((Term, Term)
t (Term, Term) -> [(Term, Term)] -> [(Term, Term)]
forall a. a -> [a] -> [a]
: [(Term, Term)]
def)
Maybe [(Term, Term)]
Nothing -> [(Term, Term)
t]
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_transforms = addDef basefn t'
(idris_transforms i) }
addErrRev :: (Term, Term) -> Idris ()
addErrRev :: (Term, Term) -> Idris ()
addErrRev (Term, Term)
t = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_errRev = t : idris_errRev i }
addErrReduce :: Name -> Idris ()
addErrReduce :: Name -> Idris ()
addErrReduce Name
t = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_errReduce = t : idris_errReduce i }
addErasureUsage :: Name -> Int -> Idris ()
addErasureUsage :: Name -> Int -> Idris ()
addErasureUsage Name
n Int
i = do IState
ist <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_erasureUsed = (n, i) : idris_erasureUsed ist }
addExport :: Name -> Idris ()
addExport :: Name -> Idris ()
addExport Name
n = do IState
ist <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_exports = n : idris_exports ist }
addUsedName :: FC -> Name -> Name -> Idris ()
addUsedName :: FC -> Name -> Name -> Idris ()
addUsedName FC
fc Name
n Name
arg
= do IState
ist <- Idris IState
getIState
case Name -> Context -> [(Name, Term)]
lookupTyName Name
n (IState -> Context
tt_ctxt IState
ist) of
[(Name
n', Term
ty)] -> Name -> Int -> Term -> Idris ()
addUsage Name
n' Int
0 Term
ty
[] -> Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc (Name -> Err
forall t. Name -> Err' t
NoSuchVariable Name
n))
[(Name, Term)]
xs -> Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc ([Name] -> Err
forall t. [Name] -> Err' t
CantResolveAlts (((Name, Term) -> Name) -> [(Name, Term)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Term) -> Name
forall a b. (a, b) -> a
fst [(Name, Term)]
xs)))
where addUsage :: Name -> Int -> Term -> Idris ()
addUsage Name
n Int
i (Bind Name
x Binder Term
_ Term
sc) | Name
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
arg = do IBCWrite -> Idris ()
addIBC ((Name, Int) -> IBCWrite
IBCUsage (Name
n, Int
i))
Name -> Int -> Idris ()
addErasureUsage Name
n Int
i
| Bool
otherwise = Name -> Int -> Term -> Idris ()
addUsage Name
n (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Term
sc
addUsage Name
_ Int
_ Term
_ = Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc (FilePath -> Err
forall t. FilePath -> Err' t
Msg (FilePath
"No such argument name " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
arg)))
getErasureUsage :: Idris [(Name, Int)]
getErasureUsage :: Idris [(Name, Int)]
getErasureUsage = do IState
ist <- Idris IState
getIState;
[(Name, Int)] -> Idris [(Name, Int)]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> [(Name, Int)]
idris_erasureUsed IState
ist)
getExports :: Idris [Name]
getExports :: Idris [Name]
getExports = do IState
ist <- Idris IState
getIState
[Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> [Name]
idris_exports IState
ist)
totcheck :: (FC, Name) -> Idris ()
totcheck :: (FC, Name) -> Idris ()
totcheck (FC, Name)
n = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_totcheck = idris_totcheck i ++ [n] }
defer_totcheck :: (FC, Name) -> Idris ()
defer_totcheck :: (FC, Name) -> Idris ()
defer_totcheck (FC, Name)
n
= do IState
i <- Idris IState
getIState;
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_defertotcheck = nub (idris_defertotcheck i ++ [n]) }
clear_totcheck :: Idris ()
clear_totcheck :: Idris ()
clear_totcheck = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_totcheck = [] }
setFlags :: Name -> [FnOpt] -> Idris ()
setFlags :: Name -> [FnOpt] -> Idris ()
setFlags Name
n [FnOpt]
fs = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_flags = addDef n fs (idris_flags i) }
addFnOpt :: Name -> FnOpt -> Idris ()
addFnOpt :: Name -> FnOpt -> Idris ()
addFnOpt Name
n FnOpt
f = do IState
i <- Idris IState
getIState
let fls :: [FnOpt]
fls = case Name -> Ctxt [FnOpt] -> Maybe [FnOpt]
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt [FnOpt]
idris_flags IState
i) of
Maybe [FnOpt]
Nothing -> []
Just [FnOpt]
x -> [FnOpt]
x
Name -> [FnOpt] -> Idris ()
setFlags Name
n (FnOpt
f FnOpt -> [FnOpt] -> [FnOpt]
forall a. a -> [a] -> [a]
: [FnOpt]
fls)
setFnInfo :: Name -> FnInfo -> Idris ()
setFnInfo :: Name -> FnInfo -> Idris ()
setFnInfo Name
n FnInfo
fs = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_fninfo = addDef n fs (idris_fninfo i) }
setAccessibility :: Name -> Accessibility -> Idris ()
setAccessibility :: Name -> Accessibility -> Idris ()
setAccessibility Name
n Accessibility
a
= do IState
i <- Idris IState
getIState
let ctxt :: Context
ctxt = Name -> Accessibility -> Context -> Context
setAccess Name
n Accessibility
a (IState -> Context
tt_ctxt IState
i)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt = ctxt }
getFromHideList :: Name -> Idris (Maybe Accessibility)
getFromHideList :: Name -> Idris (Maybe Accessibility)
getFromHideList Name
n = do IState
i <- Idris IState
getIState
Maybe Accessibility -> Idris (Maybe Accessibility)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Accessibility -> Idris (Maybe Accessibility))
-> Maybe Accessibility -> Idris (Maybe Accessibility)
forall a b. (a -> b) -> a -> b
$ Name -> Ctxt Accessibility -> Maybe Accessibility
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt Accessibility
hide_list IState
i)
setTotality :: Name -> Totality -> Idris ()
setTotality :: Name -> Totality -> Idris ()
setTotality Name
n Totality
a
= do IState
i <- Idris IState
getIState
let ctxt :: Context
ctxt = Name -> Totality -> Context -> Context
setTotal Name
n Totality
a (IState -> Context
tt_ctxt IState
i)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt = ctxt }
setInjectivity :: Name -> Injectivity -> Idris ()
setInjectivity :: Name -> Bool -> Idris ()
setInjectivity Name
n Bool
a
= do IState
i <- Idris IState
getIState
let ctxt :: Context
ctxt = Name -> Bool -> Context -> Context
setInjective Name
n Bool
a (IState -> Context
tt_ctxt IState
i)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt = ctxt }
getTotality :: Name -> Idris Totality
getTotality :: Name -> Idris Totality
getTotality Name
n
= do IState
i <- Idris IState
getIState
case Name -> Context -> [Totality]
lookupTotal Name
n (IState -> Context
tt_ctxt IState
i) of
[Totality
t] -> Totality -> Idris Totality
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Totality
t
[Totality]
_ -> Totality -> Idris Totality
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Totality
Total [])
getCoercionsTo :: IState -> Type -> [Name]
getCoercionsTo :: IState -> Term -> [Name]
getCoercionsTo IState
i Term
ty =
let cs :: [Name]
cs = IState -> [Name]
idris_coercions IState
i
(Term
fn,[Term]
_) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply (Term -> Term
forall n. TT n -> TT n
getRetTy Term
ty) in
Term -> [Name] -> [Name]
findCoercions Term
fn [Name]
cs
where findCoercions :: Term -> [Name] -> [Name]
findCoercions Term
_ [] = []
findCoercions Term
t (Name
n : [Name]
ns) =
let ps :: [Name]
ps = case Name -> Context -> [Term]
lookupTy Name
n (IState -> Context
tt_ctxt IState
i) of
[Term
ty'] -> case Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply (Term -> Term
forall n. TT n -> TT n
getRetTy (Context -> Env -> Term -> Term
normalise (IState -> Context
tt_ctxt IState
i) [] Term
ty')) of
(Term
t', [Term]
_) -> [Name
n | Term
t Term -> Term -> Bool
forall a. Eq a => a -> a -> Bool
== Term
t']
[Term]
_ -> [] in
[Name]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ Term -> [Name] -> [Name]
findCoercions Term
t [Name]
ns
addToCG :: Name -> CGInfo -> Idris ()
addToCG :: Name -> CGInfo -> Idris ()
addToCG Name
n CGInfo
cg
= do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_callgraph = addDef n cg (idris_callgraph i) }
addCalls :: Name -> [Name] -> Idris ()
addCalls :: Name -> [Name] -> Idris ()
addCalls Name
n [Name]
calls
= do IState
i <- Idris IState
getIState
case Name -> Ctxt CGInfo -> Maybe CGInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt CGInfo
idris_callgraph IState
i) of
Maybe CGInfo
Nothing -> Name -> CGInfo -> Idris ()
addToCG Name
n ([Name]
-> Maybe [Name] -> [SCGEntry] -> [(Int, [(Name, Int)])] -> CGInfo
CGInfo [Name]
calls Maybe [Name]
forall a. Maybe a
Nothing [] [])
Just (CGInfo [Name]
cs Maybe [Name]
ans [SCGEntry]
scg [(Int, [(Name, Int)])]
used) ->
Name -> CGInfo -> Idris ()
addToCG Name
n ([Name]
-> Maybe [Name] -> [SCGEntry] -> [(Int, [(Name, Int)])] -> CGInfo
CGInfo ([Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
calls [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
cs)) Maybe [Name]
ans [SCGEntry]
scg [(Int, [(Name, Int)])]
used)
addTyInferred :: Name -> Idris ()
addTyInferred :: Name -> Idris ()
addTyInferred Name
n
= do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_tyinfodata =
addDef n TIPartial (idris_tyinfodata i) }
addTyInfConstraints :: FC -> [(Term, Term)] -> Idris ()
addTyInfConstraints :: FC -> [(Term, Term)] -> Idris ()
addTyInfConstraints FC
fc [(Term, Term)]
ts = do Int -> FilePath -> Idris ()
logLvl Int
2 (FilePath -> Idris ()) -> FilePath -> Idris ()
forall a b. (a -> b) -> a -> b
$ FilePath
"TI missing: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [(Term, Term)] -> FilePath
forall a. Show a => a -> FilePath
show [(Term, Term)]
ts
((Term, Term) -> Idris ()) -> [(Term, Term)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term, Term) -> Idris ()
addConstraint [(Term, Term)]
ts
() -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where addConstraint :: (Term, Term) -> Idris ()
addConstraint (Term
x, Term
y) = Term -> Term -> Idris ()
findMVApps Term
x Term
y
findMVApps :: Term -> Term -> Idris ()
findMVApps Term
x Term
y
= do let (Term
fx, [Term]
argsx) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
x
let (Term
fy, [Term]
argsy) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
y
if (Term
fx Term -> Term -> Bool
forall a. Eq a => a -> a -> Bool
/= Term
fy)
then do
Term -> Term -> Idris ()
tryAddMV Term
fx Term
y
Term -> Term -> Idris ()
tryAddMV Term
fy Term
x
else ((Term, Term) -> Idris ()) -> [(Term, Term)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term, Term) -> Idris ()
addConstraint ([Term] -> [Term] -> [(Term, Term)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Term]
argsx [Term]
argsy)
tryAddMV :: Term -> Term -> Idris ()
tryAddMV (P NameType
_ Name
mv Term
_) Term
y =
do IState
ist <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
case Name
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
-> Maybe (Maybe Name, Int, [Name], Bool, Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
mv (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
ist) of
Just (Maybe Name, Int, [Name], Bool, Bool)
_ -> Name -> Term -> Idris ()
addConstraintRule Name
mv Term
y
Maybe (Maybe Name, Int, [Name], Bool, Bool)
_ -> () -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tryAddMV Term
_ Term
_ = () -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addConstraintRule :: Name -> Term -> Idris ()
addConstraintRule :: Name -> Term -> Idris ()
addConstraintRule Name
n Term
t
= do IState
ist <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
Int -> FilePath -> Idris ()
logLvl Int
1 (FilePath -> Idris ()) -> FilePath -> Idris ()
forall a b. (a -> b) -> a -> b
$ FilePath
"TI constraint: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Name, Term) -> FilePath
forall a. Show a => a -> FilePath
show (Name
n, Term
t)
case Name -> Ctxt TIData -> [TIData]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt TIData
idris_tyinfodata IState
ist) of
[TISolution [Term]
ts] ->
do (Term -> Idris ()) -> [Term] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term -> Term -> Idris ()
checkConsistent Term
t) [Term]
ts
let ti' :: Ctxt TIData
ti' = Name -> TIData -> Ctxt TIData -> Ctxt TIData
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n ([Term] -> TIData
TISolution (Term
t Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: [Term]
ts))
(IState -> Ctxt TIData
idris_tyinfodata IState
ist)
IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_tyinfodata = ti' }
[TIData]
_ ->
do let ti' :: Ctxt TIData
ti' = Name -> TIData -> Ctxt TIData -> Ctxt TIData
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n ([Term] -> TIData
TISolution [Term
t])
(IState -> Ctxt TIData
idris_tyinfodata IState
ist)
IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_tyinfodata = ti' }
checkConsistent :: Term -> Term -> Idris ()
checkConsistent :: Term -> Term -> Idris ()
checkConsistent Term
x Term
y =
do let (Term
fx, [Term]
_) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
x
let (Term
fy, [Term]
_) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
y
case (Term
fx, Term
fy) of
(P (TCon Int
_ Int
_) Name
n Term
_, P (TCon Int
_ Int
_) Name
n' Term
_) -> Bool -> Idris ()
errWhen (Name
nName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
n')
(P (TCon Int
_ Int
_) Name
n Term
_, Constant Const
_) -> Bool -> Idris ()
errWhen Bool
True
(Constant Const
_, P (TCon Int
_ Int
_) Name
n' Term
_) -> Bool -> Idris ()
errWhen Bool
True
(P (DCon Int
_ Int
_ Bool
_) Name
n Term
_, P (DCon Int
_ Int
_ Bool
_) Name
n' Term
_) -> Bool -> Idris ()
errWhen (Name
nName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
n')
(Term, Term)
_ -> () -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where errWhen :: Bool -> Idris ()
errWhen Bool
True
= Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc
(Bool
-> (Term, Maybe Provenance)
-> (Term, Maybe Provenance)
-> Err
-> [(Name, Term)]
-> Int
-> Err
forall t.
Bool
-> (t, Maybe Provenance)
-> (t, Maybe Provenance)
-> Err' t
-> [(Name, t)]
-> Int
-> Err' t
CantUnify Bool
False (Term
x, Maybe Provenance
forall a. Maybe a
Nothing) (Term
y, Maybe Provenance
forall a. Maybe a
Nothing) (FilePath -> Err
forall t. FilePath -> Err' t
Msg FilePath
"") [] Int
0))
errWhen Bool
False = () -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
isTyInferred :: Name -> Idris Bool
isTyInferred :: Name -> Idris Bool
isTyInferred Name
n
= do IState
i <- Idris IState
getIState
case Name -> Ctxt TIData -> [TIData]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt TIData
idris_tyinfodata IState
i) of
[TIData
TIPartial] -> Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[TIData]
_ -> Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
addFunctionErrorHandlers :: Name -> Name -> [Name] -> Idris ()
addFunctionErrorHandlers :: Name -> Name -> [Name] -> Idris ()
addFunctionErrorHandlers Name
f Name
arg [Name]
hs =
do IState
i <- Idris IState
getIState
let oldHandlers :: Ctxt (Map Name (Set Name))
oldHandlers = IState -> Ctxt (Map Name (Set Name))
idris_function_errorhandlers IState
i
let newHandlers :: Ctxt (Map Name (Set Name))
newHandlers = (Map Name (Set Name)
-> Ctxt (Map Name (Set Name)) -> Ctxt (Map Name (Set Name)))
-> Ctxt (Map Name (Set Name))
-> Map Name (Set Name)
-> Ctxt (Map Name (Set Name))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name
-> Map Name (Set Name)
-> Ctxt (Map Name (Set Name))
-> Ctxt (Map Name (Set Name))
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
f) Ctxt (Map Name (Set Name))
oldHandlers (Map Name (Set Name) -> Ctxt (Map Name (Set Name)))
-> Map Name (Set Name) -> Ctxt (Map Name (Set Name))
forall a b. (a -> b) -> a -> b
$
case Name -> Ctxt (Map Name (Set Name)) -> Maybe (Map Name (Set Name))
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
f Ctxt (Map Name (Set Name))
oldHandlers of
Maybe (Map Name (Set Name))
Nothing -> Name -> Set Name -> Map Name (Set Name)
forall k a. k -> a -> Map k a
M.singleton Name
arg ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList [Name]
hs)
Just (Map Name (Set Name)
oldHandlers) -> (Set Name -> Set Name -> Set Name)
-> Name -> Set Name -> Map Name (Set Name) -> Map Name (Set Name)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Name
arg ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList [Name]
hs) Map Name (Set Name)
oldHandlers
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_function_errorhandlers = newHandlers }
getAllNames :: Name -> Idris [Name]
getAllNames :: Name -> Idris [Name]
getAllNames Name
n = do IState
i <- Idris IState
getIState
case IState -> Name -> Maybe [Name]
getCGAllNames IState
i Name
n of
Just [Name]
ns -> [Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns
Maybe [Name]
Nothing -> do [Name]
ns <- [Name] -> Name -> Idris [Name]
allNames [] Name
n
IState -> Name -> [Name] -> Idris ()
addCGAllNames IState
i Name
n [Name]
ns
[Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns
getCGAllNames :: IState -> Name -> Maybe [Name]
getCGAllNames :: IState -> Name -> Maybe [Name]
getCGAllNames IState
i Name
n = case Name -> Ctxt CGInfo -> Maybe CGInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt CGInfo
idris_callgraph IState
i) of
Just CGInfo
ci -> CGInfo -> Maybe [Name]
allCalls CGInfo
ci
Maybe CGInfo
_ -> Maybe [Name]
forall a. Maybe a
Nothing
addCGAllNames :: IState -> Name -> [Name] -> Idris ()
addCGAllNames :: IState -> Name -> [Name] -> Idris ()
addCGAllNames IState
i Name
n [Name]
ns
= case Name -> Ctxt CGInfo -> Maybe CGInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt CGInfo
idris_callgraph IState
i) of
Just CGInfo
ci -> Name -> CGInfo -> Idris ()
addToCG Name
n (CGInfo
ci { allCalls = Just ns })
Maybe CGInfo
_ -> Name -> CGInfo -> Idris ()
addToCG Name
n ([Name]
-> Maybe [Name] -> [SCGEntry] -> [(Int, [(Name, Int)])] -> CGInfo
CGInfo [] ([Name] -> Maybe [Name]
forall a. a -> Maybe a
Just [Name]
ns) [] [])
allNames :: [Name] -> Name -> Idris [Name]
allNames :: [Name] -> Name -> Idris [Name]
allNames [Name]
ns Name
n | Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns = [Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
allNames [Name]
ns Name
n = do IState
i <- Idris IState
getIState
case IState -> Name -> Maybe [Name]
getCGAllNames IState
i Name
n of
Just [Name]
ns -> [Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns
Maybe [Name]
Nothing -> case Name -> Ctxt CGInfo -> Maybe CGInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt CGInfo
idris_callgraph IState
i) of
Just CGInfo
ci ->
do [[Name]]
more <- (Name -> Idris [Name])
-> [Name] -> StateT IState (ExceptT Err IO) [[Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Name] -> Name -> Idris [Name]
allNames (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ns)) (CGInfo -> [Name]
calls CGInfo
ci)
let ns' :: [Name]
ns' = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
more)
IState -> Name -> [Name] -> Idris ()
addCGAllNames IState
i Name
n [Name]
ns'
[Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns'
Maybe CGInfo
_ -> [Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
n]
addCoercion :: Name -> Idris ()
addCoercion :: Name -> Idris ()
addCoercion Name
n = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_coercions = nub $ n : idris_coercions i }
addDocStr :: Name -> Docstring DocTerm -> [(Name, Docstring DocTerm)] -> Idris ()
addDocStr :: Name
-> Docstring DocTerm -> [(Name, Docstring DocTerm)] -> Idris ()
addDocStr Name
n Docstring DocTerm
doc [(Name, Docstring DocTerm)]
args
= do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_docstrings = addDef n (doc, args) (idris_docstrings i) }
addNameHint :: Name -> Name -> Idris ()
addNameHint :: Name -> Name -> Idris ()
addNameHint Name
ty Name
n
= do IState
i <- Idris IState
getIState
Name
ty' <- case Name -> Ctxt [PArg] -> [(Name, [PArg])]
forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
ty (IState -> Ctxt [PArg]
idris_implicits IState
i) of
[(Name
tyn, [PArg]
_)] -> Name -> StateT IState (ExceptT Err IO) Name
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
tyn
[] -> Err -> StateT IState (ExceptT Err IO) Name
forall a. Err -> Idris a
throwError (Name -> Err
forall t. Name -> Err' t
NoSuchVariable Name
ty)
[(Name, [PArg])]
tyns -> Err -> StateT IState (ExceptT Err IO) Name
forall a. Err -> Idris a
throwError ([Name] -> Err
forall t. [Name] -> Err' t
CantResolveAlts (((Name, [PArg]) -> Name) -> [(Name, [PArg])] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [PArg]) -> Name
forall a b. (a, b) -> a
fst [(Name, [PArg])]
tyns))
let ns' :: [Name]
ns' = case Name -> Ctxt [Name] -> [[Name]]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
ty' (IState -> Ctxt [Name]
idris_namehints IState
i) of
[[Name]
ns] -> [Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
n]
[[Name]]
_ -> [Name
n]
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_namehints = addDef ty' ns' (idris_namehints i) }
getNameHints :: IState -> Name -> [Name]
getNameHints :: IState -> Name -> [Name]
getNameHints IState
_ (UN Text
arr) | Text
arr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"->" = [FilePath -> Name
sUN FilePath
"f",FilePath -> Name
sUN FilePath
"g"]
getNameHints IState
i Name
n =
case Name -> Ctxt [Name] -> [[Name]]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt [Name]
idris_namehints IState
i) of
[[Name]
ns] -> [Name]
ns
[[Name]]
_ -> []
addDeprecated :: Name -> String -> Idris ()
addDeprecated :: Name -> FilePath -> Idris ()
addDeprecated Name
n FilePath
reason = do
IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_deprecated = addDef n reason (idris_deprecated i) }
getDeprecated :: Name -> Idris (Maybe String)
getDeprecated :: Name -> Idris (Maybe FilePath)
getDeprecated Name
n = do
IState
i <- Idris IState
getIState
Maybe FilePath -> Idris (Maybe FilePath)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Idris (Maybe FilePath))
-> Maybe FilePath -> Idris (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Name -> Ctxt FilePath -> Maybe FilePath
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt FilePath
idris_deprecated IState
i)
addFragile :: Name -> String -> Idris ()
addFragile :: Name -> FilePath -> Idris ()
addFragile Name
n FilePath
reason = do
IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_fragile = addDef n reason (idris_fragile i) }
getFragile :: Name -> Idris (Maybe String)
getFragile :: Name -> Idris (Maybe FilePath)
getFragile Name
n = do
IState
i <- Idris IState
getIState
Maybe FilePath -> Idris (Maybe FilePath)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Idris (Maybe FilePath))
-> Maybe FilePath -> Idris (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Name -> Ctxt FilePath -> Maybe FilePath
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt FilePath
idris_fragile IState
i)
push_estack :: Name -> Bool -> Idris ()
push_estack :: Name -> Bool -> Idris ()
push_estack Name
n Bool
implementation
= do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState
i { elab_stack = (n, implementation) : elab_stack i })
pop_estack :: Idris ()
pop_estack :: Idris ()
pop_estack = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState
i { elab_stack = ptail (elab_stack i) })
where ptail :: [a] -> [a]
ptail [] = []
ptail (a
_ : [a]
xs) = [a]
xs
addImplementation :: Bool
-> Bool
-> Name
-> Name
-> Idris ()
addImplementation :: Bool -> Bool -> Name -> Name -> Idris ()
addImplementation Bool
int Bool
res Name
n Name
i
= do IState
ist <- Idris IState
getIState
case Name -> Ctxt InterfaceInfo -> [InterfaceInfo]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist) of
[CI Name
a [(Name, (Bool, [FnOpt], PTerm))]
b [(Name, (Name, PDecl))]
c [PDecl]
d [Name]
e [Name]
f [PTerm]
g [(Name, Bool)]
ins [Int]
fds] ->
do let cs :: Ctxt InterfaceInfo
cs = Name -> InterfaceInfo -> Ctxt InterfaceInfo -> Ctxt InterfaceInfo
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n (Name
-> [(Name, (Bool, [FnOpt], PTerm))]
-> [(Name, (Name, PDecl))]
-> [PDecl]
-> [Name]
-> [Name]
-> [PTerm]
-> [(Name, Bool)]
-> [Int]
-> InterfaceInfo
CI Name
a [(Name, (Bool, [FnOpt], PTerm))]
b [(Name, (Name, PDecl))]
c [PDecl]
d [Name]
e [Name]
f [PTerm]
g (Name -> [(Name, Bool)] -> [(Name, Bool)]
addI Name
i [(Name, Bool)]
ins) [Int]
fds) (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces = cs }
[InterfaceInfo]
_ -> do let cs :: Ctxt InterfaceInfo
cs = Name -> InterfaceInfo -> Ctxt InterfaceInfo -> Ctxt InterfaceInfo
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n (Name
-> [(Name, (Bool, [FnOpt], PTerm))]
-> [(Name, (Name, PDecl))]
-> [PDecl]
-> [Name]
-> [Name]
-> [PTerm]
-> [(Name, Bool)]
-> [Int]
-> InterfaceInfo
CI (Int -> FilePath -> Name
sMN Int
0 FilePath
"none") [] [] [] [] [] [] [(Name
i, Bool
res)] []) (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces = cs }
where addI, insI :: Name -> [(Name, Bool)] -> [(Name, Bool)]
addI :: Name -> [(Name, Bool)] -> [(Name, Bool)]
addI Name
i [(Name, Bool)]
ins | Bool
int = (Name
i, Bool
res) (Name, Bool) -> [(Name, Bool)] -> [(Name, Bool)]
forall a. a -> [a] -> [a]
: [(Name, Bool)]
ins
| Name -> Bool
chaser Name
n = [(Name, Bool)]
ins [(Name, Bool)] -> [(Name, Bool)] -> [(Name, Bool)]
forall a. [a] -> [a] -> [a]
++ [(Name
i, Bool
res)]
| Bool
otherwise = Name -> [(Name, Bool)] -> [(Name, Bool)]
insI Name
i [(Name, Bool)]
ins
insI :: Name -> [(Name, Bool)] -> [(Name, Bool)]
insI Name
i [] = [(Name
i, Bool
res)]
insI Name
i ((Name, Bool)
n : [(Name, Bool)]
ns) | Name -> Bool
chaser ((Name, Bool) -> Name
forall a b. (a, b) -> a
fst (Name, Bool)
n) = (Name
i, Bool
res) (Name, Bool) -> [(Name, Bool)] -> [(Name, Bool)]
forall a. a -> [a] -> [a]
: (Name, Bool)
n (Name, Bool) -> [(Name, Bool)] -> [(Name, Bool)]
forall a. a -> [a] -> [a]
: [(Name, Bool)]
ns
| Bool
otherwise = (Name, Bool)
n (Name, Bool) -> [(Name, Bool)] -> [(Name, Bool)]
forall a. a -> [a] -> [a]
: Name -> [(Name, Bool)] -> [(Name, Bool)]
insI Name
i [(Name, Bool)]
ns
chaser :: Name -> Bool
chaser (SN (ParentN Name
_ Text
_)) = Bool
True
chaser (NS Name
n [Text]
_) = Name -> Bool
chaser Name
n
chaser Name
_ = Bool
False
addOpenImpl :: [Name] -> Idris [Name]
addOpenImpl :: [Name] -> Idris [Name]
addOpenImpl [Name]
ns = do IState
ist <- Idris IState
getIState
[Name]
ns' <- (Name -> StateT IState (ExceptT Err IO) Name)
-> [Name] -> Idris [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IState -> Name -> StateT IState (ExceptT Err IO) Name
checkValid IState
ist) [Name]
ns
let open :: [Name]
open = IState -> [Name]
idris_openimpls IState
ist
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_openimpls = nub (ns' ++ open) }
[Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
open
where
checkValid :: IState -> Name -> StateT IState (ExceptT Err IO) Name
checkValid IState
ist Name
n
= case Name -> Ctxt [PArg] -> [(Name, [PArg])]
forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
n (IState -> Ctxt [PArg]
idris_implicits IState
ist) of
[(Name
n', [PArg]
_)] -> Name -> StateT IState (ExceptT Err IO) Name
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n'
[] -> Err -> StateT IState (ExceptT Err IO) Name
forall a. Err -> Idris a
throwError (Name -> Err
forall t. Name -> Err' t
NoSuchVariable Name
n)
[(Name, [PArg])]
more -> Err -> StateT IState (ExceptT Err IO) Name
forall a. Err -> Idris a
throwError ([Name] -> Err
forall t. [Name] -> Err' t
CantResolveAlts (((Name, [PArg]) -> Name) -> [(Name, [PArg])] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [PArg]) -> Name
forall a b. (a, b) -> a
fst [(Name, [PArg])]
more))
setOpenImpl :: [Name] -> Idris ()
setOpenImpl :: [Name] -> Idris ()
setOpenImpl [Name]
ns = do IState
ist <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_openimpls = ns }
getOpenImpl :: Idris [Name]
getOpenImpl :: Idris [Name]
getOpenImpl = do IState
ist <- Idris IState
getIState
[Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> [Name]
idris_openimpls IState
ist)
addInterface :: Name -> InterfaceInfo -> Idris ()
addInterface :: Name -> InterfaceInfo -> Idris ()
addInterface Name
n InterfaceInfo
i
= do IState
ist <- Idris IState
getIState
let i' :: InterfaceInfo
i' = case Name -> Ctxt InterfaceInfo -> [InterfaceInfo]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist) of
[InterfaceInfo
c] -> InterfaceInfo
i { interface_implementations = interface_implementations c ++
interface_implementations i }
[InterfaceInfo]
_ -> InterfaceInfo
i
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces = addDef n i' (idris_interfaces ist) }
updateIMethods :: Name -> [(Name, PTerm)] -> Idris ()
updateIMethods :: Name -> [(Name, PTerm)] -> Idris ()
updateIMethods Name
n [(Name, PTerm)]
meths
= do IState
ist <- Idris IState
getIState
let i :: InterfaceInfo
i = case Name -> Ctxt InterfaceInfo -> Maybe InterfaceInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist) of
Just InterfaceInfo
c -> InterfaceInfo
c { interface_methods = update (interface_methods c) }
Maybe InterfaceInfo
Nothing -> FilePath -> InterfaceInfo
forall a. HasCallStack => FilePath -> a
error FilePath
"Can't happen updateIMethods"
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces = addDef n i (idris_interfaces ist) }
where
update :: [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
update [] = []
update (m :: (Name, (a, b, PTerm))
m@(Name
n, (a
b, b
opts, PTerm
t)) : [(Name, (a, b, PTerm))]
rest)
| Just PTerm
ty <- Name -> [(Name, PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, PTerm)]
meths
= (Name
n, (a
b, b
opts, PTerm
ty)) (Name, (a, b, PTerm))
-> [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
forall a. a -> [a] -> [a]
: [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
update [(Name, (a, b, PTerm))]
rest
| Bool
otherwise = (Name, (a, b, PTerm))
m (Name, (a, b, PTerm))
-> [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
forall a. a -> [a] -> [a]
: [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
update [(Name, (a, b, PTerm))]
rest
addRecord :: Name -> RecordInfo -> Idris ()
addRecord :: Name -> RecordInfo -> Idris ()
addRecord Name
n RecordInfo
ri = do IState
ist <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_records = addDef n ri (idris_records ist) }
addAutoHint :: Name -> Name -> Idris ()
addAutoHint :: Name -> Name -> Idris ()
addAutoHint Name
n Name
hint =
do IState
ist <- Idris IState
getIState
case Name -> Ctxt [Name] -> Maybe [Name]
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt [Name]
idris_autohints IState
ist) of
Maybe [Name]
Nothing ->
do let hs :: Ctxt [Name]
hs = Name -> [Name] -> Ctxt [Name] -> Ctxt [Name]
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n [Name
hint] (IState -> Ctxt [Name]
idris_autohints IState
ist)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_autohints = hs }
Just [Name]
nhints ->
do let hs :: Ctxt [Name]
hs = Name -> [Name] -> Ctxt [Name] -> Ctxt [Name]
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n (Name
hint Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
nhints) (IState -> Ctxt [Name]
idris_autohints IState
ist)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_autohints = hs }
getAutoHints :: Name -> Idris [Name]
getAutoHints :: Name -> Idris [Name]
getAutoHints Name
n = do IState
ist <- Idris IState
getIState
case Name -> Ctxt [Name] -> Maybe [Name]
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt [Name]
idris_autohints IState
ist) of
Maybe [Name]
Nothing -> [Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just [Name]
ns -> [Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns
addIBC :: IBCWrite -> Idris ()
addIBC :: IBCWrite -> Idris ()
addIBC ibc :: IBCWrite
ibc@(IBCDef Name
n)
= do IState
i <- Idris IState
getIState
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([IBCWrite] -> Bool
notDef (IState -> [IBCWrite]
ibc_write IState
i)) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { ibc_write = ibc : ibc_write i }
where notDef :: [IBCWrite] -> Bool
notDef [] = Bool
True
notDef (IBCDef Name
n': [IBCWrite]
_) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = Bool
False
notDef (IBCWrite
_ : [IBCWrite]
is) = [IBCWrite] -> Bool
notDef [IBCWrite]
is
addIBC IBCWrite
ibc = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { ibc_write = ibc : ibc_write i }
clearIBC :: Idris ()
clearIBC :: Idris ()
clearIBC = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { ibc_write = [],
idris_inmodule = S.empty }
resetNameIdx :: Idris ()
resetNameIdx :: Idris ()
resetNameIdx = do IState
i <- Idris IState
getIState
IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_nameIdx = (0, emptyContext) })
addNameIdx :: Name -> Idris (Int, Name)
addNameIdx :: Name -> Idris (Int, Name)
addNameIdx Name
n = do IState
i <- Idris IState
getIState
let (IState
i', (Int, Name)
x) = IState -> Name -> (IState, (Int, Name))
addNameIdx' IState
i Name
n
IState -> Idris ()
putIState IState
i'
(Int, Name) -> Idris (Int, Name)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int, Name)
x
addNameIdx' :: IState -> Name -> (IState, (Int, Name))
addNameIdx' :: IState -> Name -> (IState, (Int, Name))
addNameIdx' IState
i Name
n
= let idxs :: Map Name (Map Name (Int, Name))
idxs = (Int, Map Name (Map Name (Int, Name)))
-> Map Name (Map Name (Int, Name))
forall a b. (a, b) -> b
snd (IState -> (Int, Map Name (Map Name (Int, Name)))
idris_nameIdx IState
i) in
case Name -> Map Name (Map Name (Int, Name)) -> [(Int, Name)]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n Map Name (Map Name (Int, Name))
idxs of
[(Int, Name)
x] -> (IState
i, (Int, Name)
x)
[(Int, Name)]
_ -> let i' :: Int
i' = (Int, Map Name (Map Name (Int, Name))) -> Int
forall a b. (a, b) -> a
fst (IState -> (Int, Map Name (Map Name (Int, Name)))
idris_nameIdx IState
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 in
(IState
i { idris_nameIdx = (i', addDef n (i', n) idxs) }, (Int
i', Name
n))
getSymbol :: Name -> Idris Name
getSymbol :: Name -> StateT IState (ExceptT Err IO) Name
getSymbol Name
n = do IState
i <- Idris IState
getIState
case Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n (IState -> Map Name Name
idris_symbols IState
i) of
Just Name
n' -> Name -> StateT IState (ExceptT Err IO) Name
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n'
Maybe Name
Nothing -> do let sym' :: Map Name Name
sym' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n (IState -> Map Name Name
idris_symbols IState
i)
IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_symbols = sym' })
Name -> StateT IState (ExceptT Err IO) Name
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
getHdrs :: Codegen -> Idris [String]
getHdrs :: Codegen -> Idris [FilePath]
getHdrs Codegen
tgt = do IState
i <- Idris IState
getIState; [FilePath] -> Idris [FilePath]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Codegen -> [(Codegen, FilePath)] -> [FilePath]
forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt ([(Codegen, FilePath)] -> [FilePath])
-> [(Codegen, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, FilePath)]
idris_hdrs IState
i)
getImported :: Idris [(FilePath, Bool)]
getImported :: Idris [(FilePath, Bool)]
getImported = IState -> [(FilePath, Bool)]
idris_imported (IState -> [(FilePath, Bool)])
-> Idris IState -> Idris [(FilePath, Bool)]
forall a b.
(a -> b)
-> StateT IState (ExceptT Err IO) a
-> StateT IState (ExceptT Err IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Idris IState
getIState
setErrSpan :: FC -> Idris ()
setErrSpan :: FC -> Idris ()
setErrSpan FC
x = do IState
i <- Idris IState
getIState;
case (IState -> Maybe FC
errSpan IState
i) of
Maybe FC
Nothing -> IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { errSpan = Just x }
Just FC
_ -> () -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
clearErr :: Idris ()
clearErr :: Idris ()
clearErr = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { errSpan = Nothing }
getSO :: Idris (Maybe String)
getSO :: Idris (Maybe FilePath)
getSO = do IState
i <- Idris IState
getIState
Maybe FilePath -> Idris (Maybe FilePath)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> Maybe FilePath
compiled_so IState
i)
setSO :: Maybe String -> Idris ()
setSO :: Maybe FilePath -> Idris ()
setSO Maybe FilePath
s = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState
i { compiled_so = s })
getIState :: Idris IState
getIState :: Idris IState
getIState = Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
putIState :: IState -> Idris ()
putIState :: IState -> Idris ()
putIState = IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
updateIState :: (IState -> IState) -> Idris ()
updateIState :: (IState -> IState) -> Idris ()
updateIState IState -> IState
f = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState -> IState
f IState
i
withContext :: (IState -> Ctxt a) -> Name -> b -> (a -> Idris b) -> Idris b
withContext :: forall a b.
(IState -> Ctxt a) -> Name -> b -> (a -> Idris b) -> Idris b
withContext IState -> Ctxt a
ctx Name
name b
dflt a -> Idris b
action = do
IState
ist <- Idris IState
getIState
case Name -> Ctxt a -> [a]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
name (IState -> Ctxt a
ctx IState
ist) of
[a
x] -> a -> Idris b
action a
x
[a]
_ -> b -> Idris b
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return b
dflt
withContext_ :: (IState -> Ctxt a) -> Name -> (a -> Idris ()) -> Idris ()
withContext_ :: forall a. (IState -> Ctxt a) -> Name -> (a -> Idris ()) -> Idris ()
withContext_ IState -> Ctxt a
ctx Name
name a -> Idris ()
action = (IState -> Ctxt a) -> Name -> () -> (a -> Idris ()) -> Idris ()
forall a b.
(IState -> Ctxt a) -> Name -> b -> (a -> Idris b) -> Idris b
withContext IState -> Ctxt a
ctx Name
name () a -> Idris ()
action
runIO :: IO a -> Idris a
runIO :: forall a. IO a -> Idris a
runIO IO a
x = IO (Either IOError a)
-> StateT IState (ExceptT Err IO) (Either IOError a)
forall a. IO a -> Idris a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either IOError a)
forall a. IO a -> IO (Either IOError a)
tryIOError IO a
x) StateT IState (ExceptT Err IO) (Either IOError a)
-> (Either IOError a -> StateT IState (ExceptT Err IO) a)
-> StateT IState (ExceptT Err IO) a
forall a b.
StateT IState (ExceptT Err IO) a
-> (a -> StateT IState (ExceptT Err IO) b)
-> StateT IState (ExceptT Err IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> StateT IState (ExceptT Err IO) a)
-> (a -> StateT IState (ExceptT Err IO) a)
-> Either IOError a
-> StateT IState (ExceptT Err IO) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Err -> StateT IState (ExceptT Err IO) a
forall a. Err -> Idris a
throwError (Err -> StateT IState (ExceptT Err IO) a)
-> (IOError -> Err) -> IOError -> StateT IState (ExceptT Err IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Err
forall t. FilePath -> Err' t
Msg (FilePath -> Err) -> (IOError -> FilePath) -> IOError -> Err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> FilePath
forall a. Show a => a -> FilePath
show) a -> StateT IState (ExceptT Err IO) a
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return
getName :: Idris Int
getName :: Idris Int
getName = do IState
i <- Idris IState
getIState;
let idx :: Int
idx = IState -> Int
idris_name IState
i;
IState -> Idris ()
putIState (IState
i { idris_name = idx + 1 })
Int -> Idris Int
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
addInternalApp :: FilePath -> Int -> PTerm -> Idris ()
addInternalApp :: FilePath -> Int -> PTerm -> Idris ()
addInternalApp FilePath
fp Int
l PTerm
t
= do IState
i <- Idris IState
getIState
Bool
exists <- IO Bool -> Idris Bool
forall a. IO a -> Idris a
runIO (IO Bool -> Idris Bool) -> IO Bool -> Idris Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fp
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
do FilePath
fp' <- IO FilePath -> Idris FilePath
forall a. IO a -> Idris a
runIO (IO FilePath -> Idris FilePath) -> IO FilePath -> Idris FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
fp
IState -> Idris ()
putIState (IState
i { idris_lineapps = ((fp', l), t) : idris_lineapps i })
getInternalApp :: FilePath -> Int -> Idris PTerm
getInternalApp :: FilePath -> Int -> Idris PTerm
getInternalApp FilePath
fp Int
l = do IState
i <- Idris IState
getIState
Bool
exists <- IO Bool -> Idris Bool
forall a. IO a -> Idris a
runIO (IO Bool -> Idris Bool) -> IO Bool -> Idris Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fp
if Bool
exists
then do FilePath
fp' <- IO FilePath -> Idris FilePath
forall a. IO a -> Idris a
runIO (IO FilePath -> Idris FilePath) -> IO FilePath -> Idris FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
fp
case (FilePath, Int) -> [((FilePath, Int), PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath
fp', Int
l) (IState -> [((FilePath, Int), PTerm)]
idris_lineapps IState
i) of
Just PTerm
n' -> PTerm -> Idris PTerm
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
n'
Maybe PTerm
Nothing -> PTerm -> Idris PTerm
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
Placeholder
else PTerm -> Idris PTerm
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
Placeholder
clearOrigPats :: Idris ()
clearOrigPats :: Idris ()
clearOrigPats = do IState
i <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
let ps :: Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
ps = IState -> Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
idris_patdefs IState
i
let ps' :: Ctxt ([a], [PTerm])
ps' = (([([(Name, Term)], Term, Term)], [PTerm]) -> ([a], [PTerm]))
-> Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
-> Ctxt ([a], [PTerm])
forall a b. (a -> b) -> Ctxt a -> Ctxt b
mapCtxt (\ ([([(Name, Term)], Term, Term)]
_,[PTerm]
miss) -> ([], [PTerm]
miss)) Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
ps
IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_patdefs = ps' })
clearPTypes :: Idris ()
clearPTypes :: Idris ()
clearPTypes = do IState
i <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
let ctxt :: Context
ctxt = IState -> Context
tt_ctxt IState
i
IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { tt_ctxt = mapDefCtxt pErase ctxt })
where pErase :: Def -> Def
pErase (CaseOp CaseInfo
c Term
t [(Term, Bool)]
tys [Either Term (Term, Term)]
orig [([Name], Term, Term)]
_ CaseDefs
cds)
= CaseInfo
-> Term
-> [(Term, Bool)]
-> [Either Term (Term, Term)]
-> [([Name], Term, Term)]
-> CaseDefs
-> Def
CaseOp CaseInfo
c Term
t [(Term, Bool)]
tys [Either Term (Term, Term)]
orig [] (CaseDefs -> CaseDefs
pErase' CaseDefs
cds)
pErase Def
x = Def
x
pErase' :: CaseDefs -> CaseDefs
pErase' (CaseDefs ([Name]
cs, SC
c) ([Name], SC)
rs)
= let c' :: ([Name], SC)
c' = ([Name]
cs, (Term -> Term) -> SC -> SC
forall a b. (a -> b) -> SC' a -> SC' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Term
forall n. TT n -> TT n
pEraseType SC
c) in
([Name], SC) -> ([Name], SC) -> CaseDefs
CaseDefs ([Name], SC)
c' ([Name], SC)
rs
checkUndefined :: FC -> Name -> Idris ()
checkUndefined :: FC -> Name -> Idris ()
checkUndefined FC
fc Name
n
= do Context
i <- Idris Context
getContext
case Name -> Context -> [Term]
lookupTy Name
n Context
i of
(Term
_:[Term]
_) -> Err -> Idris ()
forall a. Err -> Idris a
throwError (Err -> Idris ()) -> (FilePath -> Err) -> FilePath -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Err
forall t. FilePath -> Err' t
Msg (FilePath -> Idris ()) -> FilePath -> Idris ()
forall a b. (a -> b) -> a -> b
$ FC -> FilePath
forall a. Show a => a -> FilePath
show FC
fc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" already defined"
[Term]
_ -> () -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
isUndefined :: FC -> Name -> Idris Bool
isUndefined :: FC -> Name -> Idris Bool
isUndefined FC
_ Name
n
= do Context
i <- Idris Context
getContext
case Name -> Context -> Maybe Term
lookupTyExact Name
n Context
i of
Just Term
_ -> Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Maybe Term
_ -> Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
setContext :: Context -> Idris ()
setContext :: Context -> Idris ()
setContext Context
ctxt = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState
i { tt_ctxt = ctxt } )
updateContext :: (Context -> Context) -> Idris ()
updateContext :: (Context -> Context) -> Idris ()
updateContext Context -> Context
f = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState
i { tt_ctxt = f (tt_ctxt i) } )
addConstraints :: FC -> (Int, [UConstraint]) -> Idris ()
addConstraints :: FC -> (Int, [UConstraint]) -> Idris ()
addConstraints FC
fc (Int
v, [UConstraint]
cs)
= do Bool
tit <- Idris Bool
typeInType
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
tit) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$ do
IState
i <- Idris IState
getIState
let ctxt :: Context
ctxt = IState -> Context
tt_ctxt IState
i
let ctxt' :: Context
ctxt' = Context
ctxt { next_tvar = v }
let ics :: Set ConstraintFC
ics = [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll ([UConstraint] -> [FC] -> [(UConstraint, FC)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UConstraint]
cs (FC -> [FC]
forall a. a -> [a]
repeat FC
fc)) (IState -> Set ConstraintFC
idris_constraints IState
i)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt = ctxt', idris_constraints = ics }
where
insertAll :: [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll [] Set ConstraintFC
c = Set ConstraintFC
c
insertAll ((ULE (UVal Int
0) UExp
_, FC
fc) : [(UConstraint, FC)]
cs) Set ConstraintFC
ics = [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll [(UConstraint, FC)]
cs Set ConstraintFC
ics
insertAll ((ULE UExp
x UExp
y, FC
fc) : [(UConstraint, FC)]
cs) Set ConstraintFC
ics | UExp
x UExp -> UExp -> Bool
forall a. Eq a => a -> a -> Bool
== UExp
y = [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll [(UConstraint, FC)]
cs Set ConstraintFC
ics
insertAll ((UConstraint
c, FC
fc) : [(UConstraint, FC)]
cs) Set ConstraintFC
ics
= [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll [(UConstraint, FC)]
cs (Set ConstraintFC -> Set ConstraintFC)
-> Set ConstraintFC -> Set ConstraintFC
forall a b. (a -> b) -> a -> b
$ ConstraintFC -> Set ConstraintFC -> Set ConstraintFC
forall a. Ord a => a -> Set a -> Set a
S.insert (UConstraint -> FC -> ConstraintFC
ConstraintFC UConstraint
c FC
fc) Set ConstraintFC
ics
addDeferred :: [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))] -> Idris ()
addDeferred = NameType
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> Idris ()
addDeferred' NameType
Ref
addDeferredTyCon :: [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))] -> Idris ()
addDeferredTyCon = NameType
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> Idris ()
addDeferred' (Int -> Int -> NameType
TCon Int
0 Int
0)
addDeferred' :: NameType
-> [(Name, (Int, Maybe Name, Type, [Name], Bool, Bool))]
-> Idris ()
addDeferred' :: NameType
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> Idris ()
addDeferred' NameType
nt [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
ns
= do ((Name, (Int, Maybe Name, Term, [Name], Bool, Bool)) -> Idris ())
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Name
n, (Int
i, Maybe Name
_, Term
t, [Name]
_, Bool
_, Bool
_)) -> (Context -> Context) -> Idris ()
updateContext (Name -> NameType -> Term -> Context -> Context
addTyDecl Name
n NameType
nt (Set Name -> Term -> Term
tidyNames Set Name
forall a. Set a
S.empty Term
t))) [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
ns
((Name, (Int, Maybe Name, Term, [Name], Bool, Bool)) -> Idris ())
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Name
n, (Int, Maybe Name, Term, [Name], Bool, Bool)
_) -> Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
primDefs)) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$ IBCWrite -> Idris ()
addIBC (Name -> IBCWrite
IBCMetavar Name
n)) [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
ns
IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_metavars = map (\(Name
n, (Int
i, Maybe Name
top, Term
_, [Name]
ns, Bool
isTopLevel, Bool
isDefinable)) ->
(Name
n, (Maybe Name
top, Int
i, [Name]
ns, Bool
isTopLevel, Bool
isDefinable))) ns ++
idris_metavars i }
where
tidyNames :: Set Name -> Term -> Term
tidyNames Set Name
used (Bind (MN Int
i Text
x) Binder Term
b Term
sc)
= let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet (Text -> Name
UN Text
x) Set Name
used in
Name -> Binder Term -> Term -> Term
forall n. n -> Binder (TT n) -> TT n -> TT n
Bind Name
n' Binder Term
b (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Set Name -> Term -> Term
tidyNames (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
used) Term
sc
tidyNames Set Name
used (Bind Name
n Binder Term
b Term
sc)
= let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet Name
n Set Name
used in
Name -> Binder Term -> Term -> Term
forall n. n -> Binder (TT n) -> TT n -> TT n
Bind Name
n' Binder Term
b (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Set Name -> Term -> Term
tidyNames (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
used) Term
sc
tidyNames Set Name
_ Term
b = Term
b
solveDeferred :: FC -> Name -> Idris ()
solveDeferred :: FC -> Name -> Idris ()
solveDeferred FC
fc Name
n
= do IState
i <- Idris IState
getIState
case Name
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
-> Maybe (Maybe Name, Int, [Name], Bool, Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
i) of
Just (Maybe Name
_, Int
_, [Name]
_, Bool
_, Bool
False) ->
Err -> Idris ()
forall a. Err -> Idris a
throwError (Err -> Idris ()) -> Err -> Idris ()
forall a b. (a -> b) -> a -> b
$ FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc (Err -> Err) -> Err -> Err
forall a b. (a -> b) -> a -> b
$ FilePath -> Err
forall t. FilePath -> Err' t
Msg (FilePath
"Can't define hole " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" as it depends on other holes")
Maybe (Maybe Name, Int, [Name], Bool, Bool)
_ -> IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_metavars =
filter (\(Name
n', (Maybe Name, Int, [Name], Bool, Bool)
_) -> Name
nName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
n')
(idris_metavars i),
ibc_write =
filter (notMV n) (ibc_write i)
}
where notMV :: Name -> IBCWrite -> Bool
notMV Name
n (IBCMetavar Name
n') = Bool -> Bool
not (Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n')
notMV Name
n IBCWrite
_ = Bool
True
getUndefined :: Idris [Name]
getUndefined :: Idris [Name]
getUndefined = do IState
i <- Idris IState
getIState
[Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (((Name, (Maybe Name, Int, [Name], Bool, Bool)) -> Name)
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, (Maybe Name, Int, [Name], Bool, Bool)) -> Name
forall a b. (a, b) -> a
fst (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
i) [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
primDefs)
isMetavarName :: Name -> IState -> Bool
isMetavarName :: Name -> IState -> Bool
isMetavarName Name
n IState
ist
= case Name -> Context -> [Name]
lookupNames Name
n (IState -> Context
tt_ctxt IState
ist) of
(Name
t:[Name]
_) -> Maybe (Maybe Name, Int, [Name], Bool, Bool) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Maybe Name, Int, [Name], Bool, Bool) -> Bool)
-> Maybe (Maybe Name, Int, [Name], Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ Name
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
-> Maybe (Maybe Name, Int, [Name], Bool, Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
t (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
ist)
[Name]
_ -> Bool
False
getWidth :: Idris ConsoleWidth
getWidth :: Idris ConsoleWidth
getWidth = (IState -> ConsoleWidth) -> Idris IState -> Idris ConsoleWidth
forall a b.
(a -> b)
-> StateT IState (ExceptT Err IO) a
-> StateT IState (ExceptT Err IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IState -> ConsoleWidth
idris_consolewidth Idris IState
getIState
setWidth :: ConsoleWidth -> Idris ()
setWidth :: ConsoleWidth -> Idris ()
setWidth ConsoleWidth
w = do IState
ist <- Idris IState
getIState
IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put IState
ist { idris_consolewidth = w }
setDepth :: Maybe Int -> Idris ()
setDepth :: Maybe Int -> Idris ()
setDepth Maybe Int
d = do IState
ist <- Idris IState
getIState
IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put IState
ist { idris_options = (idris_options ist) { opt_printdepth = d } }
typeDescription :: String
typeDescription :: FilePath
typeDescription = FilePath
"The type of types"
type1Doc :: Doc OutputAnnotation
type1Doc :: Doc OutputAnnotation
type1Doc = (OutputAnnotation -> Doc OutputAnnotation -> Doc OutputAnnotation
forall a. a -> Doc a -> Doc a
annotate (FilePath -> FilePath -> OutputAnnotation
AnnType FilePath
"Type" FilePath
"The type of types, one level up") (Doc OutputAnnotation -> Doc OutputAnnotation)
-> Doc OutputAnnotation -> Doc OutputAnnotation
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc OutputAnnotation
forall a. FilePath -> Doc a
text FilePath
"Type 1")
isetPrompt :: String -> Idris ()
isetPrompt :: FilePath -> Idris ()
isetPrompt FilePath
p = do IState
i <- Idris IState
getIState
case IState -> OutputMode
idris_outputmode IState
i of
IdeMode Integer
n Handle
h -> IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> (FilePath -> IO ()) -> FilePath -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
h (FilePath -> Idris ()) -> FilePath -> Idris ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Integer -> FilePath
forall a. SExpable a => FilePath -> a -> Integer -> FilePath
convSExp FilePath
"set-prompt" FilePath
p Integer
n
isetLoadedRegion :: Idris ()
isetLoadedRegion :: Idris ()
isetLoadedRegion = do IState
i <- Idris IState
getIState
let span :: Maybe FC
span = IState -> Maybe FC
idris_parsedSpan IState
i
case Maybe FC
span of
Just FC
fc ->
case IState -> OutputMode
idris_outputmode IState
i of
IdeMode Integer
n Handle
h ->
IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> (FilePath -> IO ()) -> FilePath -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
h (FilePath -> Idris ()) -> FilePath -> Idris ()
forall a b. (a -> b) -> a -> b
$
FilePath -> FC -> Integer -> FilePath
forall a. SExpable a => FilePath -> a -> Integer -> FilePath
convSExp FilePath
"set-loaded-region" FC
fc Integer
n
Maybe FC
Nothing -> () -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setLogLevel :: Int -> Idris ()
setLogLevel :: Int -> Idris ()
setLogLevel Int
l = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_logLevel = l }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
setLogCats :: [LogCat] -> Idris ()
setLogCats :: [LogCat] -> Idris ()
setLogCats [LogCat]
cs = do
IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_logcats = cs }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
setCmdLine :: [Opt] -> Idris ()
setCmdLine :: [Opt] -> Idris ()
setCmdLine [Opt]
opts = do IState
i <- Idris IState
getIState
let iopts :: IOption
iopts = IState -> IOption
idris_options IState
i
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = iopts { opt_cmdline = opts } }
getCmdLine :: Idris [Opt]
getCmdLine :: Idris [Opt]
getCmdLine = do IState
i <- Idris IState
getIState
[Opt] -> Idris [Opt]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
i))
getDumpHighlighting :: Idris Bool
getDumpHighlighting :: Idris Bool
getDumpHighlighting = do IState
ist <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Opt] -> Bool
findC (IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
ist)))
where findC :: [Opt] -> Bool
findC = Opt -> [Opt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Opt
DumpHighlights
getDumpDefun :: Idris (Maybe FilePath)
getDumpDefun :: Idris (Maybe FilePath)
getDumpDefun = do IState
i <- Idris IState
getIState
Maybe FilePath -> Idris (Maybe FilePath)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Idris (Maybe FilePath))
-> Maybe FilePath -> Idris (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ [Opt] -> Maybe FilePath
findC (IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
i))
where findC :: [Opt] -> Maybe FilePath
findC [] = Maybe FilePath
forall a. Maybe a
Nothing
findC (DumpDefun FilePath
x : [Opt]
_) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
x
findC (Opt
_ : [Opt]
xs) = [Opt] -> Maybe FilePath
findC [Opt]
xs
getDumpCases :: Idris (Maybe FilePath)
getDumpCases :: Idris (Maybe FilePath)
getDumpCases = do IState
i <- Idris IState
getIState
Maybe FilePath -> Idris (Maybe FilePath)
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Idris (Maybe FilePath))
-> Maybe FilePath -> Idris (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ [Opt] -> Maybe FilePath
findC (IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
i))
where findC :: [Opt] -> Maybe FilePath
findC [] = Maybe FilePath
forall a. Maybe a
Nothing
findC (DumpCases FilePath
x : [Opt]
_) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
x
findC (Opt
_ : [Opt]
xs) = [Opt] -> Maybe FilePath
findC [Opt]
xs
logLevel :: Idris Int
logLevel :: Idris Int
logLevel = do IState
i <- Idris IState
getIState
Int -> Idris Int
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Int
opt_logLevel (IState -> IOption
idris_options IState
i))
setAutoImpls :: Bool -> Idris ()
setAutoImpls :: Bool -> Idris ()
setAutoImpls Bool
b = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_autoimpls = b }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
getAutoImpls :: Idris Bool
getAutoImpls :: Idris Bool
getAutoImpls = do IState
i <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_autoimpls (IState -> IOption
idris_options IState
i))
setErrContext :: Bool -> Idris ()
setErrContext :: Bool -> Idris ()
setErrContext Bool
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opts' :: IOption
opts' = IOption
opts { opt_errContext = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opts' }
errContext :: Idris Bool
errContext :: Idris Bool
errContext = do IState
i <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_errContext (IState -> IOption
idris_options IState
i))
getOptimise :: Idris [Optimisation]
getOptimise :: Idris [Optimisation]
getOptimise = do IState
i <- Idris IState
getIState
[Optimisation] -> Idris [Optimisation]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> [Optimisation]
opt_optimise (IState -> IOption
idris_options IState
i))
setOptimise :: [Optimisation] -> Idris ()
setOptimise :: [Optimisation] -> Idris ()
setOptimise [Optimisation]
newopts = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opts' :: IOption
opts' = IOption
opts { opt_optimise = newopts }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opts' }
addOptimise :: Optimisation -> Idris ()
addOptimise :: Optimisation -> Idris ()
addOptimise Optimisation
opt = do [Optimisation]
opts <- Idris [Optimisation]
getOptimise
[Optimisation] -> Idris ()
setOptimise ([Optimisation] -> [Optimisation]
forall a. Eq a => [a] -> [a]
nub (Optimisation
opt Optimisation -> [Optimisation] -> [Optimisation]
forall a. a -> [a] -> [a]
: [Optimisation]
opts))
removeOptimise :: Optimisation -> Idris ()
removeOptimise :: Optimisation -> Idris ()
removeOptimise Optimisation
opt = do [Optimisation]
opts <- Idris [Optimisation]
getOptimise
[Optimisation] -> Idris ()
setOptimise (([Optimisation] -> [Optimisation]
forall a. Eq a => [a] -> [a]
nub [Optimisation]
opts) [Optimisation] -> [Optimisation] -> [Optimisation]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Optimisation
opt])
setOptLevel :: Int -> Idris ()
setOptLevel :: Int -> Idris ()
setOptLevel Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Optimisation] -> Idris ()
setOptimise []
setOptLevel Int
1 = [Optimisation] -> Idris ()
setOptimise []
setOptLevel Int
2 = [Optimisation] -> Idris ()
setOptimise [Optimisation
PETransform]
setOptLevel Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 = [Optimisation] -> Idris ()
setOptimise [Optimisation
PETransform]
useREPL :: Idris Bool
useREPL :: Idris Bool
useREPL = do IState
i <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_repl (IState -> IOption
idris_options IState
i))
setREPL :: Bool -> Idris ()
setREPL :: Bool -> Idris ()
setREPL Bool
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_repl = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
showOrigErr :: Idris Bool
showOrigErr :: Idris Bool
showOrigErr = do IState
i <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_origerr (IState -> IOption
idris_options IState
i))
setShowOrigErr :: Bool -> Idris ()
setShowOrigErr :: Bool -> Idris ()
setShowOrigErr Bool
b = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_origerr = b }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
setAutoSolve :: Bool -> Idris ()
setAutoSolve :: Bool -> Idris ()
setAutoSolve Bool
b = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_autoSolve = b }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
setNoBanner :: Bool -> Idris ()
setNoBanner :: Bool -> Idris ()
setNoBanner Bool
n = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_nobanner = n }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
getNoBanner :: Idris Bool
getNoBanner :: Idris Bool
getNoBanner = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_nobanner IOption
opts)
setEvalTypes :: Bool -> Idris ()
setEvalTypes :: Bool -> Idris ()
setEvalTypes Bool
n = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_evaltypes = n }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
getDesugarNats :: Idris Bool
getDesugarNats :: Idris Bool
getDesugarNats = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_desugarnats IOption
opts)
setDesugarNats :: Bool -> Idris ()
setDesugarNats :: Bool -> Idris ()
setDesugarNats Bool
n = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_desugarnats = n }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
setQuiet :: Bool -> Idris ()
setQuiet :: Bool -> Idris ()
setQuiet Bool
q = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_quiet = q }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
getQuiet :: Idris Bool
getQuiet :: Idris Bool
getQuiet = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_quiet IOption
opts)
setCodegen :: Codegen -> Idris ()
setCodegen :: Codegen -> Idris ()
setCodegen Codegen
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_codegen = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
codegen :: Idris Codegen
codegen :: Idris Codegen
codegen = do IState
i <- Idris IState
getIState
Codegen -> Idris Codegen
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Codegen
opt_codegen (IState -> IOption
idris_options IState
i))
setOutputTy :: OutputType -> Idris ()
setOutputTy :: OutputType -> Idris ()
setOutputTy OutputType
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_outputTy = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
outputTy :: Idris OutputType
outputTy :: Idris OutputType
outputTy = do IState
i <- Idris IState
getIState
OutputType -> Idris OutputType
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (OutputType -> Idris OutputType) -> OutputType -> Idris OutputType
forall a b. (a -> b) -> a -> b
$ IOption -> OutputType
opt_outputTy (IOption -> OutputType) -> IOption -> OutputType
forall a b. (a -> b) -> a -> b
$ IState -> IOption
idris_options IState
i
setIdeMode :: Bool -> Handle -> Idris ()
setIdeMode :: Bool -> Handle -> Idris ()
setIdeMode Bool
True Handle
h = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_outputmode = IdeMode 0 h
, idris_colourRepl = False
}
setIdeMode Bool
False Handle
_ = () -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setTargetTriple :: String -> Idris ()
setTargetTriple :: FilePath -> Idris ()
setTargetTriple FilePath
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
opt' :: IOption
opt' = IOption
opts { opt_triple = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
targetTriple :: Idris String
targetTriple :: Idris FilePath
targetTriple = do IState
i <- Idris IState
getIState
FilePath -> Idris FilePath
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> FilePath
opt_triple (IState -> IOption
idris_options IState
i))
setTargetCPU :: String -> Idris ()
setTargetCPU :: FilePath -> Idris ()
setTargetCPU FilePath
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
opt' :: IOption
opt' = IOption
opts { opt_cpu = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
targetCPU :: Idris String
targetCPU :: Idris FilePath
targetCPU = do IState
i <- Idris IState
getIState
FilePath -> Idris FilePath
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> FilePath
opt_cpu (IState -> IOption
idris_options IState
i))
verbose :: Idris Int
verbose :: Idris Int
verbose = do
IState
i <- Idris IState
getIState
let quiet :: Bool
quiet = IOption -> Bool
opt_quiet (IOption -> Bool) -> IOption -> Bool
forall a b. (a -> b) -> a -> b
$ IState -> IOption
idris_options IState
i
if Bool
quiet
then Int -> Idris Int
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Idris Int) -> Int -> Idris Int
forall a b. (a -> b) -> a -> b
$ Int
0
else Int -> Idris Int
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Idris Int) -> Int -> Idris Int
forall a b. (a -> b) -> a -> b
$ (IOption -> Int
opt_verbose (IOption -> Int) -> IOption -> Int
forall a b. (a -> b) -> a -> b
$ IState -> IOption
idris_options IState
i)
setVerbose :: Int -> Idris ()
setVerbose :: Int -> Idris ()
setVerbose Int
t = do
IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_verbose = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
iReport :: Int -> String -> Idris ()
iReport :: Int -> FilePath -> Idris ()
iReport Int
level FilePath
msg = do
Int
verbosity <- Idris Int
verbose
IState
i <- Idris IState
getIState
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
verbosity) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
case IState -> OutputMode
idris_outputmode IState
i of
RawOutput Handle
h -> IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> IO () -> Idris ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
h FilePath
msg
IdeMode Integer
n Handle
h -> IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> (FilePath -> IO ()) -> FilePath -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
h (FilePath -> Idris ()) -> FilePath -> Idris ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Integer -> FilePath
forall a. SExpable a => FilePath -> a -> Integer -> FilePath
convSExp FilePath
"write-string" FilePath
msg Integer
n
() -> Idris ()
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
typeInType :: Idris Bool
typeInType :: Idris Bool
typeInType = do IState
i <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_typeintype (IState -> IOption
idris_options IState
i))
setTypeInType :: Bool -> Idris ()
setTypeInType :: Bool -> Idris ()
setTypeInType Bool
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_typeintype = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
coverage :: Idris Bool
coverage :: Idris Bool
coverage = do IState
i <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_coverage (IState -> IOption
idris_options IState
i))
setCoverage :: Bool -> Idris ()
setCoverage :: Bool -> Idris ()
setCoverage Bool
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_coverage = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
setIBCSubDir :: FilePath -> Idris ()
setIBCSubDir :: FilePath -> Idris ()
setIBCSubDir FilePath
fp = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_ibcsubdir = fp }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
valIBCSubDir :: IState -> Idris FilePath
valIBCSubDir :: IState -> Idris FilePath
valIBCSubDir IState
i = FilePath -> Idris FilePath
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> FilePath
opt_ibcsubdir (IState -> IOption
idris_options IState
i))
addImportDir :: FilePath -> Idris ()
addImportDir :: FilePath -> Idris ()
addImportDir FilePath
fp = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_importdirs = nub $ fp : opt_importdirs opts }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
setImportDirs :: [FilePath] -> Idris ()
setImportDirs :: [FilePath] -> Idris ()
setImportDirs [FilePath]
fps = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_importdirs = fps }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
allImportDirs :: Idris [FilePath]
allImportDirs :: Idris [FilePath]
allImportDirs = do IState
i <- Idris IState
getIState
let optdirs :: [FilePath]
optdirs = IOption -> [FilePath]
opt_importdirs (IState -> IOption
idris_options IState
i)
[FilePath] -> Idris [FilePath]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"." FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
forall {a}. [a] -> [a]
reverse [FilePath]
optdirs)
rankedImportDirs :: FilePath -> Idris [FilePath]
rankedImportDirs :: FilePath -> Idris [FilePath]
rankedImportDirs FilePath
fp = do [FilePath]
ids <- Idris [FilePath]
allImportDirs
let ([FilePath]
prefixes, [FilePath]
rest) = (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`FilePath
fp) [FilePath]
ids
[FilePath] -> Idris [FilePath]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> Idris [FilePath]) -> [FilePath] -> Idris [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
prefixes [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rest
addSourceDir :: FilePath -> Idris ()
addSourceDir :: FilePath -> Idris ()
addSourceDir FilePath
fp = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opts' :: IOption
opts' = IOption
opts { opt_sourcedirs = nub $ fp : opt_sourcedirs opts }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opts' }
setSourceDirs :: [FilePath] -> Idris ()
setSourceDirs :: [FilePath] -> Idris ()
setSourceDirs [FilePath]
fps = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opts' :: IOption
opts' = IOption
opts { opt_sourcedirs = nub $ fps }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opts' }
allSourceDirs :: Idris [FilePath]
allSourceDirs :: Idris [FilePath]
allSourceDirs = do IState
i <- Idris IState
getIState
let optdirs :: [FilePath]
optdirs = IOption -> [FilePath]
opt_sourcedirs (IState -> IOption
idris_options IState
i)
[FilePath] -> Idris [FilePath]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"." FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
forall {a}. [a] -> [a]
reverse [FilePath]
optdirs)
colourise :: Idris Bool
colourise :: Idris Bool
colourise = do IState
i <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Idris Bool) -> Bool -> Idris Bool
forall a b. (a -> b) -> a -> b
$ IState -> Bool
idris_colourRepl IState
i
setColourise :: Bool -> Idris ()
setColourise :: Bool -> Idris ()
setColourise Bool
b = do IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_colourRepl = b }
impShow :: Idris Bool
impShow :: Idris Bool
impShow = do IState
i <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_showimp (IState -> IOption
idris_options IState
i))
setImpShow :: Bool -> Idris ()
setImpShow :: Bool -> Idris ()
setImpShow Bool
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_showimp = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
setColour :: ColourType -> IdrisColour -> Idris ()
setColour :: ColourType -> IdrisColour -> Idris ()
setColour ColourType
ct IdrisColour
c = do IState
i <- Idris IState
getIState
let newTheme :: ColourTheme
newTheme = ColourType -> IdrisColour -> ColourTheme -> ColourTheme
setColour' ColourType
ct IdrisColour
c (IState -> ColourTheme
idris_colourTheme IState
i)
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_colourTheme = newTheme }
where setColour' :: ColourType -> IdrisColour -> ColourTheme -> ColourTheme
setColour' ColourType
KeywordColour IdrisColour
c ColourTheme
t = ColourTheme
t { keywordColour = c }
setColour' ColourType
BoundVarColour IdrisColour
c ColourTheme
t = ColourTheme
t { boundVarColour = c }
setColour' ColourType
ImplicitColour IdrisColour
c ColourTheme
t = ColourTheme
t { implicitColour = c }
setColour' ColourType
FunctionColour IdrisColour
c ColourTheme
t = ColourTheme
t { functionColour = c }
setColour' ColourType
TypeColour IdrisColour
c ColourTheme
t = ColourTheme
t { typeColour = c }
setColour' ColourType
DataColour IdrisColour
c ColourTheme
t = ColourTheme
t { dataColour = c }
setColour' ColourType
PromptColour IdrisColour
c ColourTheme
t = ColourTheme
t { promptColour = c }
setColour' ColourType
PostulateColour IdrisColour
c ColourTheme
t = ColourTheme
t { postulateColour = c }
logLvl :: Int -> String -> Idris ()
logLvl :: Int -> FilePath -> Idris ()
logLvl = [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats []
logCoverage :: Int -> String -> Idris ()
logCoverage :: Int -> FilePath -> Idris ()
logCoverage = [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats [LogCat
ICoverage]
logErasure :: Int -> String -> Idris ()
logErasure :: Int -> FilePath -> Idris ()
logErasure = [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats [LogCat
IErasure]
logParser :: Int -> String -> Idris ()
logParser :: Int -> FilePath -> Idris ()
logParser = [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats [LogCat]
parserCats
logElab :: Int -> String -> Idris ()
logElab :: Int -> FilePath -> Idris ()
logElab = [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats [LogCat]
elabCats
logCodeGen :: Int -> String -> Idris ()
logCodeGen :: Int -> FilePath -> Idris ()
logCodeGen = [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats [LogCat]
codegenCats
logIBC :: Int -> String -> Idris ()
logIBC :: Int -> FilePath -> Idris ()
logIBC = [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats [LogCat
IIBC]
logLvlCats :: [LogCat]
-> Int
-> String
-> Idris ()
logLvlCats :: [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats [LogCat]
cs Int
l FilePath
msg = do
IState
i <- Idris IState
getIState
let lvl :: Int
lvl = IOption -> Int
opt_logLevel (IState -> IOption
idris_options IState
i)
let cats :: [LogCat]
cats = IOption -> [LogCat]
opt_logcats (IState -> IOption
idris_options IState
i)
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
lvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LogCat] -> [LogCat] -> Bool
inCat [LogCat]
cs [LogCat]
cats Bool -> Bool -> Bool
|| [LogCat] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogCat]
cats) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
case IState -> OutputMode
idris_outputmode IState
i of
RawOutput Handle
h -> do
IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> IO () -> Idris ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
h FilePath
msg
IdeMode Integer
n Handle
h -> do
let good :: SExp
good = [SExp] -> SExp
SexpList [Integer -> SExp
IntegerAtom (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
l), FilePath -> SExp
forall a. SExpable a => a -> SExp
toSExp FilePath
msg]
IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> (FilePath -> IO ()) -> FilePath -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
h (FilePath -> Idris ()) -> FilePath -> Idris ()
forall a b. (a -> b) -> a -> b
$ FilePath -> SExp -> Integer -> FilePath
forall a. SExpable a => FilePath -> a -> Integer -> FilePath
convSExp FilePath
"log" SExp
good Integer
n
where
inCat :: [LogCat] -> [LogCat] -> Bool
inCat :: [LogCat] -> [LogCat] -> Bool
inCat [LogCat]
cs [LogCat]
cats = (LogCat -> Bool) -> [LogCat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LogCat -> [LogCat] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [LogCat]
cats) [LogCat]
cs
cmdOptType :: Opt -> Idris Bool
cmdOptType :: Opt -> Idris Bool
cmdOptType Opt
x = do IState
i <- Idris IState
getIState
Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Idris Bool) -> Bool -> Idris Bool
forall a b. (a -> b) -> a -> b
$ Opt
x Opt -> [Opt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
i)
noErrors :: Idris Bool
noErrors :: Idris Bool
noErrors = do IState
i <- Idris IState
getIState
case IState -> Maybe FC
errSpan IState
i of
Maybe FC
Nothing -> Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe FC
_ -> Bool -> Idris Bool
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
setTypeCase :: Bool -> Idris ()
setTypeCase :: Bool -> Idris ()
setTypeCase Bool
t = do IState
i <- Idris IState
getIState
let opts :: IOption
opts = IState -> IOption
idris_options IState
i
let opt' :: IOption
opt' = IOption
opts { opt_typecase = t }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options = opt' }
getIndentWith :: Idris Int
getIndentWith :: Idris Int
getIndentWith = do
IState
i <- Idris IState
getIState
Int -> Idris Int
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Idris Int) -> Int -> Idris Int
forall a b. (a -> b) -> a -> b
$ InteractiveOpts -> Int
interactiveOpts_indentWith (IState -> InteractiveOpts
idris_interactiveOpts IState
i)
setIndentWith :: Int -> Idris ()
setIndentWith :: Int -> Idris ()
setIndentWith Int
indentWith = do
IState
i <- Idris IState
getIState
let opts :: InteractiveOpts
opts = IState -> InteractiveOpts
idris_interactiveOpts IState
i
let opts' :: InteractiveOpts
opts' = InteractiveOpts
opts { interactiveOpts_indentWith = indentWith }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_interactiveOpts = opts' }
getIndentClause :: Idris Int
getIndentClause :: Idris Int
getIndentClause = do
IState
i <- Idris IState
getIState
Int -> Idris Int
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Idris Int) -> Int -> Idris Int
forall a b. (a -> b) -> a -> b
$ InteractiveOpts -> Int
interactiveOpts_indentClause (IState -> InteractiveOpts
idris_interactiveOpts IState
i)
setIndentClause :: Int -> Idris ()
setIndentClause :: Int -> Idris ()
setIndentClause Int
indentClause = do
IState
i <- Idris IState
getIState
let opts :: InteractiveOpts
opts = IState -> InteractiveOpts
idris_interactiveOpts IState
i
let opts' :: InteractiveOpts
opts' = InteractiveOpts
opts { interactiveOpts_indentClause = indentClause }
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_interactiveOpts = opts' }
expandParams :: (Name -> Name) -> [(Name, PTerm)] ->
[Name] ->
[Name] ->
PTerm -> PTerm
expandParams :: (Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [Name]
infs PTerm
tm = Int -> PTerm -> PTerm
en Int
0 PTerm
tm
where
mkShadow :: Name -> Name
mkShadow (UN Text
n) = Int -> Text -> Name
MN Int
0 Text
n
mkShadow (MN Int
i Text
n) = Int -> Text -> Name
MN (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Text
n
mkShadow (NS Name
x [Text]
s) = Name -> [Text] -> Name
NS (Name -> Name
mkShadow Name
x) [Text]
s
en :: Int
-> PTerm -> PTerm
en :: Int -> PTerm -> PTerm
en Int
0 (PLam FC
fc Name
n FC
nfc PTerm
t PTerm
s)
| Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ns)
= let n' :: Name
n' = Name -> Name
mkShadow Name
n in
FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
n' FC
nfc (Int -> PTerm -> PTerm
en Int
0 PTerm
t) (Int -> PTerm -> PTerm
en Int
0 (Name -> Name -> PTerm -> PTerm
shadow Name
n Name
n' PTerm
s))
| Bool
otherwise = FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
n FC
nfc (Int -> PTerm -> PTerm
en Int
0 PTerm
t) (Int -> PTerm -> PTerm
en Int
0 PTerm
s)
en Int
0 (PPi Plicity
p Name
n FC
nfc PTerm
t PTerm
s)
| Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ns)
= let n' :: Name
n' = Name -> Name
mkShadow Name
n in
Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi (Int -> Plicity -> Plicity
enTacImp Int
0 Plicity
p) Name
n' FC
nfc (Int -> PTerm -> PTerm
en Int
0 PTerm
t) (Int -> PTerm -> PTerm
en Int
0 (Name -> Name -> PTerm -> PTerm
shadow Name
n Name
n' PTerm
s))
| Bool
otherwise = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi (Int -> Plicity -> Plicity
enTacImp Int
0 Plicity
p) Name
n FC
nfc (Int -> PTerm -> PTerm
en Int
0 PTerm
t) (Int -> PTerm -> PTerm
en Int
0 PTerm
s)
en Int
0 (PLet FC
fc RigCount
rc Name
n FC
nfc PTerm
ty PTerm
v PTerm
s)
| Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ns)
= let n' :: Name
n' = Name -> Name
mkShadow Name
n in
FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
n' FC
nfc (Int -> PTerm -> PTerm
en Int
0 PTerm
ty) (Int -> PTerm -> PTerm
en Int
0 PTerm
v) (Int -> PTerm -> PTerm
en Int
0 (Name -> Name -> PTerm -> PTerm
shadow Name
n Name
n' PTerm
s))
| Bool
otherwise = FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
n FC
nfc (Int -> PTerm -> PTerm
en Int
0 PTerm
ty) (Int -> PTerm -> PTerm
en Int
0 PTerm
v) (Int -> PTerm -> PTerm
en Int
0 PTerm
s)
en Int
0 (PDPair FC
f [FC]
hls PunInfo
p (PRef FC
f' [FC]
fcs Name
n) PTerm
t PTerm
r)
| Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ns) Bool -> Bool -> Bool
&& PTerm
t PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/= PTerm
Placeholder
= let n' :: Name
n' = Name -> Name
mkShadow Name
n in
FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
f [FC]
hls PunInfo
p (FC -> [FC] -> Name -> PTerm
PRef FC
f' [FC]
fcs Name
n') (Int -> PTerm -> PTerm
en Int
0 PTerm
t) (Int -> PTerm -> PTerm
en Int
0 (Name -> Name -> PTerm -> PTerm
shadow Name
n Name
n' PTerm
r))
en Int
0 (PRewrite FC
f Maybe Name
by PTerm
l PTerm
r Maybe PTerm
g) = FC -> Maybe Name -> PTerm -> PTerm -> Maybe PTerm -> PTerm
PRewrite FC
f Maybe Name
by (Int -> PTerm -> PTerm
en Int
0 PTerm
l) (Int -> PTerm -> PTerm
en Int
0 PTerm
r) ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0) Maybe PTerm
g)
en Int
0 (PTyped PTerm
l PTerm
r) = PTerm -> PTerm -> PTerm
PTyped (Int -> PTerm -> PTerm
en Int
0 PTerm
l) (Int -> PTerm -> PTerm
en Int
0 PTerm
r)
en Int
0 (PPair FC
f [FC]
hls PunInfo
p PTerm
l PTerm
r) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
f [FC]
hls PunInfo
p (Int -> PTerm -> PTerm
en Int
0 PTerm
l) (Int -> PTerm -> PTerm
en Int
0 PTerm
r)
en Int
0 (PDPair FC
f [FC]
hls PunInfo
p PTerm
l PTerm
t PTerm
r) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
f [FC]
hls PunInfo
p (Int -> PTerm -> PTerm
en Int
0 PTerm
l) (Int -> PTerm -> PTerm
en Int
0 PTerm
t) (Int -> PTerm -> PTerm
en Int
0 PTerm
r)
en Int
0 (PAlternative [(Name, Name)]
ns PAltType
a [PTerm]
as) = [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ns PAltType
a ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> PTerm -> PTerm
en Int
0) [PTerm]
as)
en Int
0 (PHidden PTerm
t) = PTerm -> PTerm
PHidden (Int -> PTerm -> PTerm
en Int
0 PTerm
t)
en Int
0 (PUnifyLog PTerm
t) = PTerm -> PTerm
PUnifyLog (Int -> PTerm -> PTerm
en Int
0 PTerm
t)
en Int
0 (PDisamb [[Text]]
ds PTerm
t) = [[Text]] -> PTerm -> PTerm
PDisamb [[Text]]
ds (Int -> PTerm -> PTerm
en Int
0 PTerm
t)
en Int
0 (PNoImplicits PTerm
t) = PTerm -> PTerm
PNoImplicits (Int -> PTerm -> PTerm
en Int
0 PTerm
t)
en Int
0 (PDoBlock [PDo]
ds) = [PDo] -> PTerm
PDoBlock ((PDo -> PDo) -> [PDo] -> [PDo]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PDo -> PDo
forall a b. (a -> b) -> PDo' a -> PDo' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PDo]
ds)
en Int
0 (PProof [PTactic]
ts) = [PTactic] -> PTerm
PProof ((PTactic -> PTactic) -> [PTactic] -> [PTactic]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PTactic -> PTactic
forall a b. (a -> b) -> PTactic' a -> PTactic' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PTactic]
ts)
en Int
0 (PTactics [PTactic]
ts) = [PTactic] -> PTerm
PTactics ((PTactic -> PTactic) -> [PTactic] -> [PTactic]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PTactic -> PTactic
forall a b. (a -> b) -> PTactic' a -> PTactic' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PTactic]
ts)
en Int
0 (PQuote (Var Name
n))
| Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = Raw -> PTerm
PQuote (Name -> Raw
Var (Name -> Name
dec Name
n))
en Int
0 (PApp FC
fc (PInferRef FC
fc' [FC]
hl Name
n) [PArg]
as)
| Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
(((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall {t}. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PArg]
as))
en Int
0 (PApp FC
fc (PRef FC
fc' [FC]
hl Name
n) [PArg]
as)
| Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infs = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
(((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall {t}. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PArg]
as))
| Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
(((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall {t}. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PArg]
as))
en Int
0 (PAppBind FC
fc (PRef FC
fc' [FC]
hl Name
n) [PArg]
as)
| Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infs = FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
(((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall {t}. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PArg]
as))
| Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
(((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall {t}. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PArg]
as))
en Int
0 (PRef FC
fc [FC]
hl Name
n)
| Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infs = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc [FC]
hl (Name -> Name
dec Name
n))
(((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall {t}. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps)
| Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl (Name -> Name
dec Name
n))
(((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall {t}. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps)
en Int
0 (PInferRef FC
fc [FC]
hl Name
n)
| Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc [FC]
hl (Name -> Name
dec Name
n))
(((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall {t}. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps)
en Int
0 (PApp FC
fc PTerm
f [PArg]
as) = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (Int -> PTerm -> PTerm
en Int
0 PTerm
f) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PArg]
as)
en Int
0 (PAppBind FC
fc PTerm
f [PArg]
as) = FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
fc (Int -> PTerm -> PTerm
en Int
0 PTerm
f) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
0)) [PArg]
as)
en Int
0 (PCase FC
fc PTerm
c [(PTerm, PTerm)]
os) = FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc (Int -> PTerm -> PTerm
en Int
0 PTerm
c) (((PTerm, PTerm) -> (PTerm, PTerm))
-> [(PTerm, PTerm)] -> [(PTerm, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> (PTerm, PTerm) -> (PTerm, PTerm)
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
pmap (Int -> PTerm -> PTerm
en Int
0)) [(PTerm, PTerm)]
os)
en Int
0 (PIfThenElse FC
fc PTerm
c PTerm
t PTerm
f) = FC -> PTerm -> PTerm -> PTerm -> PTerm
PIfThenElse FC
fc (Int -> PTerm -> PTerm
en Int
0 PTerm
c) (Int -> PTerm -> PTerm
en Int
0 PTerm
t) (Int -> PTerm -> PTerm
en Int
0 PTerm
f)
en Int
0 (PRunElab FC
fc PTerm
tm [FilePath]
ns) = FC -> PTerm -> [FilePath] -> PTerm
PRunElab FC
fc (Int -> PTerm -> PTerm
en Int
0 PTerm
tm) [FilePath]
ns
en Int
0 (PConstSugar FC
fc PTerm
tm) = FC -> PTerm -> PTerm
PConstSugar FC
fc (Int -> PTerm -> PTerm
en Int
0 PTerm
tm)
en Int
ql (PQuasiquote PTerm
tm Maybe PTerm
ty) = PTerm -> Maybe PTerm -> PTerm
PQuasiquote (Int -> PTerm -> PTerm
en (Int
ql Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PTerm
tm) ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
ql) Maybe PTerm
ty)
en Int
ql (PUnquote PTerm
tm) = PTerm -> PTerm
PUnquote (Int -> PTerm -> PTerm
en (Int
ql Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) PTerm
tm)
en Int
ql PTerm
t = (PTerm -> PTerm) -> PTerm -> PTerm
forall on. Uniplate on => (on -> on) -> on -> on
descend (Int -> PTerm -> PTerm
en Int
ql) PTerm
t
nselem :: Name -> [Name] -> Bool
nselem Name
x [] = Bool
False
nselem Name
x (Name
y : [Name]
xs) | Name -> Name -> Bool
nseq Name
x Name
y = Bool
True
| Bool
otherwise = Name -> [Name] -> Bool
nselem Name
x [Name]
xs
nseq :: Name -> Name -> Bool
nseq Name
x Name
y = Name -> Name
nsroot Name
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Name
nsroot Name
y
enTacImp :: Int -> Plicity -> Plicity
enTacImp Int
ql (TacImp [ArgOpt]
aos Static
st PTerm
scr RigCount
rig) = [ArgOpt] -> Static -> PTerm -> RigCount -> Plicity
TacImp [ArgOpt]
aos Static
st (Int -> PTerm -> PTerm
en Int
ql PTerm
scr) RigCount
rig
enTacImp Int
ql Plicity
other = Plicity
other
expandParamsD :: Bool ->
IState ->
(Name -> Name) -> [(Name, PTerm)] -> [Name] -> PDecl -> PDecl
expandParamsD :: Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
rhsonly IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns (PTy Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argdocs SyntaxInfo
syn FC
fc [FnOpt]
o Name
n FC
nfc PTerm
ty)
= if Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
rhsonly)
then
Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> [FnOpt]
-> Name
-> FC
-> PTerm
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [FnOpt]
-> Name
-> FC
-> t
-> PDecl' t
PTy Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argdocs SyntaxInfo
syn FC
fc [FnOpt]
o (Name -> Name
dec Name
n) FC
nfc (Plicity -> [(Name, PTerm)] -> PTerm -> PTerm
piBindp Plicity
expl_param [(Name, PTerm)]
ps ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty))
else
Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> [FnOpt]
-> Name
-> FC
-> PTerm
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [FnOpt]
-> Name
-> FC
-> t
-> PDecl' t
PTy Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argdocs SyntaxInfo
syn FC
fc [FnOpt]
o Name
n FC
nfc ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty)
expandParamsD Bool
rhsonly IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns (PPostulate Bool
e Docstring (Either Err PTerm)
doc SyntaxInfo
syn FC
fc FC
nfc [FnOpt]
o Name
n PTerm
ty)
= if Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
rhsonly)
then
Bool
-> Docstring (Either Err PTerm)
-> SyntaxInfo
-> FC
-> FC
-> [FnOpt]
-> Name
-> PTerm
-> PDecl
forall t.
Bool
-> Docstring (Either Err t)
-> SyntaxInfo
-> FC
-> FC
-> [FnOpt]
-> Name
-> t
-> PDecl' t
PPostulate Bool
e Docstring (Either Err PTerm)
doc SyntaxInfo
syn FC
fc FC
nfc [FnOpt]
o (Name -> Name
dec Name
n)
([(Name, PTerm)] -> PTerm -> PTerm
piBind [(Name, PTerm)]
ps ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty))
else
Bool
-> Docstring (Either Err PTerm)
-> SyntaxInfo
-> FC
-> FC
-> [FnOpt]
-> Name
-> PTerm
-> PDecl
forall t.
Bool
-> Docstring (Either Err t)
-> SyntaxInfo
-> FC
-> FC
-> [FnOpt]
-> Name
-> t
-> PDecl' t
PPostulate Bool
e Docstring (Either Err PTerm)
doc SyntaxInfo
syn FC
fc FC
nfc [FnOpt]
o Name
n ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty)
expandParamsD Bool
rhsonly IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns (PClauses FC
fc [FnOpt]
opts Name
n [PClause' PTerm]
cs)
= let n' :: Name
n' = if Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then Name -> Name
dec Name
n else Name
n in
FC -> [FnOpt] -> Name -> [PClause' PTerm] -> PDecl
forall t. FC -> [FnOpt] -> Name -> [PClause' t] -> PDecl' t
PClauses FC
fc [FnOpt]
opts Name
n' ((PClause' PTerm -> PClause' PTerm)
-> [PClause' PTerm] -> [PClause' PTerm]
forall a b. (a -> b) -> [a] -> [b]
map PClause' PTerm -> PClause' PTerm
expandParamsC [PClause' PTerm]
cs)
where
expandParamsC :: PClause' PTerm -> PClause' PTerm
expandParamsC (PClause FC
fc Name
n PTerm
lhs [PTerm]
ws PTerm
rhs [PDecl]
ds)
= let
ps'' :: [(Name, PTerm)]
ps'' = Bool -> [Name] -> [((Name, PTerm), Int)] -> [(Name, PTerm)]
forall {t :: * -> *} {b}.
Foldable t =>
Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps Bool
False ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [] IState
ist PTerm
lhs) ([(Name, PTerm)] -> [Int] -> [((Name, PTerm), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Name, PTerm)]
ps [Int
0..])
lhs' :: PTerm
lhs' = if Bool
rhsonly then PTerm
lhs else ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns [] PTerm
lhs)
n' :: Name
n' = if Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then Name -> Name
dec Name
n else Name
n
ns' :: [Name]
ns' = PTerm -> [Name] -> [Name]
removeBound PTerm
lhs [Name]
ns in
FC
-> Name -> PTerm -> [PTerm] -> PTerm -> [PDecl] -> PClause' PTerm
forall t. FC -> Name -> t -> [t] -> t -> [PDecl' t] -> PClause' t
PClause FC
fc Name
n' PTerm
lhs'
((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns' []) [PTerm]
ws)
((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns' [] PTerm
rhs)
((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
True IState
ist Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns') [PDecl]
ds)
expandParamsC (PWith FC
fc Name
n PTerm
lhs [PTerm]
ws PTerm
wval Maybe (Name, FC)
pn [PDecl]
ds)
= let
ps'' :: [(Name, PTerm)]
ps'' = Bool -> [Name] -> [((Name, PTerm), Int)] -> [(Name, PTerm)]
forall {t :: * -> *} {b}.
Foldable t =>
Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps Bool
False ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [] IState
ist PTerm
lhs) ([(Name, PTerm)] -> [Int] -> [((Name, PTerm), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Name, PTerm)]
ps [Int
0..])
lhs' :: PTerm
lhs' = if Bool
rhsonly then PTerm
lhs else ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns [] PTerm
lhs)
n' :: Name
n' = if Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then Name -> Name
dec Name
n else Name
n
ns' :: [Name]
ns' = PTerm -> [Name] -> [Name]
removeBound PTerm
lhs [Name]
ns in
FC
-> Name
-> PTerm
-> [PTerm]
-> PTerm
-> Maybe (Name, FC)
-> [PDecl]
-> PClause' PTerm
forall t.
FC
-> Name
-> t
-> [t]
-> t
-> Maybe (Name, FC)
-> [PDecl' t]
-> PClause' t
PWith FC
fc Name
n' PTerm
lhs'
((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns' []) [PTerm]
ws)
((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns' [] PTerm
wval)
Maybe (Name, FC)
pn
((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
rhsonly IState
ist Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns') [PDecl]
ds)
updateps :: Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps Bool
yn t Name
nm [] = []
updateps Bool
yn t Name
nm (((Name
a, b
t), Int
i):[((Name, b), Int)]
as)
| (Name
a Name -> t Name -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Name
nm) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
yn = (Name
a, b
t) (Name, b) -> [(Name, b)] -> [(Name, b)]
forall a. a -> [a] -> [a]
: Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps Bool
yn t Name
nm [((Name, b), Int)]
as
| Bool
otherwise = (Int -> FilePath -> Name
sMN Int
i (Name -> FilePath
forall a. Show a => a -> FilePath
show Name
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_shadow"), b
t) (Name, b) -> [(Name, b)] -> [(Name, b)]
forall a. a -> [a] -> [a]
: Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps Bool
yn t Name
nm [((Name, b), Int)]
as
removeBound :: PTerm -> [Name] -> [Name]
removeBound PTerm
lhs [Name]
ns = [Name]
ns [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (PTerm -> [Name]
bnames PTerm
lhs)
bnames :: PTerm -> [Name]
bnames (PRef FC
_ [FC]
_ Name
n) = [Name
n]
bnames (PApp FC
_ PTerm
_ [PArg]
args) = (PArg -> [Name]) -> [PArg] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PTerm -> [Name]
bnames (PTerm -> [Name]) -> (PArg -> PTerm) -> PArg -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PArg -> PTerm
forall t. PArg' t -> t
getTm) [PArg]
args
bnames (PPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
r) = PTerm -> [Name]
bnames PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ PTerm -> [Name]
bnames PTerm
r
bnames (PDPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
Placeholder PTerm
r) = PTerm -> [Name]
bnames PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ PTerm -> [Name]
bnames PTerm
r
bnames PTerm
_ = []
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns (PData Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argDocs SyntaxInfo
syn FC
fc DataOpts
co PData' PTerm
pd)
= Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> DataOpts
-> PData' PTerm
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> DataOpts
-> PData' t
-> PDecl' t
PData Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argDocs SyntaxInfo
syn FC
fc DataOpts
co (PData' PTerm -> PData' PTerm
expandPData PData' PTerm
pd)
where
expandPData :: PData' PTerm -> PData' PTerm
expandPData (PDatadecl Name
n FC
nfc PTerm
ty [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])]
cons)
= if Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns
then Name
-> FC
-> PTerm
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])]
-> PData' PTerm
forall t.
Name
-> FC
-> t
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
-> PData' t
PDatadecl (Name -> Name
dec Name
n) FC
nfc ([(Name, PTerm)] -> PTerm -> PTerm
piBind [(Name, PTerm)]
ps ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty))
(((Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])
-> (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name]))
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])]
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])]
forall a b. (a -> b) -> [a] -> [b]
map (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])
-> (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])
forall {a} {b} {d} {f} {g}.
(a, b, Name, d, PTerm, f, g) -> (a, b, Name, d, PTerm, f, g)
econ [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])]
cons)
else Name
-> FC
-> PTerm
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])]
-> PData' PTerm
forall t.
Name
-> FC
-> t
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
-> PData' t
PDatadecl Name
n FC
nfc ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty) (((Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])
-> (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name]))
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])]
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])]
forall a b. (a -> b) -> [a] -> [b]
map (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])
-> (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])
forall {a} {b} {d} {f} {g}.
(a, b, Name, d, PTerm, f, g) -> (a, b, Name, d, PTerm, f, g)
econ [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
[Name])]
cons)
econ :: (a, b, Name, d, PTerm, f, g) -> (a, b, Name, d, PTerm, f, g)
econ (a
doc, b
argDocs, Name
n, d
nfc, PTerm
t, f
fc, g
fs)
= (a
doc, b
argDocs, Name -> Name
dec Name
n, d
nfc, Plicity -> [(Name, PTerm)] -> PTerm -> PTerm
piBindp Plicity
expl [(Name, PTerm)]
ps ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
t), f
fc, g
fs)
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns d :: PDecl
d@(PRecord Docstring (Either Err PTerm)
doc SyntaxInfo
rsyn FC
fc DataOpts
opts Name
name FC
nfc [(Name, FC, Plicity, PTerm)]
prs [(Name, Docstring (Either Err PTerm))]
pdocs [(Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm)))]
fls Maybe (Name, FC)
cn Docstring (Either Err PTerm)
cdoc SyntaxInfo
csyn)
= PDecl
d
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns (PParams FC
f [(Name, PTerm)]
params [PDecl]
pds)
= FC -> [(Name, PTerm)] -> [PDecl] -> PDecl
forall t. FC -> [(Name, t)] -> [PDecl' t] -> PDecl' t
PParams FC
f ([(Name, PTerm)]
ps [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> (Name, PTerm))
-> [(Name, PTerm)] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> (Name, PTerm) -> (Name, PTerm)
forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
mapsnd ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [])) [(Name, PTerm)]
params)
((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
True IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns) [PDecl]
pds)
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns (PMutual FC
f [PDecl]
pds)
= FC -> [PDecl] -> PDecl
forall t. FC -> [PDecl' t] -> PDecl' t
PMutual FC
f ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns) [PDecl]
pds)
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns (PInterface Docstring (Either Err PTerm)
doc SyntaxInfo
info FC
f [(Name, PTerm)]
cs Name
n FC
nfc [(Name, FC, PTerm)]
params [(Name, Docstring (Either Err PTerm))]
pDocs [(Name, FC)]
fds [PDecl]
decls Maybe (Name, FC)
cn Docstring (Either Err PTerm)
cd)
= Docstring (Either Err PTerm)
-> SyntaxInfo
-> FC
-> [(Name, PTerm)]
-> Name
-> FC
-> [(Name, FC, PTerm)]
-> [(Name, Docstring (Either Err PTerm))]
-> [(Name, FC)]
-> [PDecl]
-> Maybe (Name, FC)
-> Docstring (Either Err PTerm)
-> PDecl
forall t.
Docstring (Either Err t)
-> SyntaxInfo
-> FC
-> [(Name, t)]
-> Name
-> FC
-> [(Name, FC, t)]
-> [(Name, Docstring (Either Err t))]
-> [(Name, FC)]
-> [PDecl' t]
-> Maybe (Name, FC)
-> Docstring (Either Err t)
-> PDecl' t
PInterface Docstring (Either Err PTerm)
doc SyntaxInfo
info FC
f
(((Name, PTerm) -> (Name, PTerm))
-> [(Name, PTerm)] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Name
n, PTerm
t) -> (Name
n, (Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
t)) [(Name, PTerm)]
cs)
Name
n FC
nfc
(((Name, FC, PTerm) -> (Name, FC, PTerm))
-> [(Name, FC, PTerm)] -> [(Name, FC, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
n, FC
fc, PTerm
t) -> (Name
n, FC
fc, (Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
t)) [(Name, FC, PTerm)]
params)
[(Name, Docstring (Either Err PTerm))]
pDocs
[(Name, FC)]
fds
((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns) [PDecl]
decls)
Maybe (Name, FC)
cn
Docstring (Either Err PTerm)
cd
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns (PImplementation Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argDocs SyntaxInfo
info FC
f [(Name, PTerm)]
cs [Name]
pnames Accessibility
acc [FnOpt]
opts Name
n FC
nfc [PTerm]
params [(Name, PTerm)]
pextra PTerm
ty Maybe Name
cn [PDecl]
decls)
= let cn' :: Maybe Name
cn' = case Maybe Name
cn of
Just Name
n -> if Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Name
dec Name
n) else Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
Maybe Name
Nothing -> Maybe Name
forall a. Maybe a
Nothing in
Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> [(Name, PTerm)]
-> [Name]
-> Accessibility
-> [FnOpt]
-> Name
-> FC
-> [PTerm]
-> [(Name, PTerm)]
-> PTerm
-> Maybe Name
-> [PDecl]
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [(Name, t)]
-> [Name]
-> Accessibility
-> [FnOpt]
-> Name
-> FC
-> [t]
-> [(Name, t)]
-> t
-> Maybe Name
-> [PDecl' t]
-> PDecl' t
PImplementation Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argDocs SyntaxInfo
info FC
f
(((Name, PTerm) -> (Name, PTerm))
-> [(Name, PTerm)] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Name
n, PTerm
t) -> (Name
n, (Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
t)) [(Name, PTerm)]
cs)
[Name]
pnames Accessibility
acc [FnOpt]
opts Name
n
FC
nfc
((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns []) [PTerm]
params)
(((Name, PTerm) -> (Name, PTerm))
-> [(Name, PTerm)] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Name
n, PTerm
t) -> (Name
n, (Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
t)) [(Name, PTerm)]
pextra)
((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty)
Maybe Name
cn'
((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
True IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns) [PDecl]
decls)
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns PDecl
d = PDecl
d
mapsnd :: (t -> b) -> (a, t) -> (a, b)
mapsnd t -> b
f (a
x, t
t) = (a
x, t -> b
f t
t)
expandImplementationScope :: p -> p -> [(Name, t)] -> p -> PDecl' t -> PDecl' t
expandImplementationScope p
ist p
dec [(Name, t)]
ps p
ns (PImplementation Docstring (Either Err t)
doc [(Name, Docstring (Either Err t))]
argDocs SyntaxInfo
info FC
f [(Name, t)]
cs [Name]
pnames Accessibility
acc [FnOpt]
opts Name
n FC
nfc [t]
params [(Name, t)]
pextra t
ty Maybe Name
cn [PDecl' t]
decls)
= Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [(Name, t)]
-> [Name]
-> Accessibility
-> [FnOpt]
-> Name
-> FC
-> [t]
-> [(Name, t)]
-> t
-> Maybe Name
-> [PDecl' t]
-> PDecl' t
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [(Name, t)]
-> [Name]
-> Accessibility
-> [FnOpt]
-> Name
-> FC
-> [t]
-> [(Name, t)]
-> t
-> Maybe Name
-> [PDecl' t]
-> PDecl' t
PImplementation Docstring (Either Err t)
doc [(Name, Docstring (Either Err t))]
argDocs SyntaxInfo
info FC
f [(Name, t)]
cs [Name]
pnames Accessibility
acc [FnOpt]
opts Name
n FC
nfc [t]
params ([(Name, t)]
ps [(Name, t)] -> [(Name, t)] -> [(Name, t)]
forall a. [a] -> [a] -> [a]
++ [(Name, t)]
pextra)
t
ty Maybe Name
cn [PDecl' t]
decls
expandImplementationScope p
ist p
dec [(Name, t)]
ps p
ns PDecl' t
d = PDecl' t
d
getPriority :: IState -> PTerm -> Int
getPriority :: IState -> PTerm -> Int
getPriority IState
i PTerm
tm = Int
1
addStatics :: Name -> Term -> PTerm -> Idris ()
addStatics :: Name -> Term -> PTerm -> Idris ()
addStatics Name
n Term
tm PTerm
ptm =
do let ([(Name, Term)]
statics, [(Name, Term)]
dynamics) = Term -> PTerm -> ([(Name, Term)], [(Name, Term)])
initStatics Term
tm PTerm
ptm
IState
ist <- Idris IState
getIState
let paramnames :: [Name]
paramnames
= [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ case Name -> Ctxt FnInfo -> Maybe FnInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt FnInfo
idris_fninfo IState
ist) of
Just FnInfo
p -> Int -> [Int] -> Term -> [Name]
forall {t :: * -> *} {t} {a}.
(Foldable t, Eq t, Num t) =>
t -> t t -> TT a -> [a]
getNamesFrom Int
0 (FnInfo -> [Int]
fn_params FnInfo
p) Term
tm [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
((Name, Term) -> [Name]) -> [(Name, Term)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IState -> Term -> [Name]
getParamNames IState
ist (Term -> [Name])
-> ((Name, Term) -> Term) -> (Name, Term) -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Term) -> Term
forall a b. (a, b) -> b
snd) [(Name, Term)]
statics
Maybe FnInfo
_ -> ((Name, Term) -> [Name]) -> [(Name, Term)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IState -> Term -> [Name]
getParamNames IState
ist (Term -> [Name])
-> ((Name, Term) -> Term) -> (Name, Term) -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Term) -> Term
forall a b. (a, b) -> b
snd) [(Name, Term)]
statics
let stnames :: [Name]
stnames = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ((Name, Term) -> [Name]) -> [(Name, Term)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Term -> [Name]
forall {a}. Eq a => TT a -> [a]
freeArgNames (Term -> [Name])
-> ((Name, Term) -> Term) -> (Name, Term) -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Term) -> Term
forall a b. (a, b) -> b
snd) [(Name, Term)]
statics
let dnames :: [Name]
dnames = ([Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ((Name, Term) -> [Name]) -> [(Name, Term)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Term -> [Name]
forall {a}. Eq a => TT a -> [a]
freeArgNames (Term -> [Name])
-> ((Name, Term) -> Term) -> (Name, Term) -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Term) -> Term
forall a b. (a, b) -> b
snd) [(Name, Term)]
dynamics)
[Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
paramnames
let statics' :: [Name]
statics' = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ((Name, Term) -> Name) -> [(Name, Term)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Term) -> Name
forall a b. (a, b) -> a
fst [(Name, Term)]
statics [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
(Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
x -> Bool -> Bool
not (Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
x [Name]
dnames)) [Name]
stnames
let stpos :: [Bool]
stpos = [Name] -> Term -> [Bool]
forall {t :: * -> *} {a}.
(Foldable t, Eq a) =>
t a -> TT a -> [Bool]
staticList [Name]
statics' Term
tm
IState
i <- Idris IState
getIState
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Name, Term)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, Term)]
statics) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
Int -> FilePath -> Idris ()
logLvl Int
3 (FilePath -> Idris ()) -> FilePath -> Idris ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Statics for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Term -> FilePath
forall a. Show a => a -> FilePath
show Term
tm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PTerm -> FilePath
showTmImpls PTerm
ptm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [(Name, Term)] -> FilePath
forall a. Show a => a -> FilePath
show [(Name, Term)]
statics FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [(Name, Term)] -> FilePath
forall a. Show a => a -> FilePath
show [(Name, Term)]
dynamics
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Name] -> FilePath
forall a. Show a => a -> FilePath
show [Name]
paramnames
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Bool] -> FilePath
forall a. Show a => a -> FilePath
show [Bool]
stpos
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_statics = addDef n stpos (idris_statics i) }
IBCWrite -> Idris ()
addIBC (Name -> IBCWrite
IBCStatic Name
n)
where
initStatics :: Term -> PTerm -> ([(Name, Term)], [(Name, Term)])
initStatics (Bind Name
n (Pi RigCount
_ Maybe ImplicitInfo
_ Term
ty Term
_) Term
sc) (PPi Plicity
p Name
n' FC
fc PTerm
t PTerm
s)
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
n' = let ([(Name, Term)]
static, [(Name, Term)]
dynamic) = Term -> PTerm -> ([(Name, Term)], [(Name, Term)])
initStatics Term
sc (Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
n' FC
fc PTerm
t PTerm
s) in
([(Name, Term)]
static, (Name
n, Term
ty) (Name, Term) -> [(Name, Term)] -> [(Name, Term)]
forall a. a -> [a] -> [a]
: [(Name, Term)]
dynamic)
initStatics (Bind Name
n (Pi RigCount
_ Maybe ImplicitInfo
_ Term
ty Term
_) Term
sc) (PPi Plicity
p Name
n' FC
fc PTerm
_ PTerm
s)
= let ([(Name, Term)]
static, [(Name, Term)]
dynamic) = Term -> PTerm -> ([(Name, Term)], [(Name, Term)])
initStatics (Term -> Term -> Term
forall n. TT n -> TT n -> TT n
instantiate (NameType -> Name -> Term -> Term
forall n. NameType -> n -> TT n -> TT n
P NameType
Bound Name
n Term
ty) Term
sc) PTerm
s in
if Plicity -> Static
pstatic Plicity
p Static -> Static -> Bool
forall a. Eq a => a -> a -> Bool
== Static
Static then ((Name
n, Term
ty) (Name, Term) -> [(Name, Term)] -> [(Name, Term)]
forall a. a -> [a] -> [a]
: [(Name, Term)]
static, [(Name, Term)]
dynamic)
else if (Bool -> Bool
not (Plicity -> Bool
searchArg Plicity
p))
then ([(Name, Term)]
static, (Name
n, Term
ty) (Name, Term) -> [(Name, Term)] -> [(Name, Term)]
forall a. a -> [a] -> [a]
: [(Name, Term)]
dynamic)
else ([(Name, Term)]
static, [(Name, Term)]
dynamic)
initStatics Term
t PTerm
pt = ([], [])
getParamNames :: IState -> Term -> [Name]
getParamNames IState
ist Term
tm | (P NameType
_ Name
n Term
_ , [Term]
args) <- Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
tm
= case Name -> Ctxt TypeInfo -> Maybe TypeInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt TypeInfo
idris_datatypes IState
ist) of
Just TypeInfo
ti -> Int -> [Int] -> [Term] -> [Name]
forall {t :: * -> *} {t} {a}.
(Foldable t, Eq t, Num t) =>
t -> t t -> [TT a] -> [a]
getNamePos Int
0 (TypeInfo -> [Int]
param_pos TypeInfo
ti) [Term]
args
Maybe TypeInfo
Nothing -> []
where getNamePos :: t -> t t -> [TT a] -> [a]
getNamePos t
i t t
ps [] = []
getNamePos t
i t t
ps (P NameType
_ a
n TT a
_ : [TT a]
as)
| t
i t -> t t -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t t
ps = a
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> t t -> [TT a] -> [a]
getNamePos (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) t t
ps [TT a]
as
getNamePos t
i t t
ps (TT a
_ : [TT a]
as) = t -> t t -> [TT a] -> [a]
getNamePos (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) t t
ps [TT a]
as
getParamNames IState
ist (Bind Name
t (Pi RigCount
_ Maybe ImplicitInfo
_ (P NameType
_ Name
n Term
_) Term
_) Term
sc)
= Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: IState -> Term -> [Name]
getParamNames IState
ist Term
sc
getParamNames IState
ist Term
_ = []
getNamesFrom :: t -> t t -> TT a -> [a]
getNamesFrom t
i t t
ps (Bind a
n (Pi RigCount
_ Maybe ImplicitInfo
_ TT a
_ TT a
_) TT a
sc)
| t
i t -> t t -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t t
ps = a
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> t t -> TT a -> [a]
getNamesFrom (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) t t
ps TT a
sc
| Bool
otherwise = t -> t t -> TT a -> [a]
getNamesFrom (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) t t
ps TT a
sc
getNamesFrom t
i t t
ps TT a
sc = []
freeArgNames :: TT a -> [a]
freeArgNames (Bind a
n (Pi RigCount
_ Maybe ImplicitInfo
_ TT a
ty TT a
_) TT a
sc)
= [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ TT a -> [a]
forall {a}. Eq a => TT a -> [a]
freeNames TT a
ty [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ TT a -> [a]
forall {a}. Eq a => TT a -> [a]
freeNames TT a
sc
freeArgNames TT a
tm = let (TT a
_, [TT a]
args) = TT a -> (TT a, [TT a])
forall n. TT n -> (TT n, [TT n])
unApply TT a
tm in
(TT a -> [a]) -> [TT a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TT a -> [a]
forall {a}. Eq a => TT a -> [a]
freeNames [TT a]
args
searchArg :: Plicity -> Bool
searchArg (Constraint [ArgOpt]
_ Static
_ RigCount
_) = Bool
True
searchArg (TacImp [ArgOpt]
_ Static
_ PTerm
_ RigCount
_) = Bool
True
searchArg Plicity
_ = Bool
False
staticList :: t a -> TT a -> [Bool]
staticList t a
sts (Bind a
n (Pi RigCount
_ Maybe ImplicitInfo
_ TT a
_ TT a
_) TT a
sc) = (a
n a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
sts) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: t a -> TT a -> [Bool]
staticList t a
sts TT a
sc
staticList t a
_ TT a
_ = []
addToUsing :: [Using] -> [(Name, PTerm)] -> [Using]
addToUsing :: [Using] -> [(Name, PTerm)] -> [Using]
addToUsing [Using]
us [] = [Using]
us
addToUsing [Using]
us ((Name
n, PTerm
t) : [(Name, PTerm)]
ns)
| Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Using -> Maybe Name) -> [Using] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Using -> Maybe Name
impName [Using]
us = [Using] -> [(Name, PTerm)] -> [Using]
addToUsing ([Using]
us [Using] -> [Using] -> [Using]
forall a. [a] -> [a] -> [a]
++ [Name -> PTerm -> Using
UImplicit Name
n PTerm
t]) [(Name, PTerm)]
ns
| Bool
otherwise = [Using] -> [(Name, PTerm)] -> [Using]
addToUsing [Using]
us [(Name, PTerm)]
ns
where impName :: Using -> Maybe Name
impName (UImplicit Name
n PTerm
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
impName Using
_ = Maybe Name
forall a. Maybe a
Nothing
addUsingConstraints :: SyntaxInfo -> FC -> PTerm -> Idris PTerm
addUsingConstraints :: SyntaxInfo -> FC -> PTerm -> Idris PTerm
addUsingConstraints SyntaxInfo
syn FC
fc PTerm
t
= do IState
ist <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
let ns :: [Name]
ns = [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [] IState
ist PTerm
t
let cs :: [Using]
cs = PTerm -> [Using]
getConstraints PTerm
t
let addconsts :: [Using]
addconsts = [Using]
uconsts [Using] -> [Using] -> [Using]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Using]
cs
PTerm -> Idris PTerm
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Using] -> [Name] -> PTerm -> PTerm
forall {t :: * -> *}.
Foldable t =>
[Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
addconsts [Name]
ns PTerm
t)
where uconsts :: [Using]
uconsts = (Using -> Bool) -> [Using] -> [Using]
forall a. (a -> Bool) -> [a] -> [a]
filter Using -> Bool
uconst (SyntaxInfo -> [Using]
using SyntaxInfo
syn)
uconst :: Using -> Bool
uconst (UConstraint Name
_ [Name]
_) = Bool
True
uconst Using
_ = Bool
False
doAdd :: [Using] -> t Name -> PTerm -> PTerm
doAdd [] t Name
_ PTerm
t = PTerm
t
doAdd (UConstraint Name
c [Name]
args : [Using]
cs) t Name
ns PTerm
t
| (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Name
n -> Name -> t Name -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n t Name
ns) [Name]
args
= Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi ([ArgOpt] -> Static -> RigCount -> Plicity
Constraint [] Static
Dynamic RigCount
RigW) (Int -> FilePath -> Name
sMN Int
0 FilePath
"cu") FC
NoFC
(Name -> [Name] -> PTerm
mkConst Name
c [Name]
args) ([Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
cs t Name
ns PTerm
t)
| Bool
otherwise = [Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
cs t Name
ns PTerm
t
mkConst :: Name -> [Name] -> PTerm
mkConst Name
c [Name]
args = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc [] Name
c)
((Name -> PArg) -> [Name] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp Int
0 [] (Int -> FilePath -> Name
sMN Int
0 FilePath
"carg") (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FC -> [FC] -> Name -> PTerm
PRef FC
fc []) [Name]
args)
getConstraints :: PTerm -> [Using]
getConstraints (PPi (Constraint [ArgOpt]
_ Static
_ RigCount
_) Name
_ FC
_ PTerm
c PTerm
sc)
= PTerm -> [Using]
getcapp PTerm
c [Using] -> [Using] -> [Using]
forall a. [a] -> [a] -> [a]
++ PTerm -> [Using]
getConstraints PTerm
sc
getConstraints (PPi Plicity
_ Name
_ FC
_ PTerm
c PTerm
sc) = PTerm -> [Using]
getConstraints PTerm
sc
getConstraints PTerm
_ = []
getcapp :: PTerm -> [Using]
getcapp (PApp FC
_ (PRef FC
_ [FC]
_ Name
c) [PArg]
args)
= do [Name]
ns <- (PArg -> [Name]) -> [PArg] -> [[Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PArg -> [Name]
getName [PArg]
args
Using -> [Using]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Name] -> Using
UConstraint Name
c [Name]
ns)
getcapp PTerm
_ = []
getName :: PArg -> [Name]
getName (PExp Int
_ [ArgOpt]
_ Name
_ (PRef FC
_ [FC]
_ Name
n)) = Name -> [Name]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
getName PArg
_ = []
addUsingImpls :: SyntaxInfo -> Name -> FC -> PTerm -> Idris PTerm
addUsingImpls :: SyntaxInfo -> Name -> FC -> PTerm -> Idris PTerm
addUsingImpls SyntaxInfo
syn Name
n FC
fc PTerm
t
= do IState
ist <- Idris IState
getIState
Bool
autoimpl <- Idris Bool
getAutoImpls
let ns_in :: [Name]
ns_in = [Name] -> IState -> PTerm -> [Name]
implicitNamesIn ((Using -> Name) -> [Using] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls) IState
ist PTerm
t
let ns :: [Name]
ns = if Bool
autoimpl then [Name]
ns_in
else (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
n -> Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Using -> Name) -> [Using] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls)) [Name]
ns_in
let badnames :: [Name]
badnames = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
n -> Bool -> Bool
not (Name -> Bool
implicitable Name
n) Bool -> Bool -> Bool
&&
Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((Using -> Name) -> [Using] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls)) [Name]
ns
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
badnames) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc (FilePath -> Name -> Maybe Term -> Err -> Err
forall t. FilePath -> Name -> Maybe t -> Err' t -> Err' t
Elaborating FilePath
"type of " Name
n Maybe Term
forall a. Maybe a
Nothing
(Name -> Err
forall t. Name -> Err' t
NoSuchVariable ([Name] -> Name
forall a. HasCallStack => [a] -> a
head [Name]
badnames))))
let cs :: [Name]
cs = PTerm -> [Name]
getArgnames PTerm
t
let addimpls :: [Using]
addimpls = (Using -> Bool) -> [Using] -> [Using]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Using
n -> Using -> Name
iname Using
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
cs) [Using]
uimpls
PTerm -> Idris PTerm
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name] -> PTerm -> PTerm
bindFree [Name]
ns ([Using] -> [Name] -> PTerm -> PTerm
forall {t :: * -> *}.
Foldable t =>
[Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
addimpls [Name]
ns PTerm
t))
where uimpls :: [Using]
uimpls = (Using -> Bool) -> [Using] -> [Using]
forall a. (a -> Bool) -> [a] -> [a]
filter Using -> Bool
uimpl (SyntaxInfo -> [Using]
using SyntaxInfo
syn)
uimpl :: Using -> Bool
uimpl (UImplicit Name
_ PTerm
_) = Bool
True
uimpl Using
_ = Bool
False
iname :: Using -> Name
iname (UImplicit Name
n PTerm
_) = Name
n
iname (UConstraint Name
_ [Name]
_) = FilePath -> Name
forall a. HasCallStack => FilePath -> a
error FilePath
"Can't happen addUsingImpls"
doAdd :: [Using] -> t Name -> PTerm -> PTerm
doAdd [] t Name
_ PTerm
t = PTerm
t
doAdd (UImplicit Name
n PTerm
ty : [Using]
cs) t Name
ns PTerm
t
| Name -> t Name -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n t Name
ns
= Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
impl_gen Name
n FC
NoFC PTerm
ty ([Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
cs t Name
ns PTerm
t)
| Bool
otherwise = [Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
cs t Name
ns PTerm
t
bindFree :: [Name] -> PTerm -> PTerm
bindFree [] PTerm
tm = PTerm
tm
bindFree (Name
n:[Name]
ns) PTerm
tm
| Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n ((Using -> Name) -> [Using] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls) = [Name] -> PTerm -> PTerm
bindFree [Name]
ns PTerm
tm
| Bool
otherwise
= Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi (Plicity
impl_gen { pargopts = [InaccessibleArg] }) Name
n FC
NoFC PTerm
Placeholder ([Name] -> PTerm -> PTerm
bindFree [Name]
ns PTerm
tm)
getArgnames :: PTerm -> [Name]
getArgnames (PPi Plicity
_ Name
n FC
_ PTerm
c PTerm
sc)
= Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: PTerm -> [Name]
getArgnames PTerm
sc
getArgnames PTerm
_ = []
getUnboundImplicits :: IState -> Type -> PTerm -> [(Bool, PArg)]
getUnboundImplicits :: IState -> Term -> PTerm -> [(Bool, PArg)]
getUnboundImplicits IState
i Term
t PTerm
tm = Term -> [(Name, (Plicity, PTerm))] -> [(Bool, PArg)]
getImps Term
t (PTerm -> [(Name, (Plicity, PTerm))]
collectImps PTerm
tm)
where collectImps :: PTerm -> [(Name, (Plicity, PTerm))]
collectImps (PPi Plicity
p Name
n FC
_ PTerm
t PTerm
sc)
= (Name
n, (Plicity
p, PTerm
t)) (Name, (Plicity, PTerm))
-> [(Name, (Plicity, PTerm))] -> [(Name, (Plicity, PTerm))]
forall a. a -> [a] -> [a]
: PTerm -> [(Name, (Plicity, PTerm))]
collectImps PTerm
sc
collectImps PTerm
_ = []
scopedimpl :: Maybe ImplicitInfo -> Bool
scopedimpl (Just ImplicitInfo
i) = Bool -> Bool
not (ImplicitInfo -> Bool
toplevel_imp ImplicitInfo
i)
scopedimpl Maybe ImplicitInfo
_ = Bool
False
getImps :: Term -> [(Name, (Plicity, PTerm))] -> [(Bool, PArg)]
getImps (Bind Name
n (Pi RigCount
_ Maybe ImplicitInfo
i Term
_ Term
_) Term
sc) [(Name, (Plicity, PTerm))]
imps
| Maybe ImplicitInfo -> Bool
scopedimpl Maybe ImplicitInfo
i = Term -> [(Name, (Plicity, PTerm))] -> [(Bool, PArg)]
getImps Term
sc [(Name, (Plicity, PTerm))]
imps
getImps (Bind Name
n (Pi RigCount
_ Maybe ImplicitInfo
_ Term
t Term
_) Term
sc) [(Name, (Plicity, PTerm))]
imps
| Just (Plicity
p, PTerm
t') <- Name -> [(Name, (Plicity, PTerm))] -> Maybe (Plicity, PTerm)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, (Plicity, PTerm))]
imps = Name -> Plicity -> PTerm -> (Bool, PArg)
argInfo Name
n Plicity
p PTerm
t' (Bool, PArg) -> [(Bool, PArg)] -> [(Bool, PArg)]
forall a. a -> [a] -> [a]
: Term -> [(Name, (Plicity, PTerm))] -> [(Bool, PArg)]
getImps Term
sc [(Name, (Plicity, PTerm))]
imps
where
argInfo :: Name -> Plicity -> PTerm -> (Bool, PArg)
argInfo Name
n (Imp [ArgOpt]
opt Static
_ Bool
_ Maybe ImplicitInfo
_ Bool
_ RigCount
_) PTerm
Placeholder
= (Bool
True, Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
0 Bool
True [ArgOpt]
opt Name
n PTerm
Placeholder)
argInfo Name
n (Imp [ArgOpt]
opt Static
_ Bool
_ Maybe ImplicitInfo
_ Bool
_ RigCount
_) PTerm
t'
= (ArgOpt
InaccessibleArg ArgOpt -> [ArgOpt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp (IState -> PTerm -> Int
getPriority IState
i PTerm
t') Bool
True [ArgOpt]
opt Name
n PTerm
t')
argInfo Name
n (Exp [ArgOpt]
opt Static
_ Bool
_ RigCount
_) PTerm
t'
= (ArgOpt
InaccessibleArg ArgOpt -> [ArgOpt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp (IState -> PTerm -> Int
getPriority IState
i PTerm
t') [ArgOpt]
opt Name
n PTerm
t')
argInfo Name
n (Constraint [ArgOpt]
opt Static
_ RigCount
_) PTerm
t'
= (ArgOpt
InaccessibleArg ArgOpt -> [ArgOpt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
10 [ArgOpt]
opt Name
n PTerm
t')
argInfo Name
n (TacImp [ArgOpt]
opt Static
_ PTerm
scr RigCount
_) PTerm
t'
= (ArgOpt
InaccessibleArg ArgOpt -> [ArgOpt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
10 [ArgOpt]
opt Name
n PTerm
scr PTerm
t')
getImps (Bind Name
n (Pi RigCount
_ Maybe ImplicitInfo
_ Term
t Term
_) Term
sc) [(Name, (Plicity, PTerm))]
imps = Name -> Term -> (Bool, PArg)
forall {p}. Name -> p -> (Bool, PArg)
impBind Name
n Term
t (Bool, PArg) -> [(Bool, PArg)] -> [(Bool, PArg)]
forall a. a -> [a] -> [a]
: Term -> [(Name, (Plicity, PTerm))] -> [(Bool, PArg)]
getImps Term
sc [(Name, (Plicity, PTerm))]
imps
where impBind :: Name -> p -> (Bool, PArg)
impBind Name
n p
t = (Bool
True, Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
1 Bool
True [] Name
n PTerm
Placeholder)
getImps Term
sc [(Name, (Plicity, PTerm))]
tm = []
implicit :: ElabInfo -> SyntaxInfo -> Name -> PTerm -> Idris PTerm
implicit :: ElabInfo -> SyntaxInfo -> Name -> PTerm -> Idris PTerm
implicit ElabInfo
info SyntaxInfo
syn Name
n PTerm
ptm = ElabInfo -> SyntaxInfo -> [Name] -> Name -> PTerm -> Idris PTerm
implicit' ElabInfo
info SyntaxInfo
syn [] Name
n PTerm
ptm
implicit' :: ElabInfo -> SyntaxInfo -> [Name] -> Name -> PTerm -> Idris PTerm
implicit' :: ElabInfo -> SyntaxInfo -> [Name] -> Name -> PTerm -> Idris PTerm
implicit' ElabInfo
info SyntaxInfo
syn [Name]
ignore Name
n PTerm
ptm
= do IState
i <- Idris IState
getIState
Bool
auto <- Idris Bool
getAutoImpls
let (PTerm
tm', [PArg]
impdata) = Bool -> SyntaxInfo -> [Name] -> IState -> PTerm -> (PTerm, [PArg])
implicitise Bool
auto SyntaxInfo
syn [Name]
ignore IState
i PTerm
ptm
[Name] -> [PArg] -> Idris ()
defaultArgCheck (ElabInfo -> [Name]
eInfoNames ElabInfo
info [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ Ctxt [PArg] -> [Name]
forall k a. Map k a -> [k]
M.keys (IState -> Ctxt [PArg]
idris_implicits IState
i)) [PArg]
impdata
IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_implicits = addDef n impdata (idris_implicits i) }
IBCWrite -> Idris ()
addIBC (Name -> IBCWrite
IBCImp Name
n)
Int -> FilePath -> Idris ()
logLvl Int
5 (FilePath
"Implicit " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [PArg] -> FilePath
forall a. Show a => a -> FilePath
show [PArg]
impdata)
PTerm -> Idris PTerm
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
tm'
where
defaultArgCheck :: [Name] -> [PArg] -> Idris ()
defaultArgCheck :: [Name] -> [PArg] -> Idris ()
defaultArgCheck [Name]
knowns [PArg]
params = ([Name] -> PArg -> Idris [Name]) -> [Name] -> [PArg] -> Idris ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ [Name] -> PArg -> Idris [Name]
notFoundInDefault [Name]
knowns [PArg]
params
notFoundInDefault :: [Name] -> PArg -> Idris [Name]
notFoundInDefault :: [Name] -> PArg -> Idris [Name]
notFoundInDefault [Name]
kns (PTacImplicit Int
_ [ArgOpt]
_ Name
n PTerm
script PTerm
_)
= do IState
i <- Idris IState
getIState
case [Name] -> [Name] -> Maybe Name
notFound [Name]
kns ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [] IState
i PTerm
script) of
Maybe Name
Nothing -> [Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
kns)
Just Name
name -> Err -> Idris [Name]
forall a. Err -> Idris a
throwError (Name -> Err
forall t. Name -> Err' t
NoSuchVariable Name
name)
notFoundInDefault [Name]
kns PArg
p = [Name] -> Idris [Name]
forall a. a -> StateT IState (ExceptT Err IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((PArg -> Name
forall t. PArg' t -> Name
pname PArg
p)Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
kns)
notFound :: [Name] -> [Name] -> Maybe Name
notFound :: [Name] -> [Name] -> Maybe Name
notFound [Name]
kns [] = Maybe Name
forall a. Maybe a
Nothing
notFound [Name]
kns (SN (WhereN Int
_ Name
_ Name
_) : [Name]
ns) = [Name] -> [Name] -> Maybe Name
notFound [Name]
kns [Name]
ns
notFound [Name]
kns (Name
n:[Name]
ns) = if Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n [Name]
kns then [Name] -> [Name] -> Maybe Name
notFound [Name]
kns [Name]
ns else Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
implicitise :: Bool -> SyntaxInfo -> [Name] -> IState -> PTerm -> (PTerm, [PArg])
implicitise :: Bool -> SyntaxInfo -> [Name] -> IState -> PTerm -> (PTerm, [PArg])
implicitise Bool
auto SyntaxInfo
syn [Name]
ignore IState
ist PTerm
tm =
let ([PArg]
declimps, [Name]
ns') = State ([PArg], [Name]) () -> ([PArg], [Name]) -> ([PArg], [Name])
forall s a. State s a -> s -> s
execState (Bool -> [Name] -> PTerm -> State ([PArg], [Name]) ()
forall {m :: * -> *}.
MonadState ([PArg], [Name]) m =>
Bool -> [Name] -> PTerm -> m ()
imps Bool
True [] PTerm
tm) ([], [])
ns :: [Name]
ns = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
n -> Bool
auto Bool -> Bool -> Bool
&& Name -> Bool
implicitable Name
n Bool -> Bool -> Bool
|| Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
uvars)) ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$
[Name]
ns' [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
pvars [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ SyntaxInfo -> [Name]
no_imp SyntaxInfo
syn [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ignore)
nsOrder :: [Name]
nsOrder = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Bool
inUsing) [Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
inUsing [Name]
ns in
if [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ns
then (PTerm
tm, [PArg] -> [PArg]
forall {a}. [a] -> [a]
reverse [PArg]
declimps)
else Bool -> SyntaxInfo -> [Name] -> IState -> PTerm -> (PTerm, [PArg])
implicitise Bool
auto SyntaxInfo
syn [Name]
ignore IState
ist ([(Name, PTerm)] -> [Name] -> PTerm -> PTerm
pibind [(Name, PTerm)]
uvars [Name]
nsOrder PTerm
tm)
where
uvars :: [(Name, PTerm)]
uvars = (Using -> (Name, PTerm)) -> [Using] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map Using -> (Name, PTerm)
ipair ((Using -> Bool) -> [Using] -> [Using]
forall a. (a -> Bool) -> [a] -> [a]
filter Using -> Bool
uimplicit (SyntaxInfo -> [Using]
using SyntaxInfo
syn))
pvars :: [(Name, PTerm)]
pvars = SyntaxInfo -> [(Name, PTerm)]
syn_params SyntaxInfo
syn
inUsing :: Name -> Bool
inUsing Name
n = Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
uvars
ipair :: Using -> (Name, PTerm)
ipair (UImplicit Name
x PTerm
y) = (Name
x, PTerm
y)
uimplicit :: Using -> Bool
uimplicit (UImplicit Name
_ PTerm
_) = Bool
True
uimplicit Using
_ = Bool
False
dropAll :: [a] -> t a -> [a]
dropAll (a
x:[a]
xs) t a
ys | a
x a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
ys = [a] -> t a -> [a]
dropAll [a]
xs t a
ys
| Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> t a -> [a]
dropAll [a]
xs t a
ys
dropAll [] t a
ys = []
implNamesIn :: [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, b)]
uv (PApp FC
fc PTerm
f [PArg]
args) = (PArg -> [Name]) -> [PArg] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, b)]
uv (PTerm -> [Name]) -> (PArg -> PTerm) -> PArg -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PArg -> PTerm
forall t. PArg' t -> t
getTm) [PArg]
args
implNamesIn [(Name, b)]
uv PTerm
t = [Name] -> IState -> PTerm -> [Name]
implicitNamesIn (((Name, b) -> Name) -> [(Name, b)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, b) -> Name
forall a b. (a, b) -> a
fst [(Name, b)]
uv) IState
ist PTerm
t
imps :: Bool -> [Name] -> PTerm -> m ()
imps Bool
top [Name]
env ty :: PTerm
ty@(PApp FC
_ PTerm
f [PArg]
as)
= do ([PArg]
decls, [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty)
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
imps Bool
top [Name]
env (PPi (Imp [ArgOpt]
l Static
_ Bool
_ Maybe ImplicitInfo
_ Bool
_ RigCount
_) Name
n FC
_ PTerm
ty PTerm
sc)
= do let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty) [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
([PArg]
decls , [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp (IState -> PTerm -> Int
getPriority IState
ist PTerm
ty) Bool
True [ArgOpt]
l Name
n PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: [PArg]
decls,
[Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
imps Bool
top [Name]
env (PPi (Exp [ArgOpt]
l Static
_ Bool
_ RigCount
_) Name
n FC
_ PTerm
ty PTerm
sc)
= do let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ case PTerm
sc of
(PRef FC
_ [FC]
_ Name
x) -> [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
sc [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
PTerm
_ -> [])
([PArg]
decls, [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp (IState -> PTerm -> Int
getPriority IState
ist PTerm
ty) [ArgOpt]
l Name
n PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: [PArg]
decls,
[Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
imps Bool
top [Name]
env (PPi (Constraint [ArgOpt]
l Static
_ RigCount
_) Name
n FC
_ PTerm
ty PTerm
sc)
= do let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ case PTerm
sc of
(PRef FC
_ [FC]
_ Name
x) -> [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
sc [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
PTerm
_ -> [])
([PArg]
decls, [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
10 [ArgOpt]
l Name
n PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: [PArg]
decls,
[Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
imps Bool
top [Name]
env (PPi (TacImp [ArgOpt]
l Static
_ PTerm
scr RigCount
_) Name
n FC
_ PTerm
ty PTerm
sc)
= do let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ case PTerm
sc of
(PRef FC
_ [FC]
_ Name
x) -> [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
sc [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
PTerm
_ -> [])
([PArg]
decls, [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
10 [ArgOpt]
l Name
n PTerm
scr PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: [PArg]
decls,
[Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
imps Bool
top [Name]
env (PRewrite FC
_ Maybe Name
_ PTerm
l PTerm
r Maybe PTerm
_)
= do ([PArg]
decls, [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
let isn :: [Name]
isn = [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
imps Bool
top [Name]
env (PTyped PTerm
l PTerm
r)
= Bool -> [Name] -> PTerm -> m ()
imps Bool
top [Name]
env PTerm
l
imps Bool
top [Name]
env (PPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
r)
= do ([PArg]
decls, [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
let isn :: [Name]
isn = [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
imps Bool
top [Name]
env (PDPair FC
_ [FC]
_ PunInfo
_ (PRef FC
_ [FC]
_ Name
n) PTerm
t PTerm
r)
= do ([PArg]
decls, [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
t [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r) [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name
n]
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
imps Bool
top [Name]
env (PDPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
t PTerm
r)
= do ([PArg]
decls, [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
let isn :: [Name]
isn = [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
t [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
[(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
imps Bool
top [Name]
env (PAlternative [(Name, Name)]
ms PAltType
a [PTerm]
as)
= do ([PArg]
decls, [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
let isn :: [Name]
isn = (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist) [PTerm]
as
([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
imps Bool
top [Name]
env (PLam FC
fc Name
n FC
_ PTerm
ty PTerm
sc)
= do Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
ty
Bool -> [Name] -> PTerm -> m ()
imps Bool
False (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
imps Bool
top [Name]
env (PHidden PTerm
tm) = Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
tm
imps Bool
top [Name]
env (PUnifyLog PTerm
tm) = Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
tm
imps Bool
top [Name]
env (PNoImplicits PTerm
tm) = Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
tm
imps Bool
top [Name]
env (PRunElab FC
fc PTerm
tm [FilePath]
ns) = Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
tm
imps Bool
top [Name]
env (PConstSugar FC
fc PTerm
tm) = Bool -> [Name] -> PTerm -> m ()
imps Bool
top [Name]
env PTerm
tm
imps Bool
top [Name]
env PTerm
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pibind :: [(Name, PTerm)] -> [Name] -> PTerm -> PTerm
pibind [(Name, PTerm)]
using [] PTerm
sc = PTerm
sc
pibind [(Name, PTerm)]
using (Name
n:[Name]
ns) PTerm
sc
= case Name -> [(Name, PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, PTerm)]
using of
Just PTerm
ty -> Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
impl_gen
Name
n FC
NoFC PTerm
ty ([(Name, PTerm)] -> [Name] -> PTerm -> PTerm
pibind [(Name, PTerm)]
using [Name]
ns PTerm
sc)
Maybe PTerm
Nothing -> Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi (Plicity
impl_gen { pargopts = [InaccessibleArg] })
Name
n FC
NoFC PTerm
Placeholder ([(Name, PTerm)] -> [Name] -> PTerm -> PTerm
pibind [(Name, PTerm)]
using [Name]
ns PTerm
sc)
addImplPat :: IState -> PTerm -> PTerm
addImplPat :: IState -> PTerm -> PTerm
addImplPat = Bool -> [Name] -> [Name] -> [Name] -> IState -> PTerm -> PTerm
addImpl' Bool
True [] [] []
addImplBound :: IState -> [Name] -> PTerm -> PTerm
addImplBound :: IState -> [Name] -> PTerm -> PTerm
addImplBound IState
ist [Name]
ns = Bool -> [Name] -> [Name] -> [Name] -> IState -> PTerm -> PTerm
addImpl' Bool
False [Name]
ns [] [] IState
ist
addImplBoundInf :: IState -> [Name] -> [Name] -> PTerm -> PTerm
addImplBoundInf :: IState -> [Name] -> [Name] -> PTerm -> PTerm
addImplBoundInf IState
ist [Name]
ns [Name]
inf = Bool -> [Name] -> [Name] -> [Name] -> IState -> PTerm -> PTerm
addImpl' Bool
False [Name]
ns [Name]
inf [] IState
ist
addImpl :: [Name] -> IState -> PTerm -> PTerm
addImpl :: [Name] -> IState -> PTerm -> PTerm
addImpl = Bool -> [Name] -> [Name] -> [Name] -> IState -> PTerm -> PTerm
addImpl' Bool
False [] []
addImpl' :: Bool -> [Name] -> [Name] -> [Name] -> IState -> PTerm -> PTerm
addImpl' :: Bool -> [Name] -> [Name] -> [Name] -> IState -> PTerm -> PTerm
addImpl' Bool
inpat [Name]
env [Name]
infns [Name]
imp_meths IState
ist PTerm
ptm
= Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
False ([Name] -> [Maybe PTerm] -> [(Name, Maybe PTerm)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
env (Maybe PTerm -> [Maybe PTerm]
forall a. a -> [a]
repeat Maybe PTerm
forall a. Maybe a
Nothing)) [] ([Name] -> [(Name, Name)] -> PTerm -> PTerm
mkUniqueNames [Name]
env [] PTerm
ptm)
where
allowcap :: Bool
allowcap = Opt
AllowCapitalizedPatternVariables Opt -> [Opt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
ist)
topname :: Name
topname = case PTerm
ptm of
PRef FC
_ [FC]
_ Name
n -> Name
n
PApp FC
_ (PRef FC
_ [FC]
_ Name
n) [PArg]
_ -> Name
n
PTerm
_ -> FilePath -> Name
sUN FilePath
""
ai :: Bool -> Bool -> [(Name, Maybe PTerm)] -> [[T.Text]] -> PTerm -> PTerm
ai :: Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PRef FC
fc [FC]
fcs Name
f)
| Name
f Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infns = FC -> [FC] -> Name -> PTerm
PInferRef FC
fc [FC]
fcs Name
f
| Bool -> Bool
not (Name
f Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Name, Maybe PTerm) -> Name) -> [(Name, Maybe PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Maybe PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, Maybe PTerm)]
env) = Either Err PTerm -> PTerm
handleErr (Either Err PTerm -> PTerm) -> Either Err PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ Name
-> Bool
-> Bool
-> Bool
-> Bool
-> [Name]
-> IState
-> FC
-> Name
-> FC
-> [[Text]]
-> [PArg]
-> Either Err PTerm
aiFn Name
topname Bool
allowcap Bool
inpat Bool
inpat Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
fc [[Text]]
ds []
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PHidden (PRef FC
fc [FC]
hl Name
f))
| Bool -> Bool
not (Name
f Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Name, Maybe PTerm) -> Name) -> [(Name, Maybe PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Maybe PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, Maybe PTerm)]
env) = PTerm -> PTerm
PHidden (Either Err PTerm -> PTerm
handleErr (Either Err PTerm -> PTerm) -> Either Err PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ Name
-> Bool
-> Bool
-> Bool
-> Bool
-> [Name]
-> IState
-> FC
-> Name
-> FC
-> [[Text]]
-> [PArg]
-> Either Err PTerm
aiFn Name
topname Bool
allowcap Bool
inpat Bool
False Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
fc [[Text]]
ds [])
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PRewrite FC
fc Maybe Name
by PTerm
l PTerm
r Maybe PTerm
g)
= let l' :: PTerm
l' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
l
r' :: PTerm
r' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
r
g' :: Maybe PTerm
g' = (PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds) Maybe PTerm
g in
FC -> Maybe Name -> PTerm -> PTerm -> Maybe PTerm -> PTerm
PRewrite FC
fc Maybe Name
by PTerm
l' PTerm
r' Maybe PTerm
g'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PTyped PTerm
l PTerm
r)
= let l' :: PTerm
l' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
l
r' :: PTerm
r' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
r in
PTerm -> PTerm -> PTerm
PTyped PTerm
l' PTerm
r'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PPair FC
fc [FC]
hls PunInfo
p PTerm
l PTerm
r)
= let l' :: PTerm
l' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
l
r' :: PTerm
r' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
r in
FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
fc [FC]
hls PunInfo
p PTerm
l' PTerm
r'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PDPair FC
fc [FC]
hls PunInfo
p PTerm
l PTerm
t PTerm
r)
= let l' :: PTerm
l' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
l
t' :: PTerm
t' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
t
r' :: PTerm
r' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
r in
FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
fc [FC]
hls PunInfo
p PTerm
l' PTerm
t' PTerm
r'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PAlternative [(Name, Name)]
ms PAltType
a [PTerm]
as)
= let as' :: [PTerm]
as' = (PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds) [PTerm]
as in
[(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ms PAltType
a [PTerm]
as'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
_ (PDisamb [[Text]]
ds' PTerm
as) = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds' PTerm
as
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PApp FC
fc (PInferRef FC
ffc [FC]
hl Name
f) [PArg]
as)
= let as' :: [PArg]
as' = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds)) [PArg]
as in
FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
ffc [FC]
hl Name
f) [PArg]
as'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PApp FC
fc ftm :: PTerm
ftm@(PRef FC
ffc [FC]
hl Name
f) [PArg]
as)
| Name
f Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infns = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
ffc [FC]
hl Name
f) [PArg]
as)
| Bool -> Bool
not (Name
f Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Name, Maybe PTerm) -> Name) -> [(Name, Maybe PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Maybe PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, Maybe PTerm)]
env)
= let as' :: [PArg]
as' = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds)) [PArg]
as in
Either Err PTerm -> PTerm
handleErr (Either Err PTerm -> PTerm) -> Either Err PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ Name
-> Bool
-> Bool
-> Bool
-> Bool
-> [Name]
-> IState
-> FC
-> Name
-> FC
-> [[Text]]
-> [PArg]
-> Either Err PTerm
aiFn Name
topname Bool
allowcap Bool
inpat Bool
False Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
ffc [[Text]]
ds [PArg]
as'
| Just (Just PTerm
ty) <- Name -> [(Name, Maybe PTerm)] -> Maybe (Maybe PTerm)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
f [(Name, Maybe PTerm)]
env =
let as' :: [PArg]
as' = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds)) [PArg]
as
arity :: Int
arity = PTerm -> Int
getPArity PTerm
ty in
FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc Int
arity PTerm
ftm [PArg]
as'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PApp FC
fc PTerm
f [PArg]
as)
= let f' :: PTerm
f' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
f
as' :: [PArg]
as' = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds)) [PArg]
as in
FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc Int
1 PTerm
f' [PArg]
as'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PWithApp FC
fc PTerm
f PTerm
a)
= FC -> PTerm -> PTerm -> PTerm
PWithApp FC
fc (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
f) (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
a)
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PCase FC
fc PTerm
c [(PTerm, PTerm)]
os)
= let c' :: PTerm
c' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
c in
FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc PTerm
c' (((PTerm, PTerm) -> (PTerm, PTerm))
-> [(PTerm, PTerm)] -> [(PTerm, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (PTerm, PTerm) -> (PTerm, PTerm)
aiCase [(PTerm, PTerm)]
os)
where
aiCase :: (PTerm, PTerm) -> (PTerm, PTerm)
aiCase (PTerm
lhs, PTerm
rhs)
= (PTerm
lhs, Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq ([(Name, Maybe PTerm)]
env [(Name, Maybe PTerm)]
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. [a] -> [a] -> [a]
++ PTerm -> [(Name, Maybe PTerm)]
forall {a}. PTerm -> [(Name, Maybe a)]
patnames PTerm
lhs) [[Text]]
ds PTerm
rhs)
patnames :: PTerm -> [(Name, Maybe a)]
patnames (PApp FC
_ (PRef FC
_ [FC]
_ Name
f) [])
| Name -> Bool
implicitable Name
f = [(Name
f, Maybe a
forall a. Maybe a
Nothing)]
patnames (PRef FC
_ [FC]
_ Name
f)
| Name -> Bool
implicitable Name
f = [(Name
f, Maybe a
forall a. Maybe a
Nothing)]
patnames (PApp FC
_ (PRef FC
_ [FC]
_ Name
_) [PArg]
args)
= (PTerm -> [(Name, Maybe a)]) -> [PTerm] -> [(Name, Maybe a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [(Name, Maybe a)]
patnames ((PArg -> PTerm) -> [PArg] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map PArg -> PTerm
forall t. PArg' t -> t
getTm [PArg]
args)
patnames (PPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
r) = PTerm -> [(Name, Maybe a)]
patnames PTerm
l [(Name, Maybe a)] -> [(Name, Maybe a)] -> [(Name, Maybe a)]
forall a. [a] -> [a] -> [a]
++ PTerm -> [(Name, Maybe a)]
patnames PTerm
r
patnames (PDPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
t PTerm
r) = PTerm -> [(Name, Maybe a)]
patnames PTerm
l [(Name, Maybe a)] -> [(Name, Maybe a)] -> [(Name, Maybe a)]
forall a. [a] -> [a] -> [a]
++ PTerm -> [(Name, Maybe a)]
patnames PTerm
t [(Name, Maybe a)] -> [(Name, Maybe a)] -> [(Name, Maybe a)]
forall a. [a] -> [a] -> [a]
++ PTerm -> [(Name, Maybe a)]
patnames PTerm
r
patnames (PAs FC
_ Name
_ PTerm
t) = PTerm -> [(Name, Maybe a)]
patnames PTerm
t
patnames (PAlternative [(Name, Name)]
_ PAltType
_ [PTerm]
ts) = (PTerm -> [(Name, Maybe a)]) -> [PTerm] -> [(Name, Maybe a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [(Name, Maybe a)]
patnames [PTerm]
ts
patnames PTerm
_ = []
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PIfThenElse FC
fc PTerm
c PTerm
t PTerm
f) = FC -> PTerm -> PTerm -> PTerm -> PTerm
PIfThenElse FC
fc (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
c)
(Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
t)
(Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
f)
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PLam FC
fc Name
n FC
nfc PTerm
ty PTerm
sc)
= if Name -> Context -> Bool
canBeDConName Name
n (IState -> Context
tt_ctxt IState
ist)
then Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc (Int -> FilePath -> Name
sMN Int
0 FilePath
"lamp") FC
NoFC PTerm
ty
(FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc [] (Int -> FilePath -> Name
sMN Int
0 FilePath
"lamp") )
[(FC -> [FC] -> Name -> PTerm
PRef FC
fc [] Name
n, PTerm
sc)]))
else let ty' :: PTerm
ty' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
ty
sc' :: PTerm
sc' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq ((Name
n, PTerm -> Maybe PTerm
forall a. a -> Maybe a
Just PTerm
ty)(Name, Maybe PTerm)
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. a -> [a] -> [a]
:[(Name, Maybe PTerm)]
env) [[Text]]
ds PTerm
sc in
FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
n FC
nfc PTerm
ty' PTerm
sc'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PLet FC
fc RigCount
rc Name
n FC
nfc PTerm
ty PTerm
val PTerm
sc)
= if Name -> Context -> Bool
canBeDConName Name
n (IState -> Context
tt_ctxt IState
ist)
then Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc PTerm
val [(FC -> [FC] -> Name -> PTerm
PRef FC
fc [] Name
n, PTerm
sc)])
else let ty' :: PTerm
ty' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
ty
val' :: PTerm
val' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
val
sc' :: PTerm
sc' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq ((Name
n, PTerm -> Maybe PTerm
forall a. a -> Maybe a
Just PTerm
ty)(Name, Maybe PTerm)
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. a -> [a] -> [a]
:[(Name, Maybe PTerm)]
env) [[Text]]
ds PTerm
sc in
FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
n FC
nfc PTerm
ty' PTerm
val' PTerm
sc'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PPi Plicity
p Name
n FC
nfc PTerm
ty PTerm
sc)
= let ty' :: PTerm
ty' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
ty
env' :: [(Name, Maybe PTerm)]
env' = if Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
imp_meths then [(Name, Maybe PTerm)]
env
else
((Name
n, PTerm -> Maybe PTerm
forall a. a -> Maybe a
Just PTerm
ty) (Name, Maybe PTerm)
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. a -> [a] -> [a]
: [(Name, Maybe PTerm)]
env)
sc' :: PTerm
sc' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env' [[Text]]
ds PTerm
sc in
Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
n FC
nfc PTerm
ty' PTerm
sc'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PGoal FC
fc PTerm
r Name
n PTerm
sc)
= let r' :: PTerm
r' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
r
sc' :: PTerm
sc' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq ((Name
n, Maybe PTerm
forall a. Maybe a
Nothing)(Name, Maybe PTerm)
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. a -> [a] -> [a]
:[(Name, Maybe PTerm)]
env) [[Text]]
ds PTerm
sc in
FC -> PTerm -> Name -> PTerm -> PTerm
PGoal FC
fc PTerm
r' Name
n PTerm
sc'
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PHidden PTerm
tm) = PTerm -> PTerm
PHidden (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
tm)
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PUnifyLog PTerm
tm) = PTerm -> PTerm
PUnifyLog (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
tm)
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PNoImplicits PTerm
tm) = PTerm -> PTerm
PNoImplicits (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
tm)
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PQuasiquote PTerm
tm Maybe PTerm
g) = PTerm -> Maybe PTerm -> PTerm
PQuasiquote (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
True [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
tm)
((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
True [(Name, Maybe PTerm)]
env [[Text]]
ds) Maybe PTerm
g)
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PUnquote PTerm
tm) = PTerm -> PTerm
PUnquote (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
False [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
tm)
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PRunElab FC
fc PTerm
tm [FilePath]
ns) = FC -> PTerm -> [FilePath] -> PTerm
PRunElab FC
fc (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
False [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
tm) [FilePath]
ns
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (PConstSugar FC
fc PTerm
tm) = FC -> PTerm -> PTerm
PConstSugar FC
fc (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
tm)
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
tm = PTerm
tm
handleErr :: Either Err PTerm -> PTerm
handleErr (Left Err
err) = Err -> PTerm
PElabError Err
err
handleErr (Right PTerm
x) = PTerm
x
aiFn :: Name -> Bool
-> Bool -> Bool -> Bool
-> [Name]
-> IState -> FC
-> Name
-> FC -> [[T.Text]]
-> [PArg]
-> Either Err PTerm
aiFn :: Name
-> Bool
-> Bool
-> Bool
-> Bool
-> [Name]
-> IState
-> FC
-> Name
-> FC
-> [[Text]]
-> [PArg]
-> Either Err PTerm
aiFn Name
topname Bool
allowcap Bool
inpat Bool
True Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
ffc [[Text]]
ds []
| Bool
inpat Bool -> Bool -> Bool
&& Name -> Bool
implicitable Name
f Bool -> Bool -> Bool
&& Name -> Bool
unqualified Name
f = PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
| Bool
otherwise
= case Name -> Context -> [Def]
lookupDef Name
f (IState -> Context
tt_ctxt IState
ist) of
[] -> if Bool
allowcap
then PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
else case Name
f of
MN Int
_ Text
_ -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
UN Text
xs | Char -> Bool
isDigit (HasCallStack => Text -> Char
Text -> Char
T.head Text
xs)
-> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
Name
_ -> Err -> Either Err PTerm
forall a b. a -> Either a b
Left (Err -> Either Err PTerm) -> Err -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FilePath -> Err
forall t. FilePath -> Err' t
Msg (FilePath -> Err) -> FilePath -> Err
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is not a valid name for a pattern variable"
[Def]
alts -> let ialts :: [(Name, [PArg])]
ialts = Name -> Ctxt [PArg] -> [(Name, [PArg])]
forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
f (IState -> Ctxt [PArg]
idris_implicits IState
ist) in
if (Bool -> Bool
not (Name -> Bool
vname Name
f) Bool -> Bool -> Bool
|| Name -> Bool
tcname Name
f
Bool -> Bool -> Bool
|| ((Name, [PArg]) -> Bool) -> [(Name, [PArg])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Context -> (Name, [PArg]) -> Bool
forall {t :: * -> *} {t}.
Foldable t =>
Context -> (Name, t (PArg' t)) -> Bool
conCaf (IState -> Context
tt_ctxt IState
ist)) [(Name, [PArg])]
ialts)
then Name
-> Bool
-> Bool
-> Bool
-> Bool
-> [Name]
-> IState
-> FC
-> Name
-> FC
-> [[Text]]
-> [PArg]
-> Either Err PTerm
aiFn Name
topname Bool
allowcap Bool
inpat Bool
False Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
ffc [[Text]]
ds []
else PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
where imp :: PArg' t -> Bool
imp (PExp Int
_ [ArgOpt]
_ Name
_ t
_) = Bool
False
imp PArg' t
_ = Bool
True
allImp :: t (PArg' t) -> Bool
allImp t (PArg' t)
xs = (PArg' t -> Bool) -> t (PArg' t) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PArg' t -> Bool
forall {t}. PArg' t -> Bool
imp t (PArg' t)
xs
unqualified :: Name -> Bool
unqualified (NS Name
_ [Text]
_) = Bool
False
unqualified Name
_ = Bool
True
conCaf :: Context -> (Name, t (PArg' t)) -> Bool
conCaf Context
ctxt (Name
n, t (PArg' t)
cia) = (Name -> Context -> Bool
isDConName Name
n Context
ctxt Bool -> Bool -> Bool
|| (Bool
qq Bool -> Bool -> Bool
&& Name -> Context -> Bool
isTConName Name
n Context
ctxt)) Bool -> Bool -> Bool
&& t (PArg' t) -> Bool
forall {t :: * -> *} {t}. Foldable t => t (PArg' t) -> Bool
allImp t (PArg' t)
cia
vname :: Name -> Bool
vname (UN Text
n) = Bool
True
vname Name
_ = Bool
False
aiFn Name
topname Bool
allowcap Bool
inpat Bool
expat Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
ffc [[Text]]
ds [PArg]
as
| Name
f Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
primNames = PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] Name
f) [PArg]
as
aiFn Name
topname Bool
allowcap Bool
inpat Bool
expat Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
ffc [[Text]]
ds [PArg]
as
= do let ns :: [(Name, [PArg])]
ns = Name -> Ctxt [PArg] -> [(Name, [PArg])]
forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
f (IState -> Ctxt [PArg]
idris_implicits IState
ist)
let nh :: [(Name, [PArg])]
nh = ((Name, [PArg]) -> Bool) -> [(Name, [PArg])] -> [(Name, [PArg])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
n, [PArg]
_) -> Name -> Bool
notHidden Name
n) [(Name, [PArg])]
ns
let ns' :: [(Name, [PArg])]
ns' = case [[Text]] -> [(Name, [PArg])] -> [(Name, [PArg])]
forall {b}. [[Text]] -> [(Name, b)] -> [(Name, b)]
trimAlts [[Text]]
ds [(Name, [PArg])]
nh of
[] -> [(Name, [PArg])]
nh
[(Name, [PArg])]
x -> [(Name, [PArg])]
x
case [(Name, [PArg])]
ns' of
[(Name
f',[PArg]
ns)] -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc ([PArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
ns) (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] (Name -> Name -> Name
isImpName Name
f Name
f'))
([PArg] -> [PArg] -> [PArg]
insertImpl [PArg]
ns [PArg]
as)
[] -> case Name -> [Name] -> Maybe Name
metaVar Name
f (((Name, (Maybe Name, Int, [Name], Bool, Bool)) -> Name)
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, (Maybe Name, Int, [Name], Bool, Bool)) -> Name
forall a b. (a, b) -> a
fst (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
ist)) of
Just Name
f' -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] Name
f') [PArg]
as
Maybe Name
Nothing -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc ([PArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
as) (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] Name
f) [PArg]
as
[(Name, [PArg])]
alts -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$
[(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [] (Bool -> PAltType
ExactlyOne Bool
True) ([PTerm] -> PTerm) -> [PTerm] -> PTerm
forall a b. (a -> b) -> a -> b
$
((Name, [PArg]) -> PTerm) -> [(Name, [PArg])] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
f', [PArg]
ns) -> FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc ([PArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
ns) (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] (Name -> Name -> Name
isImpName Name
f Name
f'))
([PArg] -> [PArg] -> [PArg]
insertImpl [PArg]
ns [PArg]
as)) [(Name, [PArg])]
alts
where
isImpName :: Name -> Name -> Name
isImpName Name
f Name
f' | Name
f Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
imp_meths = Name
f
| Bool
otherwise = Name
f'
metaVar :: Name -> [Name] -> Maybe Name
metaVar Name
f (Name
mvn : [Name]
ns) | Name
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Name
nsroot Name
mvn = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
mvn
metaVar Name
f (Name
_ : [Name]
ns) = Name -> [Name] -> Maybe Name
metaVar Name
f [Name]
ns
metaVar Name
f [] = Maybe Name
forall a. Maybe a
Nothing
trimAlts :: [[Text]] -> [(Name, b)] -> [(Name, b)]
trimAlts [] [(Name, b)]
alts = [(Name, b)]
alts
trimAlts [[Text]]
ns [(Name, b)]
alts
= ((Name, b) -> Bool) -> [(Name, b)] -> [(Name, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
x, b
_) -> ([Text] -> Bool) -> [[Text]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\[Text]
d -> [Text]
d [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name -> [Text]
nspace Name
x) [[Text]]
ns) [(Name, b)]
alts
nspace :: Name -> [Text]
nspace (NS Name
_ [Text]
s) = [Text]
s
nspace Name
_ = []
notHidden :: Name -> Bool
notHidden Name
n = case Name -> Accessibility
getAccessibility Name
n of
Accessibility
Hidden -> Bool
False
Accessibility
Private -> Bool
False
Accessibility
_ -> Bool
True
getAccessibility :: Name -> Accessibility
getAccessibility Name
n
= case Name -> Bool -> Context -> Maybe (Def, Accessibility)
lookupDefAccExact Name
n Bool
False (IState -> Context
tt_ctxt IState
ist) of
Just (Def
n,Accessibility
t) -> Accessibility
t
Maybe (Def, Accessibility)
_ -> Accessibility
Public
insertImpl :: [PArg]
-> [PArg]
-> [PArg]
insertImpl :: [PArg] -> [PArg] -> [PArg]
insertImpl [PArg]
ps [PArg]
as
= let ([PArg]
as', [PArg]
badimpls) = (PArg -> Bool) -> [PArg] -> ([PArg], [PArg])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([PArg] -> PArg -> Bool
impIn [PArg]
ps) [PArg]
as in
(PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map PArg -> PArg
forall {t}. PArg' t -> PArg' t
addUnknownImp [PArg]
badimpls [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++
Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc Map Name PTerm
forall {k} {a}. Map k a
M.empty [PArg]
ps ((PArg -> Bool) -> [PArg] -> [PArg]
forall a. (a -> Bool) -> [a] -> [a]
filter PArg -> Bool
forall {t}. PArg' t -> Bool
expArg [PArg]
as') ((PArg -> Bool) -> [PArg] -> [PArg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (PArg -> Bool) -> PArg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PArg -> Bool
forall {t}. PArg' t -> Bool
expArg) [PArg]
as')
insImpAcc :: M.Map Name PTerm
-> [PArg]
-> [PArg]
-> [PArg]
-> [PArg]
insImpAcc :: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc Map Name PTerm
pnas (PExp Int
p [ArgOpt]
l Name
n PTerm
ty : [PArg]
ps) (PExp Int
_ [ArgOpt]
_ Name
_ PTerm
tm : [PArg]
given) [PArg]
imps =
Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp Int
p [ArgOpt]
l Name
n PTerm
tm PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
tm Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
insImpAcc Map Name PTerm
pnas (PConstraint Int
p [ArgOpt]
l Name
n PTerm
ty : [PArg]
ps) (PConstraint Int
_ [ArgOpt]
_ Name
_ PTerm
tm : [PArg]
given) [PArg]
imps =
Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
p [ArgOpt]
l Name
n PTerm
tm PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
tm Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
insImpAcc Map Name PTerm
pnas (PConstraint Int
p [ArgOpt]
l Name
n PTerm
ty : [PArg]
ps) [PArg]
given [PArg]
imps =
let rtc :: PTerm
rtc = FC -> PTerm
PResolveTC FC
fc in
Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
p [ArgOpt]
l Name
n PTerm
rtc PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
rtc Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
insImpAcc Map Name PTerm
pnas (PImp Int
p Bool
_ [ArgOpt]
l Name
n PTerm
ty : [PArg]
ps) [PArg]
given [PArg]
imps =
case Name -> [PArg] -> [PArg] -> Maybe (PTerm, [PArg])
forall {a}. Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n [PArg]
imps [] of
Just (PTerm
tm, [PArg]
imps') ->
Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
p Bool
False [ArgOpt]
l Name
n PTerm
tm PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
tm Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps'
Maybe (PTerm, [PArg])
Nothing ->
Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
p Bool
True [ArgOpt]
l Name
n PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
:
Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
Placeholder Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
insImpAcc Map Name PTerm
pnas (PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc' PTerm
ty : [PArg]
ps) [PArg]
given [PArg]
imps =
let sc :: PTerm
sc = [Name] -> IState -> PTerm -> PTerm
addImpl [Name]
imp_meths IState
ist ([(Name, PTerm)] -> PTerm -> PTerm
substMatches (Map Name PTerm -> [(Name, PTerm)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name PTerm
pnas) PTerm
sc') in
case Name -> [PArg] -> [PArg] -> Maybe (PTerm, [PArg])
forall {a}. Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n [PArg]
imps [] of
Just (PTerm
tm, [PArg]
imps') ->
Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
tm PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
:
Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
tm Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps'
Maybe (PTerm, [PArg])
Nothing ->
if Bool
inpat
then Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
:
Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
Placeholder Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
else Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
sc PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
:
Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
sc Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
insImpAcc Map Name PTerm
_ [PArg]
expected [] [PArg]
imps = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map PArg -> PArg
forall {t}. PArg' t -> PArg' t
addUnknownImp [PArg]
imps
insImpAcc Map Name PTerm
_ [PArg]
_ [PArg]
given [PArg]
imps = [PArg]
given [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ [PArg]
imps
addUnknownImp :: PArg' t -> PArg' t
addUnknownImp PArg' t
arg = PArg' t
arg { argopts = UnknownImp : argopts arg }
find :: Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n [] [PArg' a]
acc = Maybe (a, [PArg' a])
forall a. Maybe a
Nothing
find Name
n (PImp Int
_ Bool
_ [ArgOpt]
_ Name
n' a
t : [PArg' a]
gs) [PArg' a]
acc
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = (a, [PArg' a]) -> Maybe (a, [PArg' a])
forall a. a -> Maybe a
Just (a
t, [PArg' a] -> [PArg' a]
forall {a}. [a] -> [a]
reverse [PArg' a]
acc [PArg' a] -> [PArg' a] -> [PArg' a]
forall a. [a] -> [a] -> [a]
++ [PArg' a]
gs)
find Name
n (PTacImplicit Int
_ [ArgOpt]
_ Name
n' a
_ a
t : [PArg' a]
gs) [PArg' a]
acc
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = (a, [PArg' a]) -> Maybe (a, [PArg' a])
forall a. a -> Maybe a
Just (a
t, [PArg' a] -> [PArg' a]
forall {a}. [a] -> [a]
reverse [PArg' a]
acc [PArg' a] -> [PArg' a] -> [PArg' a]
forall a. [a] -> [a] -> [a]
++ [PArg' a]
gs)
find Name
n (PArg' a
g : [PArg' a]
gs) [PArg' a]
acc = Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n [PArg' a]
gs (PArg' a
g PArg' a -> [PArg' a] -> [PArg' a]
forall a. a -> [a] -> [a]
: [PArg' a]
acc)
impIn :: [PArg] -> PArg -> Bool
impIn :: [PArg] -> PArg -> Bool
impIn [PArg]
ps (PExp Int
_ [ArgOpt]
_ Name
_ PTerm
_) = Bool
True
impIn [PArg]
ps (PConstraint Int
_ [ArgOpt]
_ Name
_ PTerm
_) = Bool
True
impIn [PArg]
ps PArg
arg = (PArg -> Bool) -> [PArg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PArg
p -> Bool -> Bool
not (PArg -> Bool
forall {t}. PArg' t -> Bool
expArg PArg
arg) Bool -> Bool -> Bool
&& PArg -> Name
forall t. PArg' t -> Name
pname PArg
arg Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== PArg -> Name
forall t. PArg' t -> Name
pname PArg
p) [PArg]
ps
expArg :: PArg' t -> Bool
expArg (PExp Int
_ [ArgOpt]
_ Name
_ t
_) = Bool
True
expArg (PConstraint Int
_ [ArgOpt]
_ Name
_ t
_) = Bool
True
expArg PArg' t
_ = Bool
False
stripLinear :: IState -> PTerm -> PTerm
stripLinear :: IState -> PTerm -> PTerm
stripLinear IState
i PTerm
tm = State [Name] PTerm -> [Name] -> PTerm
forall s a. State s a -> s -> a
evalState (PTerm -> State [Name] PTerm
sl PTerm
tm) [] where
sl :: PTerm -> State [Name] PTerm
sl :: PTerm -> State [Name] PTerm
sl (PRef FC
fc [FC]
hl Name
f)
| (Term
_:[Term]
_) <- Name -> Context -> [Term]
lookupTy Name
f (IState -> Context
tt_ctxt IState
i)
= PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State [Name] PTerm) -> PTerm -> State [Name] PTerm
forall a b. (a -> b) -> a -> b
$ FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
f
| Bool
otherwise = do [Name]
ns <- StateT [Name] Identity [Name]
forall s (m :: * -> *). MonadState s m => m s
get
if (Name
f Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns)
then PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State [Name] PTerm) -> PTerm -> State [Name] PTerm
forall a b. (a -> b) -> a -> b
$ PTerm -> PTerm
PHidden (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
f)
else do [Name] -> StateT [Name] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name
f Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
ns)
PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
f)
sl (PPatvar FC
fc Name
f)
= do [Name]
ns <- StateT [Name] Identity [Name]
forall s (m :: * -> *). MonadState s m => m s
get
if (Name
f Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns)
then PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State [Name] PTerm) -> PTerm -> State [Name] PTerm
forall a b. (a -> b) -> a -> b
$ PTerm -> PTerm
PHidden (FC -> Name -> PTerm
PPatvar FC
fc Name
f)
else do [Name] -> StateT [Name] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name
f Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
ns)
PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> Name -> PTerm
PPatvar FC
fc Name
f)
sl t :: PTerm
t@(PAlternative [(Name, Name)]
ms PAltType
b [PTerm]
as) = do [Name]
ns <- StateT [Name] Identity [Name]
forall s (m :: * -> *). MonadState s m => m s
get
[PTerm]
as' <- [Name] -> [PTerm] -> StateT [Name] Identity [PTerm]
slAlts [Name]
ns [PTerm]
as
PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ms PAltType
b [PTerm]
as')
where slAlts :: [Name] -> [PTerm] -> StateT [Name] Identity [PTerm]
slAlts [Name]
ns (PTerm
a : [PTerm]
as) = do [Name] -> StateT [Name] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Name]
ns
PTerm
a' <- PTerm -> State [Name] PTerm
sl PTerm
a
[PTerm]
as' <- [Name] -> [PTerm] -> StateT [Name] Identity [PTerm]
slAlts [Name]
ns [PTerm]
as
[PTerm] -> StateT [Name] Identity [PTerm]
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm
a' PTerm -> [PTerm] -> [PTerm]
forall a. a -> [a] -> [a]
: [PTerm]
as')
slAlts [Name]
ns [] = [PTerm] -> StateT [Name] Identity [PTerm]
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
sl (PPair FC
fc [FC]
hls PunInfo
p PTerm
l PTerm
r) = do PTerm
l' <- PTerm -> State [Name] PTerm
sl PTerm
l; PTerm
r' <- PTerm -> State [Name] PTerm
sl PTerm
r; PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
fc [FC]
hls PunInfo
p PTerm
l' PTerm
r')
sl (PDPair FC
fc [FC]
hls PunInfo
p PTerm
l PTerm
t PTerm
r) = do PTerm
l' <- PTerm -> State [Name] PTerm
sl PTerm
l
PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
PTerm
r' <- PTerm -> State [Name] PTerm
sl PTerm
r
PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
fc [FC]
hls PunInfo
p PTerm
l' PTerm
t' PTerm
r')
sl (PApp FC
fc PTerm
fn [PArg]
args) = do PTerm
fn' <- case PTerm
fn of
PRef FC
_ [FC]
_ Name
_ -> PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
fn
PTerm
t -> PTerm -> State [Name] PTerm
sl PTerm
t
[PArg]
args' <- (PArg -> StateT [Name] Identity PArg)
-> [PArg] -> StateT [Name] Identity [PArg]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PArg -> StateT [Name] Identity PArg
slA [PArg]
args
PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State [Name] PTerm) -> PTerm -> State [Name] PTerm
forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
fn' [PArg]
args'
where slA :: PArg -> StateT [Name] Identity PArg
slA (PImp Int
p Bool
m [ArgOpt]
l Name
n PTerm
t) = do PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
PArg -> StateT [Name] Identity PArg
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PArg -> StateT [Name] Identity PArg)
-> PArg -> StateT [Name] Identity PArg
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
p Bool
m [ArgOpt]
l Name
n PTerm
t'
slA (PExp Int
p [ArgOpt]
l Name
n PTerm
t) = do PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
PArg -> StateT [Name] Identity PArg
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PArg -> StateT [Name] Identity PArg)
-> PArg -> StateT [Name] Identity PArg
forall a b. (a -> b) -> a -> b
$ Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp Int
p [ArgOpt]
l Name
n PTerm
t'
slA (PConstraint Int
p [ArgOpt]
l Name
n PTerm
t)
= do PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
PArg -> StateT [Name] Identity PArg
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PArg -> StateT [Name] Identity PArg)
-> PArg -> StateT [Name] Identity PArg
forall a b. (a -> b) -> a -> b
$ Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
p [ArgOpt]
l Name
n PTerm
t'
slA (PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
t)
= do PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
PArg -> StateT [Name] Identity PArg
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PArg -> StateT [Name] Identity PArg)
-> PArg -> StateT [Name] Identity PArg
forall a b. (a -> b) -> a -> b
$ Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
t'
sl PTerm
x = PTerm -> State [Name] PTerm
forall a. a -> StateT [Name] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
x
stripUnmatchable :: IState -> PTerm -> PTerm
stripUnmatchable :: IState -> PTerm -> PTerm
stripUnmatchable IState
i (PApp FC
fc PTerm
fn [PArg]
args) = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
fn ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PTerm -> PTerm
su) [PArg]
args) where
su :: PTerm -> PTerm
su :: PTerm -> PTerm
su tm :: PTerm
tm@(PRef FC
fc [FC]
hl Name
f)
| (Bind Name
n (Pi RigCount
_ Maybe ImplicitInfo
_ Term
t Term
_) Term
sc :[Term]
_) <- Name -> Context -> [Term]
lookupTy Name
f (IState -> Context
tt_ctxt IState
i)
= PTerm
Placeholder
| (TType UExp
_ : [Term]
_) <- Name -> Context -> [Term]
lookupTy Name
f (IState -> Context
tt_ctxt IState
i),
Bool -> Bool
not (Name -> Bool
implicitable Name
f)
= PTerm -> PTerm
PHidden PTerm
tm
| (UType Universe
_ : [Term]
_) <- Name -> Context -> [Term]
lookupTy Name
f (IState -> Context
tt_ctxt IState
i),
Bool -> Bool
not (Name -> Bool
implicitable Name
f)
= PTerm -> PTerm
PHidden PTerm
tm
su (PApp FC
fc f :: PTerm
f@(PRef FC
_ [FC]
_ Name
fn) [PArg]
args)
| Name -> Context -> Bool
canBeDConName Name
fn Context
ctxt
= FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PTerm -> PTerm
su) [PArg]
args)
su (PApp FC
fc PTerm
f [PArg]
args)
= PTerm -> PTerm
PHidden (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f [PArg]
args)
su (PAlternative [(Name, Name)]
ms PAltType
b [PTerm]
alts)
= let alts' :: [PTerm]
alts' = (PTerm -> Bool) -> [PTerm] -> [PTerm]
forall a. (a -> Bool) -> [a] -> [a]
filter (PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/= PTerm
Placeholder) ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map PTerm -> PTerm
su [PTerm]
alts) in
if [PTerm] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PTerm]
alts' then PTerm
Placeholder
else PTerm -> PTerm
liftHidden (PTerm -> PTerm) -> PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ms PAltType
b [PTerm]
alts'
su (PPair FC
fc [FC]
hls PunInfo
p PTerm
l PTerm
r) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
fc [FC]
hls PunInfo
p (PTerm -> PTerm
su PTerm
l) (PTerm -> PTerm
su PTerm
r)
su (PDPair FC
fc [FC]
hls PunInfo
p PTerm
l PTerm
t PTerm
r) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
fc [FC]
hls PunInfo
p (PTerm -> PTerm
su PTerm
l) (PTerm -> PTerm
su PTerm
t) (PTerm -> PTerm
su PTerm
r)
su t :: PTerm
t@(PLam FC
fc Name
_ FC
_ PTerm
_ PTerm
_) = PTerm -> PTerm
PHidden PTerm
t
su t :: PTerm
t@(PPi Plicity
_ Name
_ FC
_ PTerm
_ PTerm
_) = PTerm -> PTerm
PHidden PTerm
t
su t :: PTerm
t@(PConstant FC
_ Const
c) | Const -> Bool
isTypeConst Const
c = PTerm -> PTerm
PHidden PTerm
t
su PTerm
t = PTerm
t
ctxt :: Context
ctxt = IState -> Context
tt_ctxt IState
i
liftHidden :: PTerm -> PTerm
liftHidden tm :: PTerm
tm@(PAlternative [(Name, Name)]
ms PAltType
b [PTerm]
as)
| [PTerm] -> Bool
allHidden [PTerm]
as = PTerm -> PTerm
PHidden ([(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ms PAltType
b ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map PTerm -> PTerm
unHide [PTerm]
as))
| Bool
otherwise = PTerm
tm
allHidden :: [PTerm] -> Bool
allHidden [] = Bool
True
allHidden (PHidden PTerm
_ : [PTerm]
xs) = [PTerm] -> Bool
allHidden [PTerm]
xs
allHidden (PTerm
x : [PTerm]
xs) = Bool
False
unHide :: PTerm -> PTerm
unHide (PHidden PTerm
t) = PTerm
t
unHide PTerm
t = PTerm
t
stripUnmatchable IState
i PTerm
tm = PTerm
tm
mkPApp :: FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc Int
a PTerm
f [] = PTerm
f
mkPApp FC
fc Int
a PTerm
f [PArg]
as = let rest :: [PArg]
rest = Int -> [PArg] -> [PArg]
forall a. Int -> [a] -> [a]
drop Int
a [PArg]
as in
if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then FC -> PTerm -> [PArg] -> PTerm
appRest FC
fc PTerm
f [PArg]
rest
else FC -> PTerm -> [PArg] -> PTerm
appRest FC
fc (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f (Int -> [PArg] -> [PArg]
forall a. Int -> [a] -> [a]
take Int
a [PArg]
as)) [PArg]
rest
where
appRest :: FC -> PTerm -> [PArg] -> PTerm
appRest FC
fc PTerm
f [] = PTerm
f
appRest FC
fc PTerm
f (PArg
a : [PArg]
as) = FC -> PTerm -> [PArg] -> PTerm
appRest FC
fc (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f [PArg
a]) [PArg]
as
findStatics :: IState -> PTerm -> (PTerm, [Bool])
findStatics :: IState -> PTerm -> (PTerm, [Bool])
findStatics IState
ist PTerm
tm = let ([[Name]]
ns, [Name]
ss) = PTerm -> ([[Name]], [Name])
fs PTerm
tm
in State [Bool] PTerm -> [Bool] -> (PTerm, [Bool])
forall s a. State s a -> s -> (a, s)
runState ([[Name]] -> [Name] -> PTerm -> State [Bool] PTerm
forall {t :: * -> *} {m :: * -> *} {t}.
(Foldable t, MonadState [Bool] m) =>
t -> t Name -> PTerm -> m PTerm
pos [[Name]]
ns [Name]
ss PTerm
tm) []
where fs :: PTerm -> ([[Name]], [Name])
fs (PPi Plicity
p Name
n FC
fc PTerm
t PTerm
sc)
| Static
Static <- Plicity -> Static
pstatic Plicity
p
= let ([[Name]]
ns, [Name]
ss) = PTerm -> ([[Name]], [Name])
fs PTerm
sc in
([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [] IState
ist PTerm
t [Name] -> [[Name]] -> [[Name]]
forall a. a -> [a] -> [a]
: [[Name]]
ns, Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
ss)
| Bool
otherwise = let ([[Name]]
ns, [Name]
ss) = PTerm -> ([[Name]], [Name])
fs PTerm
sc in
([[Name]]
ns, [Name]
ss)
fs PTerm
_ = ([], [])
pos :: t -> t Name -> PTerm -> m PTerm
pos t
ns t Name
ss (PPi Plicity
p Name
n FC
fc PTerm
t PTerm
sc)
| Name -> t Name -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n t Name
ss = do PTerm
sc' <- t -> t Name -> PTerm -> m PTerm
pos t
ns t Name
ss PTerm
sc
[Bool]
spos <- m [Bool]
forall s (m :: * -> *). MonadState s m => m s
get
[Bool] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
spos)
PTerm -> m PTerm
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi (Plicity
p { pstatic = Static }) Name
n FC
fc PTerm
t PTerm
sc')
| Bool
otherwise = do PTerm
sc' <- t -> t Name -> PTerm -> m PTerm
pos t
ns t Name
ss PTerm
sc
[Bool]
spos <- m [Bool]
forall s (m :: * -> *). MonadState s m => m s
get
[Bool] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
spos)
PTerm -> m PTerm
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
n FC
fc PTerm
t PTerm
sc')
pos t
ns t Name
ss PTerm
t = PTerm -> m PTerm
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
t
data EitherErr a b = LeftErr a | RightOK b deriving ( (forall a b. (a -> b) -> EitherErr a a -> EitherErr a b)
-> (forall a b. a -> EitherErr a b -> EitherErr a a)
-> Functor (EitherErr a)
forall a b. a -> EitherErr a b -> EitherErr a a
forall a b. (a -> b) -> EitherErr a a -> EitherErr a b
forall a a b. a -> EitherErr a b -> EitherErr a a
forall a a b. (a -> b) -> EitherErr a a -> EitherErr a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> EitherErr a a -> EitherErr a b
fmap :: forall a b. (a -> b) -> EitherErr a a -> EitherErr a b
$c<$ :: forall a a b. a -> EitherErr a b -> EitherErr a a
<$ :: forall a b. a -> EitherErr a b -> EitherErr a a
Functor )
instance Applicative (EitherErr a) where
pure :: forall a. a -> EitherErr a a
pure = a -> EitherErr a a
forall a. a -> EitherErr a a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. EitherErr a (a -> b) -> EitherErr a a -> EitherErr a b
(<*>) = EitherErr a (a -> b) -> EitherErr a a -> EitherErr a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (EitherErr a) where
return :: forall a. a -> EitherErr a a
return = a -> EitherErr a a
forall a a. a -> EitherErr a a
RightOK
(LeftErr a
e) >>= :: forall a b. EitherErr a a -> (a -> EitherErr a b) -> EitherErr a b
>>= a -> EitherErr a b
_ = a -> EitherErr a b
forall a b. a -> EitherErr a b
LeftErr a
e
RightOK a
v >>= a -> EitherErr a b
k = a -> EitherErr a b
k a
v
toEither :: EitherErr a b -> Either a b
toEither :: forall a b. EitherErr a b -> Either a b
toEither (LeftErr a
e) = a -> Either a b
forall a b. a -> Either a b
Left a
e
toEither (RightOK b
ho) = b -> Either a b
forall a b. b -> Either a b
Right b
ho
matchClause :: IState -> PTerm -> PTerm -> Either (PTerm, PTerm) [(Name, PTerm)]
matchClause :: IState -> PTerm -> PTerm -> Either (PTerm, PTerm) [(Name, PTerm)]
matchClause = Bool
-> IState
-> PTerm
-> PTerm
-> Either (PTerm, PTerm) [(Name, PTerm)]
matchClause' Bool
False
matchClause' :: Bool -> IState -> PTerm -> PTerm -> Either (PTerm, PTerm) [(Name, PTerm)]
matchClause' :: Bool
-> IState
-> PTerm
-> PTerm
-> Either (PTerm, PTerm) [(Name, PTerm)]
matchClause' Bool
names IState
i PTerm
x PTerm
y = EitherErr (PTerm, PTerm) [(Name, PTerm)]
-> Either (PTerm, PTerm) [(Name, PTerm)]
forall {a}.
Eq a =>
EitherErr (PTerm, PTerm) [(a, PTerm)]
-> Either (PTerm, PTerm) [(a, PTerm)]
checkRpts (EitherErr (PTerm, PTerm) [(Name, PTerm)]
-> Either (PTerm, PTerm) [(Name, PTerm)])
-> EitherErr (PTerm, PTerm) [(Name, PTerm)]
-> Either (PTerm, PTerm) [(Name, PTerm)]
forall a b. (a -> b) -> a -> b
$ PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PTerm -> PTerm
fullApp PTerm
x) (PTerm -> PTerm
fullApp PTerm
y) where
matchArg :: PArg -> PArg -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
matchArg PArg
x PArg
y = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PTerm -> PTerm
fullApp (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x)) (PTerm -> PTerm
fullApp (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
y))
fullApp :: PTerm -> PTerm
fullApp (PApp FC
_ (PApp FC
fc PTerm
f [PArg]
args) [PArg]
xs) = PTerm -> PTerm
fullApp (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f ([PArg]
args [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ [PArg]
xs))
fullApp PTerm
x = PTerm
x
match' :: PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
x PTerm
y = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PTerm -> PTerm
fullApp PTerm
x) (PTerm -> PTerm
fullApp PTerm
y)
match :: PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PApp FC
_ (PRef FC
_ [FC]
_ (NS (UN Text
fi) [Text
b])) [PArg
_,PArg
_,PArg
x]) PTerm
x'
| Text
fi Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"fromInteger" Bool -> Bool -> Bool
&& Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"builtins",
PConstant FC
_ (I Int
_) <- PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x) PTerm
x'
match PTerm
x' (PApp FC
_ (PRef FC
_ [FC]
_ (NS (UN Text
fi) [Text
b])) [PArg
_,PArg
_,PArg
x])
| Text
fi Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"fromInteger" Bool -> Bool -> Bool
&& Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"builtins",
PConstant FC
_ (I Int
_) <- PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x) PTerm
x'
match (PApp FC
_ (PRef FC
_ [FC]
_ (UN Text
l)) [PArg
_,PArg
x]) PTerm
x' | Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"lazy" = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x) PTerm
x'
match PTerm
x (PApp FC
_ (PRef FC
_ [FC]
_ (UN Text
l)) [PArg
_,PArg
x']) | Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"lazy" = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x')
match (PApp FC
_ PTerm
f [PArg]
args) (PApp FC
_ PTerm
f' [PArg]
args')
| [PArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [PArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
args'
= do [(Name, PTerm)]
mf <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
f PTerm
f'
[[(Name, PTerm)]]
ms <- (PArg -> PArg -> EitherErr (PTerm, PTerm) [(Name, PTerm)])
-> [PArg] -> [PArg] -> EitherErr (PTerm, PTerm) [[(Name, PTerm)]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PArg -> PArg -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
matchArg [PArg]
args [PArg]
args'
[(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mf [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [[(Name, PTerm)]] -> [(Name, PTerm)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, PTerm)]]
ms)
match (PRef FC
f [FC]
hl Name
n) (PApp FC
_ PTerm
x []) = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (FC -> [FC] -> Name -> PTerm
PRef FC
f [FC]
hl Name
n) PTerm
x
match (PPatvar FC
f Name
n) PTerm
xr = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (FC -> [FC] -> Name -> PTerm
PRef FC
f [FC
f] Name
n) PTerm
xr
match PTerm
xr (PPatvar FC
f Name
n) = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
xr (FC -> [FC] -> Name -> PTerm
PRef FC
f [FC
f] Name
n)
match (PApp FC
_ PTerm
x []) (PRef FC
f [FC]
hl Name
n) = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x (FC -> [FC] -> Name -> PTerm
PRef FC
f [FC]
hl Name
n)
match (PRef FC
_ [FC]
_ Name
n) tm :: PTerm
tm@(PRef FC
_ [FC]
_ Name
n')
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
names Bool -> Bool -> Bool
&&
(Bool -> Bool
not (Name -> Context -> Bool
isConName Name
n (IState -> Context
tt_ctxt IState
i) Bool -> Bool -> Bool
|| Name -> Context -> Bool
isFnName Name
n (IState -> Context
tt_ctxt IState
i))
Bool -> Bool -> Bool
|| PTerm
tm PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
== PTerm
Placeholder)
= [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name
n, PTerm
tm)]
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' Bool -> Bool -> Bool
|| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Name
dropNS Name
n' Bool -> Bool -> Bool
|| Name -> Name
dropNS Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
where dropNS :: Name -> Name
dropNS (NS Name
n [Text]
_) = Name
n
dropNS Name
n = Name
n
match (PRef FC
_ [FC]
_ Name
n) PTerm
tm
| Bool -> Bool
not Bool
names Bool -> Bool -> Bool
&& (Bool -> Bool
not (Name -> Context -> Bool
isConName Name
n (IState -> Context
tt_ctxt IState
i) Bool -> Bool -> Bool
||
Name -> Context -> Bool
isFnName Name
n (IState -> Context
tt_ctxt IState
i)) Bool -> Bool -> Bool
|| PTerm
tm PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
== PTerm
Placeholder)
= [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name
n, PTerm
tm)]
match (PRewrite FC
_ Maybe Name
by PTerm
l PTerm
r Maybe PTerm
_) (PRewrite FC
_ Maybe Name
by' PTerm
l' PTerm
r' Maybe PTerm
_) | Maybe Name
by Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Name
by'
= do [(Name, PTerm)]
ml <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
l PTerm
l'
[(Name, PTerm)]
mr <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
r PTerm
r'
[(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mr)
match (PTyped PTerm
l PTerm
r) (PTyped PTerm
l' PTerm
r') = do [(Name, PTerm)]
ml <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
l PTerm
l'
[(Name, PTerm)]
mr <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
r PTerm
r'
[(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mr)
match (PTyped PTerm
l PTerm
r) PTerm
x = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
l PTerm
x
match PTerm
x (PTyped PTerm
l PTerm
r) = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x PTerm
l
match (PPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
r) (PPair FC
_ [FC]
_ PunInfo
_ PTerm
l' PTerm
r') = do [(Name, PTerm)]
ml <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
l PTerm
l'
[(Name, PTerm)]
mr <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
r PTerm
r'
[(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mr)
match (PDPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
t PTerm
r) (PDPair FC
_ [FC]
_ PunInfo
_ PTerm
l' PTerm
t' PTerm
r') = do [(Name, PTerm)]
ml <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
l PTerm
l'
[(Name, PTerm)]
mt <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
t PTerm
t'
[(Name, PTerm)]
mr <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
r PTerm
r'
[(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mt [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mr)
match (PAlternative [(Name, Name)]
_ PAltType
a [PTerm]
as) (PAlternative [(Name, Name)]
_ PAltType
a' [PTerm]
as')
= do [[(Name, PTerm)]]
ms <- (PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)])
-> [PTerm] -> [PTerm] -> EitherErr (PTerm, PTerm) [[(Name, PTerm)]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' [PTerm]
as [PTerm]
as'
[(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Name, PTerm)]] -> [(Name, PTerm)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, PTerm)]]
ms)
match a :: PTerm
a@(PAlternative [(Name, Name)]
_ PAltType
_ [PTerm]
as) PTerm
b
= do let ms :: [EitherErr (PTerm, PTerm) [(Name, PTerm)]]
ms = (PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)])
-> [PTerm] -> [PTerm] -> [EitherErr (PTerm, PTerm) [(Name, PTerm)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' [PTerm]
as (PTerm -> [PTerm]
forall a. a -> [a]
repeat PTerm
b)
case ([Either (PTerm, PTerm) [(Name, PTerm)]] -> [[(Name, PTerm)]]
forall a b. [Either a b] -> [b]
rights ((EitherErr (PTerm, PTerm) [(Name, PTerm)]
-> Either (PTerm, PTerm) [(Name, PTerm)])
-> [EitherErr (PTerm, PTerm) [(Name, PTerm)]]
-> [Either (PTerm, PTerm) [(Name, PTerm)]]
forall a b. (a -> b) -> [a] -> [b]
map EitherErr (PTerm, PTerm) [(Name, PTerm)]
-> Either (PTerm, PTerm) [(Name, PTerm)]
forall a b. EitherErr a b -> Either a b
toEither [EitherErr (PTerm, PTerm) [(Name, PTerm)]]
ms)) of
([(Name, PTerm)]
x: [[(Name, PTerm)]]
_) -> [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
x
[[(Name, PTerm)]]
_ -> (PTerm, PTerm) -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a b. a -> EitherErr a b
LeftErr (PTerm
a, PTerm
b)
match (PCase FC
_ PTerm
_ [(PTerm, PTerm)]
_) PTerm
_ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PMetavar FC
_ Name
_) PTerm
_ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PInferRef FC
_ [FC]
_ Name
_) PTerm
_ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PQuote Raw
_) PTerm
_ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PProof [PTactic]
_) PTerm
_ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PTactics [PTactic]
_) PTerm
_ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PResolveTC FC
_) (PResolveTC FC
_) = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PTrue FC
_ PunInfo
_) (PTrue FC
_ PunInfo
_) = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PPi Plicity
_ Name
_ FC
_ PTerm
t PTerm
s) (PPi Plicity
_ Name
_ FC
_ PTerm
t' PTerm
s') = do [(Name, PTerm)]
mt <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
t PTerm
t'
[(Name, PTerm)]
ms <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
s PTerm
s'
[(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mt [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
ms)
match (PLam FC
_ Name
_ FC
_ PTerm
t PTerm
s) (PLam FC
_ Name
_ FC
_ PTerm
t' PTerm
s') = do [(Name, PTerm)]
mt <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
t PTerm
t'
[(Name, PTerm)]
ms <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
s PTerm
s'
[(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mt [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
ms)
match (PLet FC
_ RigCount
_ Name
_ FC
_ PTerm
t PTerm
ty PTerm
s) (PLet FC
_ RigCount
_ Name
_ FC
_ PTerm
t' PTerm
ty' PTerm
s')
= do [(Name, PTerm)]
mt <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
t PTerm
t'
[(Name, PTerm)]
mty <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
ty PTerm
ty'
[(Name, PTerm)]
ms <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
s PTerm
s'
[(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mt [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mty [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
ms)
match (PHidden PTerm
x) (PHidden PTerm
y)
| RightOK [(Name, PTerm)]
xs <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x PTerm
y = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
xs
| Bool
otherwise = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PHidden PTerm
x) PTerm
y
| RightOK [(Name, PTerm)]
xs <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x PTerm
y = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
xs
| Bool
otherwise = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match PTerm
x (PHidden PTerm
y)
| RightOK [(Name, PTerm)]
xs <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x PTerm
y = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
xs
| Bool
otherwise = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PUnifyLog PTerm
x) PTerm
y = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
x PTerm
y
match PTerm
x (PUnifyLog PTerm
y) = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
x PTerm
y
match (PNoImplicits PTerm
x) PTerm
y = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
x PTerm
y
match PTerm
x (PNoImplicits PTerm
y) = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
x PTerm
y
match PTerm
Placeholder PTerm
_ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match PTerm
_ PTerm
Placeholder = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match (PResolveTC FC
_) PTerm
_ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
match PTerm
a PTerm
b | PTerm
a PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
== PTerm
b = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a. a -> EitherErr (PTerm, PTerm) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = (PTerm, PTerm) -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a b. a -> EitherErr a b
LeftErr (PTerm
a, PTerm
b)
checkRpts :: EitherErr (PTerm, PTerm) [(a, PTerm)]
-> Either (PTerm, PTerm) [(a, PTerm)]
checkRpts (RightOK [(a, PTerm)]
ms) = [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
forall {a}.
Eq a =>
[(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
check [(a, PTerm)]
ms where
check :: [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
check ((a
n,PTerm
t):[(a, PTerm)]
xs)
| Just PTerm
t' <- a -> [(a, PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
n [(a, PTerm)]
xs = if PTerm
tPTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/=PTerm
t' Bool -> Bool -> Bool
&& PTerm
tPTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/=PTerm
Placeholder Bool -> Bool -> Bool
&& PTerm
t'PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/=PTerm
Placeholder
then (PTerm, PTerm) -> Either (PTerm, PTerm) [(a, PTerm)]
forall a b. a -> Either a b
Left (PTerm
t, PTerm
t')
else [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
check [(a, PTerm)]
xs
check ((a, PTerm)
_:[(a, PTerm)]
xs) = [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
check [(a, PTerm)]
xs
check [] = [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
forall a b. b -> Either a b
Right [(a, PTerm)]
ms
checkRpts (LeftErr (PTerm, PTerm)
x) = (PTerm, PTerm) -> Either (PTerm, PTerm) [(a, PTerm)]
forall a b. a -> Either a b
Left (PTerm, PTerm)
x
substMatches :: [(Name, PTerm)] -> PTerm -> PTerm
substMatches :: [(Name, PTerm)] -> PTerm -> PTerm
substMatches [(Name, PTerm)]
ms = [(Name, PTerm)] -> [Name] -> PTerm -> PTerm
substMatchesShadow [(Name, PTerm)]
ms []
substMatch :: Name -> PTerm -> PTerm -> PTerm
substMatch :: Name -> PTerm -> PTerm -> PTerm
substMatch Name
n = Name -> [Name] -> PTerm -> PTerm -> PTerm
substMatchShadow Name
n []
substMatchShadow :: Name -> [Name] -> PTerm -> PTerm -> PTerm
substMatchShadow :: Name -> [Name] -> PTerm -> PTerm -> PTerm
substMatchShadow Name
n [Name]
shs PTerm
tm PTerm
t = [(Name, PTerm)] -> [Name] -> PTerm -> PTerm
substMatchesShadow [(Name
n, PTerm
tm)] [Name]
shs PTerm
t
substMatchesShadow :: [(Name, PTerm)] -> [Name] -> PTerm -> PTerm
substMatchesShadow :: [(Name, PTerm)] -> [Name] -> PTerm -> PTerm
substMatchesShadow [(Name, PTerm)]
nmap [Name]
shs PTerm
t = [Name] -> PTerm -> PTerm
sm [Name]
shs PTerm
t where
sm :: [Name] -> PTerm -> PTerm
sm [Name]
xs (PRef FC
_ [FC]
_ Name
n) | Just PTerm
tm <- Name -> [(Name, PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, PTerm)]
nmap = PTerm
tm
sm [Name]
xs (PLam FC
fc Name
x FC
xfc PTerm
t PTerm
sc) = FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
x FC
xfc ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
t) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
sc)
sm [Name]
xs (PPi Plicity
p Name
x FC
fc PTerm
t PTerm
sc)
| Name
x Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
xs
= let x' :: Name
x' = Name -> Name
nextName Name
x in
Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
x' FC
fc ([Name] -> PTerm -> PTerm
sm (Name
x'Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
xs) (Name -> PTerm -> PTerm -> PTerm
substMatch Name
x (FC -> [FC] -> Name -> PTerm
PRef FC
emptyFC [] Name
x') PTerm
t))
([Name] -> PTerm -> PTerm
sm (Name
x'Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
xs) (Name -> PTerm -> PTerm -> PTerm
substMatch Name
x (FC -> [FC] -> Name -> PTerm
PRef FC
emptyFC [] Name
x') PTerm
sc))
| Bool
otherwise = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
x FC
fc ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
t) ([Name] -> PTerm -> PTerm
sm (Name
x Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
xs) PTerm
sc)
sm [Name]
xs (PLet FC
fc RigCount
rc Name
x FC
xfc PTerm
val PTerm
t PTerm
sc)
= FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
x FC
xfc ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
val) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
t) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
sc)
sm [Name]
xs (PApp FC
f PTerm
x [PArg]
as) = PTerm -> PTerm
fullApp (PTerm -> PTerm) -> PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [PArg] -> PTerm
PApp FC
f ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Name] -> PTerm -> PTerm
sm [Name]
xs)) [PArg]
as)
sm [Name]
xs (PCase FC
f PTerm
x [(PTerm, PTerm)]
as) = FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
f ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) (((PTerm, PTerm) -> (PTerm, PTerm))
-> [(PTerm, PTerm)] -> [(PTerm, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> (PTerm, PTerm) -> (PTerm, PTerm)
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
pmap ([Name] -> PTerm -> PTerm
sm [Name]
xs)) [(PTerm, PTerm)]
as)
sm [Name]
xs (PIfThenElse FC
fc PTerm
c PTerm
t PTerm
f) = FC -> PTerm -> PTerm -> PTerm -> PTerm
PIfThenElse FC
fc ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
c) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
t) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
f)
sm [Name]
xs (PRewrite FC
f Maybe Name
by PTerm
x PTerm
y Maybe PTerm
tm) = FC -> Maybe Name -> PTerm -> PTerm -> Maybe PTerm -> PTerm
PRewrite FC
f Maybe Name
by ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
y)
((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Name] -> PTerm -> PTerm
sm [Name]
xs) Maybe PTerm
tm)
sm [Name]
xs (PTyped PTerm
x PTerm
y) = PTerm -> PTerm -> PTerm
PTyped ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
y)
sm [Name]
xs (PPair FC
f [FC]
hls PunInfo
p PTerm
x PTerm
y) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
f [FC]
hls PunInfo
p ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
y)
sm [Name]
xs (PDPair FC
f [FC]
hls PunInfo
p PTerm
x PTerm
t PTerm
y) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
f [FC]
hls PunInfo
p ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
t) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
y)
sm [Name]
xs (PAlternative [(Name, Name)]
ms PAltType
a [PTerm]
as) = [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ms PAltType
a ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map ([Name] -> PTerm -> PTerm
sm [Name]
xs) [PTerm]
as)
sm [Name]
xs (PHidden PTerm
x) = PTerm -> PTerm
PHidden ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x)
sm [Name]
xs (PUnifyLog PTerm
x) = PTerm -> PTerm
PUnifyLog ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x)
sm [Name]
xs (PNoImplicits PTerm
x) = PTerm -> PTerm
PNoImplicits ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x)
sm [Name]
xs (PRunElab FC
fc PTerm
script [FilePath]
ns) = FC -> PTerm -> [FilePath] -> PTerm
PRunElab FC
fc ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
script) [FilePath]
ns
sm [Name]
xs (PConstSugar FC
fc PTerm
tm) = FC -> PTerm -> PTerm
PConstSugar FC
fc ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
tm)
sm [Name]
xs PTerm
x = PTerm
x
fullApp :: PTerm -> PTerm
fullApp (PApp FC
_ (PApp FC
fc PTerm
f [PArg]
args) [PArg]
xs) = PTerm -> PTerm
fullApp (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f ([PArg]
args [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ [PArg]
xs))
fullApp PTerm
x = PTerm
x
shadow :: Name -> Name -> PTerm -> PTerm
shadow :: Name -> Name -> PTerm -> PTerm
shadow Name
n Name
n' PTerm
t = Integer -> PTerm -> PTerm
forall {t}. (Eq t, Num t) => t -> PTerm -> PTerm
sm Integer
0 PTerm
t where
sm :: t -> PTerm -> PTerm
sm t
0 (PRef FC
fc [FC]
hl Name
x) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
x = FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
n'
sm t
0 (PLam FC
fc Name
x FC
xfc PTerm
t PTerm
sc) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
x = FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
x FC
xfc (t -> PTerm -> PTerm
sm t
0 PTerm
t) (t -> PTerm -> PTerm
sm t
0 PTerm
sc)
| Bool
otherwise = FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
x FC
xfc (t -> PTerm -> PTerm
sm t
0 PTerm
t) PTerm
sc
sm t
0 (PPi Plicity
p Name
x FC
fc PTerm
t PTerm
sc) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
x = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
x FC
fc (t -> PTerm -> PTerm
sm t
0 PTerm
t) (t -> PTerm -> PTerm
sm t
0 PTerm
sc)
| Bool
otherwise = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
x FC
fc (t -> PTerm -> PTerm
sm t
0 PTerm
t) PTerm
sc
sm t
0 (PLet FC
fc RigCount
rc Name
x FC
xfc PTerm
t PTerm
v PTerm
sc) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
x = FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
x FC
xfc (t -> PTerm -> PTerm
sm t
0 PTerm
t) (t -> PTerm -> PTerm
sm t
0 PTerm
v) (t -> PTerm -> PTerm
sm t
0 PTerm
sc)
| Bool
otherwise = FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
x FC
xfc (t -> PTerm -> PTerm
sm t
0 PTerm
t) (t -> PTerm -> PTerm
sm t
0 PTerm
v) PTerm
sc
sm t
0 (PApp FC
f PTerm
x [PArg]
as) = FC -> PTerm -> [PArg] -> PTerm
PApp FC
f (t -> PTerm -> PTerm
sm t
0 PTerm
x) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> PTerm -> PTerm
sm t
0)) [PArg]
as)
sm t
0 (PAppBind FC
f PTerm
x [PArg]
as) = FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
f (t -> PTerm -> PTerm
sm t
0 PTerm
x) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall a b. (a -> b) -> PArg' a -> PArg' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> PTerm -> PTerm
sm t
0)) [PArg]
as)
sm t
0 (PCase FC
f PTerm
x [(PTerm, PTerm)]
as) = FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
f (t -> PTerm -> PTerm
sm t
0 PTerm
x) (((PTerm, PTerm) -> (PTerm, PTerm))
-> [(PTerm, PTerm)] -> [(PTerm, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> (PTerm, PTerm) -> (PTerm, PTerm)
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
pmap (t -> PTerm -> PTerm
sm t
0)) [(PTerm, PTerm)]
as)
sm t
0 (PIfThenElse FC
fc PTerm
c PTerm
t PTerm
f) = FC -> PTerm -> PTerm -> PTerm -> PTerm
PIfThenElse FC
fc (t -> PTerm -> PTerm
sm t
0 PTerm
c) (t -> PTerm -> PTerm
sm t
0 PTerm
t) (t -> PTerm -> PTerm
sm t
0 PTerm
f)
sm t
0 (PRewrite FC
f Maybe Name
by PTerm
x PTerm
y Maybe PTerm
tm) = FC -> Maybe Name -> PTerm -> PTerm -> Maybe PTerm -> PTerm
PRewrite FC
f Maybe Name
by (t -> PTerm -> PTerm
sm t
0 PTerm
x) (t -> PTerm -> PTerm
sm t
0 PTerm
y) ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> PTerm -> PTerm
sm t
0) Maybe PTerm
tm)
sm t
0 (PTyped PTerm
x PTerm
y) = PTerm -> PTerm -> PTerm
PTyped (t -> PTerm -> PTerm
sm t
0 PTerm
x) (t -> PTerm -> PTerm
sm t
0 PTerm
y)
sm t
0 (PPair FC
f [FC]
hls PunInfo
p PTerm
x PTerm
y) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
f [FC]
hls PunInfo
p (t -> PTerm -> PTerm
sm t
0 PTerm
x) (t -> PTerm -> PTerm
sm t
0 PTerm
y)
sm t
0 (PDPair FC
f [FC]
hls PunInfo
p PTerm
x PTerm
t PTerm
y) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
f [FC]
hls PunInfo
p (t -> PTerm -> PTerm
sm t
0 PTerm
x) (t -> PTerm -> PTerm
sm t
0 PTerm
t) (t -> PTerm -> PTerm
sm t
0 PTerm
y)
sm t
0 (PAlternative [(Name, Name)]
ms PAltType
a [PTerm]
as)
= [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative (((Name, Name) -> (Name, Name)) -> [(Name, Name)] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Name) -> (Name, Name)
shadowAlt [(Name, Name)]
ms) PAltType
a ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (t -> PTerm -> PTerm
sm t
0) [PTerm]
as)
sm t
0 (PTactics [PTactic]
ts) = [PTactic] -> PTerm
PTactics ((PTactic -> PTactic) -> [PTactic] -> [PTactic]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PTactic -> PTactic
forall a b. (a -> b) -> PTactic' a -> PTactic' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> PTerm -> PTerm
sm t
0)) [PTactic]
ts)
sm t
0 (PProof [PTactic]
ts) = [PTactic] -> PTerm
PProof ((PTactic -> PTactic) -> [PTactic] -> [PTactic]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PTactic -> PTactic
forall a b. (a -> b) -> PTactic' a -> PTactic' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> PTerm -> PTerm
sm t
0)) [PTactic]
ts)
sm t
0 (PHidden PTerm
x) = PTerm -> PTerm
PHidden (t -> PTerm -> PTerm
sm t
0 PTerm
x)
sm t
0 (PUnifyLog PTerm
x) = PTerm -> PTerm
PUnifyLog (t -> PTerm -> PTerm
sm t
0 PTerm
x)
sm t
0 (PNoImplicits PTerm
x) = PTerm -> PTerm
PNoImplicits (t -> PTerm -> PTerm
sm t
0 PTerm
x)
sm t
0 (PCoerced PTerm
t) = PTerm -> PTerm
PCoerced (t -> PTerm -> PTerm
sm t
0 PTerm
t)
sm t
ql (PQuasiquote PTerm
tm Maybe PTerm
ty) = PTerm -> Maybe PTerm -> PTerm
PQuasiquote (t -> PTerm -> PTerm
sm (t
ql t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) PTerm
tm) ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t -> PTerm -> PTerm
sm t
ql) Maybe PTerm
ty)
sm t
ql (PUnquote PTerm
tm) = PTerm -> PTerm
PUnquote (t -> PTerm -> PTerm
sm (t
ql t -> t -> t
forall a. Num a => a -> a -> a
- t
1) PTerm
tm)
sm t
ql PTerm
x = (PTerm -> PTerm) -> PTerm -> PTerm
forall on. Uniplate on => (on -> on) -> on -> on
descend (t -> PTerm -> PTerm
sm t
ql) PTerm
x
shadowAlt :: (Name, Name) -> (Name, Name)
shadowAlt p :: (Name, Name)
p@(Name
x, Name
oldn) = (Name -> Name
update Name
x, Name -> Name
update Name
oldn)
update :: Name -> Name
update Name
oldn | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
oldn = Name
n'
| Bool
otherwise = Name
oldn
mkUniqueNames :: [Name] -> [(Name, Name)] -> PTerm -> PTerm
mkUniqueNames :: [Name] -> [(Name, Name)] -> PTerm -> PTerm
mkUniqueNames [Name]
env [(Name, Name)]
shadows PTerm
tm
= State (Set Name) PTerm -> Set Name -> PTerm
forall s a. State s a -> s -> a
evalState (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
initMap PTerm
tm) ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList [Name]
env) where
initMap :: Map Name Name
initMap = [(Name, Name)] -> Map Name Name
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, Name)]
shadows
inScope :: S.Set Name
inScope :: Set Name
inScope = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$ PTerm -> [Name]
boundNamesIn PTerm
tm
mkUniqA :: Int -> Map Name Name -> PArg -> StateT (Set Name) Identity PArg
mkUniqA Int
ql Map Name Name
nmap PArg
arg = do PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
ql Map Name Name
nmap (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
arg)
PArg -> StateT (Set Name) Identity PArg
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PArg
arg { getTm = t' })
initN :: Name -> Int -> Name
initN (UN Text
n) Int
l = Text -> Name
UN (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
txt (Text -> FilePath
str Text
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
l)
initN (MN Int
i Text
s) Int
l = Int -> Text -> Name
MN (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) Text
s
initN Name
n Int
_ = Name
n
mkUniqT :: p -> p -> a -> m a
mkUniqT p
_ p
nmap a
tac = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
tac
mkUniq :: Int
-> M.Map Name Name -> PTerm -> State (S.Set Name) PTerm
mkUniq :: Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap (PLam FC
fc Name
n FC
nfc PTerm
ty PTerm
sc)
= do Set Name
env <- StateT (Set Name) Identity (Set Name)
forall s (m :: * -> *). MonadState s m => m s
get
(Name
n', PTerm
sc') <-
if Name
n Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
env
then do let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet (Name -> Int -> Name
initN Name
n (Set Name -> Int
forall a. Set a -> Int
S.size Set Name
env))
(Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
(Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc)
else (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
Set Name -> StateT (Set Name) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
let nmap' :: Map Name Name
nmap' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n' Map Name Name
nmap
PTerm
ty' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
ty
PTerm
sc'' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap' PTerm
sc'
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
n' FC
nfc PTerm
ty' PTerm
sc''
mkUniq Int
0 Map Name Name
nmap (PPi Plicity
p Name
n FC
fc PTerm
ty PTerm
sc)
= do Set Name
env <- StateT (Set Name) Identity (Set Name)
forall s (m :: * -> *). MonadState s m => m s
get
(Name
n', PTerm
sc') <-
if Name
n Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
env
then do let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet (Name -> Int -> Name
initN Name
n (Set Name -> Int
forall a. Set a -> Int
S.size Set Name
env))
(Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
(Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc)
else (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
Set Name -> StateT (Set Name) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
let nmap' :: Map Name Name
nmap' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n' Map Name Name
nmap
PTerm
ty' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
ty
PTerm
sc'' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap' PTerm
sc'
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
n' FC
fc PTerm
ty' PTerm
sc''
mkUniq Int
0 Map Name Name
nmap (PLet FC
fc RigCount
rc Name
n FC
nfc PTerm
ty PTerm
val PTerm
sc)
= do Set Name
env <- StateT (Set Name) Identity (Set Name)
forall s (m :: * -> *). MonadState s m => m s
get
(Name
n', PTerm
sc') <-
if Name
n Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
env
then do let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet (Name -> Int -> Name
initN Name
n (Set Name -> Int
forall a. Set a -> Int
S.size Set Name
env))
(Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
(Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc)
else (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
Set Name -> StateT (Set Name) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
let nmap' :: Map Name Name
nmap' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n' Map Name Name
nmap
PTerm
ty' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
ty; PTerm
val' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
val
PTerm
sc'' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap' PTerm
sc'
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
n' FC
nfc PTerm
ty' PTerm
val' PTerm
sc''
mkUniq Int
0 Map Name Name
nmap (PApp FC
fc PTerm
t [PArg]
args)
= do PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t
[PArg]
args' <- (PArg -> StateT (Set Name) Identity PArg)
-> [PArg] -> StateT (Set Name) Identity [PArg]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Map Name Name -> PArg -> StateT (Set Name) Identity PArg
mkUniqA Int
0 Map Name Name
nmap) [PArg]
args
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
t' [PArg]
args'
mkUniq Int
0 Map Name Name
nmap (PAppBind FC
fc PTerm
t [PArg]
args)
= do PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t
[PArg]
args' <- (PArg -> StateT (Set Name) Identity PArg)
-> [PArg] -> StateT (Set Name) Identity [PArg]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Map Name Name -> PArg -> StateT (Set Name) Identity PArg
mkUniqA Int
0 Map Name Name
nmap) [PArg]
args
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
fc PTerm
t' [PArg]
args'
mkUniq Int
0 Map Name Name
nmap (PCase FC
fc PTerm
t [(PTerm, PTerm)]
alts)
= do PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t
[(PTerm, PTerm)]
alts' <- ((PTerm, PTerm) -> StateT (Set Name) Identity (PTerm, PTerm))
-> [(PTerm, PTerm)] -> StateT (Set Name) Identity [(PTerm, PTerm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(PTerm
x,PTerm
y)-> do PTerm
x' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
x; PTerm
y' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
y
(PTerm, PTerm) -> StateT (Set Name) Identity (PTerm, PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm
x', PTerm
y')) [(PTerm, PTerm)]
alts
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc PTerm
t' [(PTerm, PTerm)]
alts'
mkUniq Int
0 Map Name Name
nmap (PIfThenElse FC
fc PTerm
c PTerm
t PTerm
f)
= (PTerm -> PTerm -> PTerm -> PTerm)
-> State (Set Name) PTerm
-> State (Set Name) PTerm
-> State (Set Name) PTerm
-> State (Set Name) PTerm
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (FC -> PTerm -> PTerm -> PTerm -> PTerm
PIfThenElse FC
fc) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
c) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
f)
mkUniq Int
0 Map Name Name
nmap (PPair FC
fc [FC]
hls PunInfo
p PTerm
l PTerm
r)
= do PTerm
l' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
l; PTerm
r' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
r
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
fc [FC]
hls PunInfo
p PTerm
l' PTerm
r'
mkUniq Int
0 Map Name Name
nmap (PDPair FC
fc [FC]
hls PunInfo
p (PRef FC
fc' [FC]
hls' Name
n) PTerm
t PTerm
sc)
| PTerm
t PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/= PTerm
Placeholder
= do Set Name
env <- StateT (Set Name) Identity (Set Name)
forall s (m :: * -> *). MonadState s m => m s
get
(Name
n', PTerm
sc') <- if Name
n Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
env
then do let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet Name
n (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
(Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc)
else (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
Set Name -> StateT (Set Name) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
let nmap' :: Map Name Name
nmap' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n' Map Name Name
nmap
PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t
PTerm
sc'' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap' PTerm
sc'
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
fc [FC]
hls PunInfo
p (FC -> [FC] -> Name -> PTerm
PRef FC
fc' [FC]
hls' Name
n') PTerm
t' PTerm
sc''
mkUniq Int
0 Map Name Name
nmap (PDPair FC
fc [FC]
hls PunInfo
p PTerm
l PTerm
t PTerm
r)
= do PTerm
l' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
l; PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t; PTerm
r' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
r
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
fc [FC]
hls PunInfo
p PTerm
l' PTerm
t' PTerm
r'
mkUniq Int
0 Map Name Name
nmap (PAlternative [(Name, Name)]
ns PAltType
b [PTerm]
as)
= PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative ([(Name, Name)]
ns [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Map Name Name -> [(Name, Name)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name Name
nmap) PAltType
b [PTerm]
as
mkUniq Int
0 Map Name Name
nmap (PHidden PTerm
t) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PTerm -> PTerm
PHidden (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t)
mkUniq Int
0 Map Name Name
nmap (PUnifyLog PTerm
t) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PTerm -> PTerm
PUnifyLog (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t)
mkUniq Int
0 Map Name Name
nmap (PDisamb [[Text]]
n PTerm
t) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([[Text]] -> PTerm -> PTerm
PDisamb [[Text]]
n) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t)
mkUniq Int
0 Map Name Name
nmap (PNoImplicits PTerm
t) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PTerm -> PTerm
PNoImplicits (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
t)
mkUniq Int
0 Map Name Name
nmap (PProof [PTactic]
ts) = ([PTactic] -> PTerm)
-> StateT (Set Name) Identity [PTactic] -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [PTactic] -> PTerm
PProof ((PTactic -> StateT (Set Name) Identity PTactic)
-> [PTactic] -> StateT (Set Name) Identity [PTactic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Integer
-> Map Name Name -> PTactic -> StateT (Set Name) Identity PTactic
forall {m :: * -> *} {p} {p} {a}. Monad m => p -> p -> a -> m a
mkUniqT Integer
0 Map Name Name
nmap) [PTactic]
ts)
mkUniq Int
0 Map Name Name
nmap (PTactics [PTactic]
ts) = ([PTactic] -> PTerm)
-> StateT (Set Name) Identity [PTactic] -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [PTactic] -> PTerm
PTactics ((PTactic -> StateT (Set Name) Identity PTactic)
-> [PTactic] -> StateT (Set Name) Identity [PTactic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Integer
-> Map Name Name -> PTactic -> StateT (Set Name) Identity PTactic
forall {m :: * -> *} {p} {p} {a}. Monad m => p -> p -> a -> m a
mkUniqT Integer
0 Map Name Name
nmap) [PTactic]
ts)
mkUniq Int
0 Map Name Name
nmap (PRunElab FC
fc PTerm
ts [FilePath]
ns) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\PTerm
tm -> FC -> PTerm -> [FilePath] -> PTerm
PRunElab FC
fc PTerm
tm [FilePath]
ns) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
ts)
mkUniq Int
0 Map Name Name
nmap (PConstSugar FC
fc PTerm
tm) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (FC -> PTerm -> PTerm
PConstSugar FC
fc) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
tm)
mkUniq Int
0 Map Name Name
nmap (PCoerced PTerm
tm) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PTerm -> PTerm
PCoerced (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
0 Map Name Name
nmap PTerm
tm)
mkUniq Int
0 Map Name Name
nmap PTerm
t = PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> PTerm -> PTerm
shadowAll (Map Name Name -> [(Name, Name)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name Name
nmap) PTerm
t
where
shadowAll :: [(Name, Name)] -> PTerm -> PTerm
shadowAll [] PTerm
t = PTerm
t
shadowAll ((Name
n, Name
n') : [(Name, Name)]
ns) PTerm
t = Name -> Name -> PTerm -> PTerm
shadow Name
n Name
n' ([(Name, Name)] -> PTerm -> PTerm
shadowAll [(Name, Name)]
ns PTerm
t)
mkUniq Int
ql Map Name Name
nmap (PQuasiquote PTerm
tm Maybe PTerm
ty) =
do PTerm
tm' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq (Int
ql Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Map Name Name
nmap PTerm
tm
Maybe PTerm
ty' <- case Maybe PTerm
ty of
Maybe PTerm
Nothing -> Maybe PTerm -> StateT (Set Name) Identity (Maybe PTerm)
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PTerm
forall a. Maybe a
Nothing
Just PTerm
t -> (PTerm -> Maybe PTerm)
-> State (Set Name) PTerm
-> StateT (Set Name) Identity (Maybe PTerm)
forall a b.
(a -> b)
-> StateT (Set Name) Identity a -> StateT (Set Name) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PTerm -> Maybe PTerm
forall a. a -> Maybe a
Just (State (Set Name) PTerm
-> StateT (Set Name) Identity (Maybe PTerm))
-> State (Set Name) PTerm
-> StateT (Set Name) Identity (Maybe PTerm)
forall a b. (a -> b) -> a -> b
$ Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
ql Map Name Name
nmap PTerm
t
PTerm -> State (Set Name) PTerm
forall a. a -> StateT (Set Name) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! PTerm -> Maybe PTerm -> PTerm
PQuasiquote PTerm
tm' Maybe PTerm
ty'
mkUniq Int
ql Map Name Name
nmap (PUnquote PTerm
tm) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall a b.
(a -> b)
-> StateT (Set Name) Identity a -> StateT (Set Name) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PTerm -> PTerm
PUnquote (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq (Int
ql Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Map Name Name
nmap PTerm
tm)
mkUniq Int
ql Map Name Name
nmap PTerm
tm = (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall on (m :: * -> *).
(Uniplate on, Applicative m) =>
(on -> m on) -> on -> m on
forall (m :: * -> *).
Applicative m =>
(PTerm -> m PTerm) -> PTerm -> m PTerm
descendM (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
ql Map Name Name
nmap) PTerm
tm