{-|
Module      : Idris.AbsSyntax
Description : Provides Idris' core data definitions and utility code.

License     : BSD3
Maintainer  : The Idris Community.
-}

{-# 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.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; 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 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; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_objs :: [(Codegen, FilePath)]
idris_objs = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, FilePath)]
idris_objs IState
i forall a. [a] -> [a] -> [a]
++ [(Codegen
tgt, FilePath
f)] }

getLibs :: Codegen -> Idris [String]
getLibs :: Codegen -> Idris [FilePath]
getLibs Codegen
tgt = do IState
i <- Idris IState
getIState; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_libs :: [(Codegen, FilePath)]
idris_libs = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, FilePath)]
idris_libs IState
i forall a. [a] -> [a] -> [a]
++ [(Codegen
tgt, FilePath
f)] }

getFlags :: Codegen -> Idris [String]
getFlags :: Codegen -> Idris [FilePath]
getFlags Codegen
tgt = do IState
i <- Idris IState
getIState; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_cgflags :: [(Codegen, FilePath)]
idris_cgflags = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, FilePath)]
idris_cgflags IState
i forall a. [a] -> [a] -> [a]
++ [(Codegen
tgt, FilePath
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 forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([DynamicLib] -> FilePath -> Maybe DynamicLib
findDyLib [DynamicLib]
ls) [FilePath]
libs of
                     DynamicLib
x:[DynamicLib]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left DynamicLib
x)
                     [] -> do
                       [Maybe DynamicLib]
handle <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
l -> forall a. IO a -> (IOError -> IO a) -> IO a
catchIO ([FilePath] -> FilePath -> IO (Maybe DynamicLib)
tryLoadLib [FilePath]
importdirs FilePath
l)
                                                     (\IOError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)) forall a b. (a -> b) -> a -> b
$ [FilePath]
libs
                       case forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Maybe DynamicLib]
handle of
                         Maybe DynamicLib
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FilePath
"Could not load dynamic alternatives \"" forall a. [a] -> [a] -> [a]
++
                                                    forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," [FilePath]
libs forall a. [a] -> [a] -> [a]
++ FilePath
"\"")
                         Just DynamicLib
x -> do IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_dynamic_libs :: [DynamicLib]
idris_dynamic_libs = DynamicLib
xforall a. a -> [a] -> [a]
:[DynamicLib]
ls }
                                      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left DynamicLib
x)
    where findDyLib :: [DynamicLib] -> String -> Maybe DynamicLib
          findDyLib :: [DynamicLib] -> FilePath -> Maybe DynamicLib
findDyLib []         FilePath
_                     = forall a. Maybe a
Nothing
          findDyLib (DynamicLib
lib:[DynamicLib]
libs') FilePath
l | FilePath
l forall a. Eq a => a -> a -> Bool
== DynamicLib -> FilePath
lib_name DynamicLib
lib = 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
                    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
                      forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_options :: IOption
idris_options = IOption
opts { opt_autoImport :: [FilePath]
opt_autoImport =
                                                       FilePath
fp forall a. a -> [a] -> [a]
: IOption -> [FilePath]
opt_autoImport IOption
opts } } )

addDefinedName :: Name -> Idris ()
addDefinedName :: Name -> Idris ()
addDefinedName Name
n = do IState
ist <- Idris IState
getIState
                      IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
ist { idris_inmodule :: Set Name
idris_inmodule = forall a. Ord a => a -> Set a -> Set a
S.insert Name
n (IState -> Set Name
idris_inmodule IState
ist) }

getDefinedNames :: Idris [Name]
getDefinedNames :: Idris [Name]
getDefinedNames = do IState
ist <- Idris IState
getIState
                     forall (m :: * -> *) a. Monad m => a -> m a
return (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 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' = 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 forall a b. (a -> b) -> a -> b
$ IState
ist { idris_ttstats :: Map Term (Int, Term)
idris_ttstats = Map Term (Int, Term)
tt' }
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                  Just (Int
i, Term
t') -> do let tt' :: Map Term (Int, Term)
tt' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Term
t' (Int
i forall a. Num a => a -> a -> a
+ Int
1, Term
t') (IState -> Map Term (Int, Term)
idris_ttstats IState
ist)
                                     IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
ist { idris_ttstats :: Map Term (Int, Term)
idris_ttstats = Map Term (Int, Term)
tt' }
                                     forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Term
t')

dumpTT :: Idris ()
dumpTT :: Idris ()
dumpTT = do IState
ist <- forall s (m :: * -> *). MonadState s m => m s
get
            let sts :: [(Term, (Int, Term))]
sts = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
count (forall k a. Map k a -> [(k, a)]
M.toList (IState -> Map Term (Int, Term)
idris_ttstats IState
ist))
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a} {a}. (Show a, Show a) => (a, a) -> Idris ()
dump [(Term, (Int, Term))]
sts
            forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    count :: (a, a) -> (a, a) -> Ordering
count (a
_,a
x) (a
_,a
y) = forall a. Ord a => a -> a -> Ordering
compare a
y a
x
    dump :: (a, a) -> Idris ()
dump (a
tm, a
val) = forall a. IO a -> Idris a
runIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (forall a. Show a => a -> FilePath
show a
val forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_hdrs :: [(Codegen, FilePath)]
idris_hdrs = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ (Codegen
tgt, FilePath
f) forall a. a -> [a] -> [a]
: IState -> [(Codegen, FilePath)]
idris_hdrs IState
i }

addImported :: Bool -> FilePath -> Idris ()
addImported :: Bool -> FilePath -> Idris ()
addImported Bool
pub FilePath
f
     = do IState
i <- Idris IState
getIState
          IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_imported :: [(FilePath, Bool)]
idris_imported = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ (FilePath
f, Bool
pub) forall a. a -> [a] -> [a]
: IState -> [(FilePath, Bool)]
idris_imported IState
i }

addLangExt :: LanguageExt -> Idris ()
addLangExt :: LanguageExt -> Idris ()
addLangExt LanguageExt
e = do IState
i <- Idris IState
getIState
                  IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i {
                    idris_language_extensions :: [LanguageExt]
idris_language_extensions = LanguageExt
e forall a. a -> [a] -> [a]
: IState -> [LanguageExt]
idris_language_extensions IState
i
                  }

dropLangExt :: LanguageExt -> Idris ()
dropLangExt :: LanguageExt -> Idris ()
dropLangExt LanguageExt
e = do IState
i <- Idris IState
getIState
                   IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i {
                     idris_language_extensions :: [LanguageExt]
idris_language_extensions = IState -> [LanguageExt]
idris_language_extensions IState
i forall a. Eq a => [a] -> [a] -> [a]
\\ [LanguageExt
e]
                   }

-- | Transforms are organised by the function being applied on the lhs
-- of the transform, to make looking up appropriate transforms quicker
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 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 forall a. a -> [a] -> [a]
: [(Term, Term)]
def)
                              Maybe [(Term, Term)]
Nothing -> [(Term, Term)
t]
                IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_transforms :: Ctxt [(Term, Term)]
idris_transforms = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
basefn [(Term, Term)]
t'
                                                          (IState -> Ctxt [(Term, Term)]
idris_transforms IState
i) }

-- | Add transformation rules from a definition, which will reverse the
-- definition for an error to make it more readable
addErrRev :: (Term, Term) -> Idris ()
addErrRev :: (Term, Term) -> Idris ()
addErrRev (Term, Term)
t = do IState
i <- Idris IState
getIState
                 IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_errRev :: [(Term, Term)]
idris_errRev = (Term, Term)
t forall a. a -> [a] -> [a]
: IState -> [(Term, Term)]
idris_errRev IState
i }

-- | Say that the name should always be reduced in error messages, to
-- help readability/error reflection
addErrReduce :: Name -> Idris ()
addErrReduce :: Name -> Idris ()
addErrReduce Name
t = do IState
i <- Idris IState
getIState
                    IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_errReduce :: [Name]
idris_errReduce = Name
t forall a. a -> [a] -> [a]
: IState -> [Name]
idris_errReduce IState
i }

addErasureUsage :: Name -> Int -> Idris ()
addErasureUsage :: Name -> Int -> Idris ()
addErasureUsage Name
n Int
i = do IState
ist <- Idris IState
getIState
                         IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
ist { idris_erasureUsed :: [(Name, Int)]
idris_erasureUsed = (Name
n, Int
i) forall a. a -> [a] -> [a]
: IState -> [(Name, Int)]
idris_erasureUsed IState
ist }

addExport :: Name -> Idris ()
addExport :: Name -> Idris ()
addExport Name
n = do IState
ist <- Idris IState
getIState
                 IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
ist { idris_exports :: [Name]
idris_exports = Name
n forall a. a -> [a] -> [a]
: IState -> [Name]
idris_exports IState
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
              [] -> forall a. Err -> Idris a
throwError (forall t. FC -> Err' t -> Err' t
At FC
fc (forall t. Name -> Err' t
NoSuchVariable Name
n))
              [(Name, Term)]
xs -> forall a. Err -> Idris a
throwError (forall t. FC -> Err' t -> Err' t
At FC
fc (forall t. [Name] -> Err' t
CantResolveAlts (forall a b. (a -> b) -> [a] -> [b]
map 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 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 forall a. Num a => a -> a -> a
+ Int
1) Term
sc
        addUsage Name
_ Int
_ Term
_ = forall a. Err -> Idris a
throwError (forall t. FC -> Err' t -> Err' t
At FC
fc (forall t. FilePath -> Err' t
Msg (FilePath
"No such argument name " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Name
arg)))

getErasureUsage :: Idris [(Name, Int)]
getErasureUsage :: Idris [(Name, Int)]
getErasureUsage = do IState
ist <- Idris IState
getIState;
                     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
                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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_totcheck :: [(FC, Name)]
idris_totcheck = IState -> [(FC, Name)]
idris_totcheck IState
i forall a. [a] -> [a] -> [a]
++ [(FC, Name)
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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_defertotcheck :: [(FC, Name)]
idris_defertotcheck = forall a. Eq a => [a] -> [a]
nub (IState -> [(FC, Name)]
idris_defertotcheck IState
i forall a. [a] -> [a] -> [a]
++ [(FC, Name)
n]) }

clear_totcheck :: Idris ()
clear_totcheck :: Idris ()
clear_totcheck  = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_totcheck :: [(FC, Name)]
idris_totcheck = [] }

setFlags :: Name -> [FnOpt] -> Idris ()
setFlags :: Name -> [FnOpt] -> Idris ()
setFlags Name
n [FnOpt]
fs = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_flags :: Ctxt [FnOpt]
idris_flags = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n [FnOpt]
fs (IState -> Ctxt [FnOpt]
idris_flags IState
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 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 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_fninfo :: Ctxt FnInfo
idris_fninfo = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n FnInfo
fs (IState -> Ctxt FnInfo
idris_fninfo IState
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 forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt :: Context
tt_ctxt = Context
ctxt }

-- | get the accessibility of a name outside this module
getFromHideList :: Name -> Idris (Maybe Accessibility)
getFromHideList :: Name -> Idris (Maybe Accessibility)
getFromHideList Name
n = do IState
i <- Idris IState
getIState
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt :: Context
tt_ctxt = Context
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 forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt :: Context
tt_ctxt = Context
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] -> forall (m :: * -> *) a. Monad m => a -> m a
return Totality
t
                [Totality]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Totality
Total [])

-- Get coercions which might return the required type
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]
_) = forall n. TT n -> (TT n, [TT n])
unApply (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 forall n. TT n -> (TT n, [TT n])
unApply (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 forall a. Eq a => a -> a -> Bool
== Term
t']
                        [Term]
_ -> [] in
                 [Name]
ps 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_callgraph :: Ctxt CGInfo
idris_callgraph = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n CGInfo
cg (IState -> Ctxt CGInfo
idris_callgraph IState
i) }

addCalls :: Name -> [Name] -> Idris ()
addCalls :: Name -> [Name] -> Idris ()
addCalls Name
n [Name]
calls
   = do IState
i <- Idris IState
getIState
        case 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 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 (forall a. Eq a => [a] -> [a]
nub ([Name]
calls 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_tyinfodata :: Ctxt TIData
idris_tyinfodata =
                        forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n TIData
TIPartial (IState -> Ctxt TIData
idris_tyinfodata IState
i) }

addTyInfConstraints :: FC -> [(Term, Term)] -> Idris ()
addTyInfConstraints :: FC -> [(Term, Term)] -> Idris ()
addTyInfConstraints FC
fc [(Term, Term)]
ts = do Int -> FilePath -> Idris ()
logLvl Int
2 forall a b. (a -> b) -> a -> b
$ FilePath
"TI missing: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [(Term, Term)]
ts
                               forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term, Term) -> Idris ()
addConstraint [(Term, Term)]
ts
                               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) = forall n. TT n -> (TT n, [TT n])
unApply Term
x
                  let (Term
fy, [Term]
argsy) = forall n. TT n -> (TT n, [TT n])
unApply Term
y
                  if (Term
fx 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 forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term, Term) -> Idris ()
addConstraint (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 <- forall s (m :: * -> *). MonadState s m => m s
get
                  case 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)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          tryAddMV Term
_ Term
_ = 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 <- forall s (m :: * -> *). MonadState s m => m s
get
                  Int -> FilePath -> Idris ()
logLvl Int
1 forall a b. (a -> b) -> a -> b
$ FilePath
"TI constraint: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (Name
n, Term
t)
                  case forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt TIData
idris_tyinfodata IState
ist) of
                     [TISolution [Term]
ts] ->
                         do 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' = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n ([Term] -> TIData
TISolution (Term
t forall a. a -> [a] -> [a]
: [Term]
ts))
                                               (IState -> Ctxt TIData
idris_tyinfodata IState
ist)
                            forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ IState
ist { idris_tyinfodata :: Ctxt TIData
idris_tyinfodata = Ctxt TIData
ti' }
                     [TIData]
_ ->
                         do let ti' :: Ctxt TIData
ti' = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n ([Term] -> TIData
TISolution [Term
t])
                                               (IState -> Ctxt TIData
idris_tyinfodata IState
ist)
                            forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ IState
ist { idris_tyinfodata :: Ctxt TIData
idris_tyinfodata = Ctxt TIData
ti' }

          -- Check a solution is consistent with previous solutions
          -- Meaning: If heads are both data types, they had better be the
          -- same.
          checkConsistent :: Term -> Term -> Idris ()
          checkConsistent :: Term -> Term -> Idris ()
checkConsistent Term
x Term
y =
              do let (Term
fx, [Term]
_) = forall n. TT n -> (TT n, [TT n])
unApply Term
x
                 let (Term
fy, [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
nforall 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
nforall a. Eq a => a -> a -> Bool
/=Name
n')
                      (Term, Term)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

              where errWhen :: Bool -> Idris ()
errWhen Bool
True
                       = forall a. Err -> Idris a
throwError (forall t. FC -> Err' t -> Err' t
At FC
fc
                            (forall t.
Bool
-> (t, Maybe Provenance)
-> (t, Maybe Provenance)
-> Err' t
-> [(Name, t)]
-> Int
-> Err' t
CantUnify Bool
False (Term
x, forall a. Maybe a
Nothing) (Term
y, forall a. Maybe a
Nothing) (forall t. FilePath -> Err' t
Msg FilePath
"") [] Int
0))
                    errWhen Bool
False = 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 forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt TIData
idris_tyinfodata IState
i) of
             [TIData
TIPartial] -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
             [TIData]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Adds error handlers for a particular function and argument. If
-- names are ambiguous, all matching handlers are updated.
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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
f) Ctxt (Map Name (Set Name))
oldHandlers forall a b. (a -> b) -> a -> b
$
                      case forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
f Ctxt (Map Name (Set Name))
oldHandlers of
                        Maybe (Map Name (Set Name))
Nothing            -> forall k a. k -> a -> Map k a
M.singleton Name
arg (forall a. Ord a => [a] -> Set a
S.fromList [Name]
hs)
                        Just (Map Name (Set Name)
oldHandlers) -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Ord a => Set a -> Set a -> Set a
S.union Name
arg (forall a. Ord a => [a] -> Set a
S.fromList [Name]
hs) Map Name (Set Name)
oldHandlers
                        -- will always be one of those two, thus no extra case
    IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_function_errorhandlers :: Ctxt (Map Name (Set Name))
idris_function_errorhandlers = Ctxt (Map Name (Set Name))
newHandlers }

-- | Trace all the names in a call graph starting at the given name
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 -> 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
                                      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 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
_ -> forall a. Maybe a
Nothing

addCGAllNames :: IState -> Name -> [Name] -> Idris ()
addCGAllNames :: IState -> Name -> [Name] -> Idris ()
addCGAllNames IState
i Name
n [Name]
ns
      = case 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 :: Maybe [Name]
allCalls = forall a. a -> Maybe a
Just [Name]
ns })
             Maybe CGInfo
_ -> Name -> CGInfo -> Idris ()
addToCG Name
n ([Name]
-> Maybe [Name] -> [SCGEntry] -> [(Int, [(Name, Int)])] -> CGInfo
CGInfo [] (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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns
                        Maybe [Name]
Nothing -> case forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt CGInfo
idris_callgraph IState
i) of
                                        Just CGInfo
ci ->
                                          do [[Name]]
more <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Name] -> Name -> Idris [Name]
allNames (Name
nforall a. a -> [a] -> [a]
:[Name]
ns)) (CGInfo -> [Name]
calls CGInfo
ci)
                                             let ns' :: [Name]
ns' = forall a. Eq a => [a] -> [a]
nub (Name
n forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
more)
                                             IState -> Name -> [Name] -> Idris ()
addCGAllNames IState
i Name
n [Name]
ns'
                                             forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns'
                                        Maybe CGInfo
_ -> 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_coercions :: [Name]
idris_coercions = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ Name
n forall a. a -> [a] -> [a]
: IState -> [Name]
idris_coercions IState
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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_docstrings :: Ctxt (Docstring DocTerm, [(Name, Docstring DocTerm)])
idris_docstrings = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n (Docstring DocTerm
doc, [(Name, Docstring DocTerm)]
args) (IState -> Ctxt (Docstring DocTerm, [(Name, Docstring DocTerm)])
idris_docstrings IState
i) }

addNameHint :: Name -> Name -> Idris ()
addNameHint :: Name -> Name -> Idris ()
addNameHint Name
ty Name
n
   = do IState
i <- Idris IState
getIState
        Name
ty' <- case forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
ty (IState -> Ctxt [PArg]
idris_implicits IState
i) of
                       [(Name
tyn, [PArg]
_)] -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
tyn
                       [] -> forall a. Err -> Idris a
throwError (forall t. Name -> Err' t
NoSuchVariable Name
ty)
                       [(Name, [PArg])]
tyns -> forall a. Err -> Idris a
throwError (forall t. [Name] -> Err' t
CantResolveAlts (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, [PArg])]
tyns))
        let ns' :: [Name]
ns' = case forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
ty' (IState -> Ctxt [Name]
idris_namehints IState
i) of
                       [[Name]
ns] -> [Name]
ns forall a. [a] -> [a] -> [a]
++ [Name
n]
                       [[Name]]
_ -> [Name
n]
        IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_namehints :: Ctxt [Name]
idris_namehints = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
ty' [Name]
ns' (IState -> Ctxt [Name]
idris_namehints IState
i) }

getNameHints :: IState -> Name -> [Name]
getNameHints :: IState -> Name -> [Name]
getNameHints IState
_ (UN Text
arr) | Text
arr 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 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_deprecated :: Ctxt FilePath
idris_deprecated = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n FilePath
reason (IState -> Ctxt FilePath
idris_deprecated IState
i) }

getDeprecated :: Name -> Idris (Maybe String)
getDeprecated :: Name -> Idris (Maybe FilePath)
getDeprecated Name
n = do
  IState
i <- Idris IState
getIState
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_fragile :: Ctxt FilePath
idris_fragile = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n FilePath
reason (IState -> Ctxt FilePath
idris_fragile IState
i) }

getFragile :: Name -> Idris (Maybe String)
getFragile :: Name -> Idris (Maybe FilePath)
getFragile Name
n = do
  IState
i <- Idris IState
getIState
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: [(Name, Bool)]
elab_stack = (Name
n, Bool
implementation) forall a. a -> [a] -> [a]
: IState -> [(Name, Bool)]
elab_stack IState
i })

pop_estack :: Idris ()
pop_estack :: Idris ()
pop_estack = do IState
i <- Idris IState
getIState
                IState -> Idris ()
putIState (IState
i { elab_stack :: [(Name, Bool)]
elab_stack = forall {a}. [a] -> [a]
ptail (IState -> [(Name, Bool)]
elab_stack IState
i) })
    where ptail :: [a] -> [a]
ptail [] = []
          ptail (a
_ : [a]
xs) = [a]
xs

-- | Add an interface implementation function.
--
-- Precondition: the implementation should have the correct type.
--
-- Dodgy hack 1: Put integer implementations first in the list so they are
-- resolved by default.
--
-- Dodgy hack 2: put constraint chasers (ParentN) last
addImplementation :: Bool -- ^ whether the name is an Integer implementation
                  -> Bool -- ^ whether to include the implementation in implementation search
                  -> Name -- ^ the name of the interface
                  -> Name -- ^ the name of the implementation
                  -> Idris ()
addImplementation :: Bool -> Bool -> Name -> Name -> Idris ()
addImplementation Bool
int Bool
res Name
n Name
i
    = do IState
ist <- Idris IState
getIState
         case 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 = 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 forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces :: Ctxt InterfaceInfo
idris_interfaces = Ctxt InterfaceInfo
cs }
                [InterfaceInfo]
_ -> do let cs :: Ctxt InterfaceInfo
cs = 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 forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces :: Ctxt InterfaceInfo
idris_interfaces = Ctxt InterfaceInfo
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) forall a. a -> [a] -> [a]
: [(Name, Bool)]
ins
                   | Name -> Bool
chaser Name
n = [(Name, Bool)]
ins 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 (forall a b. (a, b) -> a
fst (Name, Bool)
n) = (Name
i, Bool
res) forall a. a -> [a] -> [a]
: (Name, Bool)
n forall a. a -> [a] -> [a]
: [(Name, Bool)]
ns
                        | Bool
otherwise = (Name, Bool)
n 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

-- | Add a privileged implementation - one which implementation search will
-- happily resolve immediately if it is type correct This is used for
-- naming parent implementations when defining an implementation with
-- constraints.  Returns the old list, so we can revert easily at the
-- end of a block
addOpenImpl :: [Name] -> Idris [Name]
addOpenImpl :: [Name] -> Idris [Name]
addOpenImpl [Name]
ns = do IState
ist <- Idris IState
getIState
                    [Name]
ns' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 forall a b. (a -> b) -> a -> b
$ IState
ist { idris_openimpls :: [Name]
idris_openimpls = forall a. Eq a => [a] -> [a]
nub ([Name]
ns' forall a. [a] -> [a] -> [a]
++ [Name]
open) }
                    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 forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
n (IState -> Ctxt [PArg]
idris_implicits IState
ist) of
             [(Name
n', [PArg]
_)] -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
n'
             []        -> forall a. Err -> Idris a
throwError (forall t. Name -> Err' t
NoSuchVariable Name
n)
             [(Name, [PArg])]
more      -> forall a. Err -> Idris a
throwError (forall t. [Name] -> Err' t
CantResolveAlts (forall a b. (a -> b) -> [a] -> [b]
map 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 forall a b. (a -> b) -> a -> b
$ IState
ist { idris_openimpls :: [Name]
idris_openimpls = [Name]
ns }

getOpenImpl :: Idris [Name]
getOpenImpl :: Idris [Name]
getOpenImpl = do IState
ist <- Idris IState
getIState
                 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 forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist) of
                      [InterfaceInfo
c] -> InterfaceInfo
i { interface_implementations :: [(Name, Bool)]
interface_implementations = InterfaceInfo -> [(Name, Bool)]
interface_implementations InterfaceInfo
c forall a. [a] -> [a] -> [a]
++
                                                             InterfaceInfo -> [(Name, Bool)]
interface_implementations InterfaceInfo
i }
                      [InterfaceInfo]
_ -> InterfaceInfo
i
        IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces :: Ctxt InterfaceInfo
idris_interfaces = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n InterfaceInfo
i' (IState -> Ctxt InterfaceInfo
idris_interfaces IState
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 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 :: [(Name, (Bool, [FnOpt], PTerm))]
interface_methods = forall {a} {b}. [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
update (InterfaceInfo -> [(Name, (Bool, [FnOpt], PTerm))]
interface_methods InterfaceInfo
c) }
                     Maybe InterfaceInfo
Nothing -> forall a. HasCallStack => FilePath -> a
error FilePath
"Can't happen updateIMethods"
        IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces :: Ctxt InterfaceInfo
idris_interfaces = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n InterfaceInfo
i (IState -> Ctxt InterfaceInfo
idris_interfaces IState
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 <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, PTerm)]
meths
             = (Name
n, (a
b, b
opts, PTerm
ty)) 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 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 forall a b. (a -> b) -> a -> b
$ IState
ist { idris_records :: Ctxt RecordInfo
idris_records = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n RecordInfo
ri (IState -> Ctxt RecordInfo
idris_records IState
ist) }

addAutoHint :: Name -> Name -> Idris ()
addAutoHint :: Name -> Name -> Idris ()
addAutoHint Name
n Name
hint =
    do IState
ist <- Idris IState
getIState
       case 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 = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n [Name
hint] (IState -> Ctxt [Name]
idris_autohints IState
ist)
                    IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
ist { idris_autohints :: Ctxt [Name]
idris_autohints = Ctxt [Name]
hs }
            Just [Name]
nhints ->
                 do let hs :: Ctxt [Name]
hs = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n (Name
hint forall a. a -> [a] -> [a]
: [Name]
nhints) (IState -> Ctxt [Name]
idris_autohints IState
ist)
                    IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
ist { idris_autohints :: Ctxt [Name]
idris_autohints = Ctxt [Name]
hs }

getAutoHints :: Name -> Idris [Name]
getAutoHints :: Name -> Idris [Name]
getAutoHints Name
n = do IState
ist <- Idris IState
getIState
                    case forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt [Name]
idris_autohints IState
ist) of
                         Maybe [Name]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
                         Just [Name]
ns -> 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
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([IBCWrite] -> Bool
notDef (IState -> [IBCWrite]
ibc_write IState
i)) forall a b. (a -> b) -> a -> b
$
                  IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { ibc_write :: [IBCWrite]
ibc_write = IBCWrite
ibc forall a. a -> [a] -> [a]
: IState -> [IBCWrite]
ibc_write IState
i }
   where notDef :: [IBCWrite] -> Bool
notDef [] = Bool
True
         notDef (IBCDef Name
n': [IBCWrite]
_) | Name
n 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 forall a b. (a -> b) -> a -> b
$ IState
i { ibc_write :: [IBCWrite]
ibc_write = IBCWrite
ibc forall a. a -> [a] -> [a]
: IState -> [IBCWrite]
ibc_write IState
i }

clearIBC :: Idris ()
clearIBC :: Idris ()
clearIBC = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { ibc_write :: [IBCWrite]
ibc_write = [],
                                              idris_inmodule :: Set Name
idris_inmodule = forall a. Set a
S.empty }

resetNameIdx :: Idris ()
resetNameIdx :: Idris ()
resetNameIdx = do IState
i <- Idris IState
getIState
                  forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_nameIdx :: (Int, Ctxt (Int, Name))
idris_nameIdx = (Int
0, forall {k} {a}. Map k a
emptyContext) })

-- | Used to preserve sharing of names
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'
                  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 :: Ctxt (Int, Name)
idxs = forall a b. (a, b) -> b
snd (IState -> (Int, Ctxt (Int, Name))
idris_nameIdx IState
i) in
         case forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n Ctxt (Int, Name)
idxs of
            [(Int, Name)
x] -> (IState
i, (Int, Name)
x)
            [(Int, Name)]
_ -> let i' :: Int
i' = forall a b. (a, b) -> a
fst (IState -> (Int, Ctxt (Int, Name))
idris_nameIdx IState
i) forall a. Num a => a -> a -> a
+ Int
1 in
                    (IState
i { idris_nameIdx :: (Int, Ctxt (Int, Name))
idris_nameIdx = (Int
i', forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n (Int
i', Name
n) Ctxt (Int, Name)
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 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' -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
n'
                      Maybe Name
Nothing -> do let sym' :: Map Name Name
sym' = 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)
                                    forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_symbols :: Map Name Name
idris_symbols = Map Name Name
sym' })
                                    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; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt 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 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 forall a b. (a -> b) -> a -> b
$ IState
i { errSpan :: Maybe FC
errSpan = forall a. a -> Maybe a
Just FC
x }
                      Just FC
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

clearErr :: Idris ()
clearErr :: Idris ()
clearErr = do IState
i <- Idris IState
getIState
              IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { errSpan :: Maybe FC
errSpan = forall a. Maybe a
Nothing }

getSO :: Idris (Maybe String)
getSO :: Idris (Maybe FilePath)
getSO = do IState
i <- Idris IState
getIState
           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 :: Maybe FilePath
compiled_so = Maybe FilePath
s })

getIState :: Idris IState
getIState :: Idris IState
getIState = forall s (m :: * -> *). MonadState s m => m s
get

putIState :: IState -> Idris ()
putIState :: IState -> Idris ()
putIState = 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 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 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]
_   -> 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 = forall a b.
(IState -> Ctxt a) -> Name -> b -> (a -> Idris b) -> Idris b
withContext IState -> Ctxt a
ctx Name
name () a -> Idris ()
action

-- | A version of liftIO that puts errors into the exception type of
-- the Idris monad
runIO :: IO a -> Idris a
runIO :: forall a. IO a -> Idris a
runIO IO a
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IO a -> IO (Either IOError a)
tryIOError IO a
x) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Err -> Idris a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FilePath -> Err' t
Msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) forall (m :: * -> *) a. Monad m => a -> m a
return
-- TODO: create specific Idris exceptions for specific IO errors such as "openFile: does not exist"
--
-- Issue #1738 on the issue tracker.
--     https://github.com/idris-lang/Idris-dev/issues/1738

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 :: Int
idris_name = Int
idx forall a. Num a => a -> a -> a
+ Int
1 })
             forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx

-- | InternalApp keeps track of the real function application for
-- making case splits from, not the application the programmer wrote,
-- which doesn't have the whole context in any case other than top
-- level definitions
addInternalApp :: FilePath -> Int -> PTerm -> Idris ()
addInternalApp :: FilePath -> Int -> PTerm -> Idris ()
addInternalApp FilePath
fp Int
l PTerm
t
    = do IState
i <- Idris IState
getIState
         -- We canonicalise the path to make "./Test/Module.idr" equal
         -- to "Test/Module.idr"
         Bool
exists <- forall a. IO a -> Idris a
runIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fp
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$
           do FilePath
fp' <- forall a. IO a -> Idris a
runIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
fp
              IState -> Idris ()
putIState (IState
i { idris_lineapps :: [((FilePath, Int), PTerm)]
idris_lineapps = ((FilePath
fp', Int
l), PTerm
t) forall a. a -> [a] -> [a]
: IState -> [((FilePath, Int), PTerm)]
idris_lineapps IState
i })

getInternalApp :: FilePath -> Int -> Idris PTerm
getInternalApp :: FilePath -> Int -> Idris PTerm
getInternalApp FilePath
fp Int
l = do IState
i <- Idris IState
getIState
                         -- We canonicalise the path to make
                         -- "./Test/Module.idr" equal to
                         -- "Test/Module.idr"
                         Bool
exists <- forall a. IO a -> Idris a
runIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fp
                         if Bool
exists
                           then do FilePath
fp' <- forall a. IO a -> Idris a
runIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
fp
                                   case 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' -> forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
n'
                                     Maybe PTerm
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
Placeholder
                                     -- TODO: What if it's not there?
                           else forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
Placeholder

-- | Pattern definitions are only used for coverage checking, so erase
-- them when we're done
clearOrigPats :: Idris ()
clearOrigPats :: Idris ()
clearOrigPats = do IState
i <- 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' = 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
                   forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_patdefs :: Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
idris_patdefs = forall {a}. Ctxt ([a], [PTerm])
ps' })

-- | Erase types from Ps in the context (basically ending up with
-- what's in the .ibc, which is all we need after all the analysis is
-- done)
clearPTypes :: Idris ()
clearPTypes :: Idris ()
clearPTypes = do IState
i <- forall s (m :: * -> *). MonadState s m => m s
get
                 let ctxt :: Context
ctxt = IState -> Context
tt_ctxt IState
i
                 forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { tt_ctxt :: Context
tt_ctxt = (Def -> Def) -> Context -> Context
mapDefCtxt Def -> Def
pErase Context
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, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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]
_)  -> forall a. Err -> Idris a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FilePath -> Err' t
Msg forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show FC
fc forall a. [a] -> [a] -> [a]
++ FilePath
":" forall a. [a] -> [a] -> [a]
++
                                          forall a. Show a => a -> FilePath
show Name
n forall a. [a] -> [a] -> [a]
++ FilePath
" already defined"
             [Term]
_ -> 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
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
             Maybe Term
_ -> 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 :: Context
tt_ctxt = Context
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 :: Context
tt_ctxt = Context -> Context
f (IState -> Context
tt_ctxt IState
i) } )

addConstraints :: FC -> (Int, [UConstraint]) -> Idris ()
addConstraints :: FC -> (Int, [UConstraint]) -> Idris ()
addConstraints FC
fc (Int
v, [UConstraint]
cs)
    = do Bool
tit <- Idris Bool
typeInType
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
tit) 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 :: Int
next_tvar = Int
v }
             let ics :: Set ConstraintFC
ics = [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll (forall a b. [a] -> [b] -> [(a, b)]
zip [UConstraint]
cs (forall a. a -> [a]
repeat FC
fc)) (IState -> Set ConstraintFC
idris_constraints IState
i)
             IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt :: Context
tt_ctxt = Context
ctxt', idris_constraints :: Set ConstraintFC
idris_constraints = Set ConstraintFC
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 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 forall a b. (a -> b) -> a -> b
$ 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)

-- | Save information about a name that is not yet defined
addDeferred' :: NameType
             -> [(Name, (Int, Maybe Name, Type, [Name], Bool, Bool))]
                -- ^ The Name is the name being made into a metavar,
                -- the Int is the number of vars that are part of a
                -- putative proof context, the Maybe Name is the
                -- top-level function containing the new metavariable,
                -- the Type is its type, and the Bool is whether :p is
                -- allowed
             -> 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 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 forall a. Set a
S.empty Term
t))) [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
ns
       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)
_) -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
primDefs)) 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_metavars :: [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars = forall a b. (a -> b) -> [a] -> [b]
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))) [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
ns forall a. [a] -> [a] -> [a]
++
                                            IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
i }
  where
        -- 'tidyNames' is to generate user accessible names in case they are
        -- needed in tactic scripts
        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
                  forall n. n -> Binder (TT n) -> TT n -> TT n
Bind Name
n' Binder Term
b forall a b. (a -> b) -> a -> b
$ Set Name -> Term -> Term
tidyNames (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
                  forall n. n -> Binder (TT n) -> TT n -> TT n
Bind Name
n' Binder Term
b forall a b. (a -> b) -> a -> b
$ Set Name -> Term -> Term
tidyNames (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 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) ->
                   forall a. Err -> Idris a
throwError forall a b. (a -> b) -> a -> b
$ forall t. FC -> Err' t -> Err' t
At FC
fc forall a b. (a -> b) -> a -> b
$ forall t. FilePath -> Err' t
Msg (FilePath
"Can't define hole " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Name
n forall a. [a] -> [a] -> [a]
++ FilePath
" as it depends on other holes")
              Maybe (Maybe Name, Int, [Name], Bool, Bool)
_ -> IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_metavars :: [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars =
                                       forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
n', (Maybe Name, Int, [Name], Bool, Bool)
_) -> Name
nforall a. Eq a => a -> a -> Bool
/=Name
n')
                                          (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
i),
                                     ibc_write :: [IBCWrite]
ibc_write =
                                       forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> IBCWrite -> Bool
notMV Name
n) (IState -> [IBCWrite]
ibc_write IState
i)
                                          }
    where notMV :: Name -> IBCWrite -> Bool
notMV Name
n (IBCMetavar Name
n') = Bool -> Bool
not (Name
n 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
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
i) 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]
_) -> forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ 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 = 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
                forall s (m :: * -> *). MonadState s m => s -> m ()
put IState
ist { idris_consolewidth :: ConsoleWidth
idris_consolewidth = ConsoleWidth
w }

setDepth :: Maybe Int -> Idris ()
setDepth :: Maybe Int -> Idris ()
setDepth Maybe Int
d = do IState
ist <- Idris IState
getIState
                forall s (m :: * -> *). MonadState s m => s -> m ()
put IState
ist { idris_options :: IOption
idris_options = (IState -> IOption
idris_options IState
ist) { opt_printdepth :: Maybe Int
opt_printdepth = Maybe Int
d } }

typeDescription :: String
typeDescription :: FilePath
typeDescription = FilePath
"The type of types"


type1Doc :: Doc OutputAnnotation
type1Doc :: Doc OutputAnnotation
type1Doc = (forall a. a -> Doc a -> Doc a
annotate (FilePath -> FilePath -> OutputAnnotation
AnnType FilePath
"Type" FilePath
"The type of types, one level up") forall a b. (a -> b) -> a -> b
$ 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 -> forall a. IO a -> Idris a
runIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$ forall a. SExpable a => FilePath -> a -> Integer -> FilePath
convSExp FilePath
"set-prompt" FilePath
p Integer
n

-- | Tell clients how much was parsed and loaded
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 ->
                              forall a. IO a -> Idris a
runIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$
                                forall a. SExpable a => FilePath -> a -> Integer -> FilePath
convSExp FilePath
"set-loaded-region" FC
fc Integer
n
                        Maybe FC
Nothing -> 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 :: Int
opt_logLevel = Int
l }
                   IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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 :: [LogCat]
opt_logcats = [LogCat]
cs }
  IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
iopts { opt_cmdline :: [Opt]
opt_cmdline = [Opt]
opts } }

getCmdLine :: Idris [Opt]
getCmdLine :: Idris [Opt]
getCmdLine = do IState
i <- Idris IState
getIState
                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
                         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 = 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
                  forall (m :: * -> *) a. Monad m => a -> m a
return 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 [] = forall a. Maybe a
Nothing
          findC (DumpDefun FilePath
x : [Opt]
_) = 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
                  forall (m :: * -> *) a. Monad m => a -> m a
return 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 [] = forall a. Maybe a
Nothing
          findC (DumpCases FilePath
x : [Opt]
_) = 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
              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 :: Bool
opt_autoimpls = Bool
b }
                    IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

getAutoImpls :: Idris Bool
getAutoImpls :: Idris Bool
getAutoImpls = do IState
i <- Idris IState
getIState
                  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 :: Bool
opt_errContext = Bool
t }
                     IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opts' }

errContext :: Idris Bool
errContext :: Idris Bool
errContext = do IState
i <- Idris IState
getIState
                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
                 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 :: [Optimisation]
opt_optimise = [Optimisation]
newopts }
                         IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opts' }

addOptimise :: Optimisation -> Idris ()
addOptimise :: Optimisation -> Idris ()
addOptimise Optimisation
opt = do [Optimisation]
opts <- Idris [Optimisation]
getOptimise
                     [Optimisation] -> Idris ()
setOptimise (forall a. Eq a => [a] -> [a]
nub (Optimisation
opt 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 ((forall a. Eq a => [a] -> [a]
nub [Optimisation]
opts) forall a. Eq a => [a] -> [a] -> [a]
\\ [Optimisation
opt])

-- | Set appropriate optimisation set for the given level. We only
-- have one optimisation that is configurable at the moment, however!
setOptLevel :: Int -> Idris ()
setOptLevel :: Int -> Idris ()
setOptLevel Int
n | Int
n 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 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
             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 :: Bool
opt_repl = Bool
t }
               IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

showOrigErr :: Idris Bool
showOrigErr :: Idris Bool
showOrigErr = do IState
i <- Idris IState
getIState
                 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 :: Bool
opt_origerr = Bool
b }
                      IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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 :: Bool
opt_autoSolve = Bool
b }
                    IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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 :: Bool
opt_nobanner = Bool
n }
                   IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

getNoBanner :: Idris Bool
getNoBanner :: Idris Bool
getNoBanner = do IState
i <- Idris IState
getIState
                 let opts :: IOption
opts = IState -> IOption
idris_options IState
i
                 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 :: Bool
opt_evaltypes = Bool
n }
                    IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

getDesugarNats :: Idris Bool
getDesugarNats :: Idris Bool
getDesugarNats = do IState
i <- Idris IState
getIState
                    let opts :: IOption
opts = IState -> IOption
idris_options IState
i
                    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 :: Bool
opt_desugarnats = Bool
n }
                      IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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 :: Bool
opt_quiet = Bool
q }
                IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

getQuiet :: Idris Bool
getQuiet :: Idris Bool
getQuiet = do IState
i <- Idris IState
getIState
              let opts :: IOption
opts = IState -> IOption
idris_options IState
i
              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 :: Codegen
opt_codegen = Codegen
t }
                  IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

codegen :: Idris Codegen
codegen :: Idris Codegen
codegen = do IState
i <- Idris IState
getIState
             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 :: OutputType
opt_outputTy = OutputType
t }
                   IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

outputTy :: Idris OutputType
outputTy :: Idris OutputType
outputTy = do IState
i <- Idris IState
getIState
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IOption -> OutputType
opt_outputTy 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_outputmode :: OutputMode
idris_outputmode = Integer -> Handle -> OutputMode
IdeMode Integer
0 Handle
h
                                      , idris_colourRepl :: Bool
idris_colourRepl = Bool
False
                                      }
setIdeMode Bool
False Handle
_ = 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 :: FilePath
opt_triple = FilePath
t }
                       IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

targetTriple :: Idris String
targetTriple :: Idris FilePath
targetTriple = do IState
i <- Idris IState
getIState
                  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 :: FilePath
opt_cpu = FilePath
t }
                    IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

targetCPU :: Idris String
targetCPU :: Idris FilePath
targetCPU = do IState
i <- Idris IState
getIState
               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
  -- Quietness overrides verbosity
  let quiet :: Bool
quiet = IOption -> Bool
opt_quiet   forall a b. (a -> b) -> a -> b
$ IState -> IOption
idris_options IState
i
  if Bool
quiet
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
0
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (IOption -> Int
opt_verbose 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 :: Int
opt_verbose = Int
t }
  IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
level forall a. Ord a => a -> a -> Bool
<= Int
verbosity) forall a b. (a -> b) -> a -> b
$
    case IState -> OutputMode
idris_outputmode IState
i of
      RawOutput Handle
h -> forall a. IO a -> Idris a
runIO forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
h FilePath
msg
      IdeMode Integer
n Handle
h -> forall a. IO a -> Idris a
runIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$ forall a. SExpable a => FilePath -> a -> Integer -> FilePath
convSExp FilePath
"write-string" FilePath
msg Integer
n
  forall (m :: * -> *) a. Monad m => a -> m a
return ()

typeInType :: Idris Bool
typeInType :: Idris Bool
typeInType = do IState
i <- Idris IState
getIState
                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 :: Bool
opt_typeintype = Bool
t }
                     IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

coverage :: Idris Bool
coverage :: Idris Bool
coverage = do IState
i <- Idris IState
getIState
              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 :: Bool
opt_coverage = Bool
t }
                   IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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 :: FilePath
opt_ibcsubdir = FilePath
fp }
                     IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

valIBCSubDir :: IState -> Idris FilePath
valIBCSubDir :: IState -> Idris FilePath
valIBCSubDir IState
i = 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 :: [FilePath]
opt_importdirs = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ FilePath
fp forall a. a -> [a] -> [a]
: IOption -> [FilePath]
opt_importdirs IOption
opts }
                     IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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 :: [FilePath]
opt_importdirs = [FilePath]
fps }
                       IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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)
                   forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"." forall a. a -> [a] -> [a]
: forall {a}. [a] -> [a]
reverse [FilePath]
optdirs)

-- Like allImportDirs but the dirs that are a prefix of
-- the files path first. This makes it look in the current
-- package first.
rankedImportDirs :: FilePath -> Idris [FilePath]
rankedImportDirs :: FilePath -> Idris [FilePath]
rankedImportDirs FilePath
fp = do [FilePath]
ids <- Idris [FilePath]
allImportDirs
                         let ([FilePath]
prefixes, [FilePath]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`FilePath
fp) [FilePath]
ids
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [FilePath]
prefixes 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 :: [FilePath]
opt_sourcedirs = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ FilePath
fp forall a. a -> [a] -> [a]
: IOption -> [FilePath]
opt_sourcedirs IOption
opts  }
                     IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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 :: [FilePath]
opt_sourcedirs = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [FilePath]
fps  }
                       IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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)
                   forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"." forall a. a -> [a] -> [a]
: forall {a}. [a] -> [a]
reverse [FilePath]
optdirs)

colourise :: Idris Bool
colourise :: Idris Bool
colourise = do IState
i <- Idris IState
getIState
               forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_colourRepl :: Bool
idris_colourRepl = Bool
b }

impShow :: Idris Bool
impShow :: Idris Bool
impShow = do IState
i <- Idris IState
getIState
             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 :: Bool
opt_showimp = Bool
t }
                  IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
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 forall a b. (a -> b) -> a -> b
$ IState
i { idris_colourTheme :: ColourTheme
idris_colourTheme = ColourTheme
newTheme }
    where setColour' :: ColourType -> IdrisColour -> ColourTheme -> ColourTheme
setColour' ColourType
KeywordColour   IdrisColour
c ColourTheme
t = ColourTheme
t { keywordColour :: IdrisColour
keywordColour = IdrisColour
c }
          setColour' ColourType
BoundVarColour  IdrisColour
c ColourTheme
t = ColourTheme
t { boundVarColour :: IdrisColour
boundVarColour = IdrisColour
c }
          setColour' ColourType
ImplicitColour  IdrisColour
c ColourTheme
t = ColourTheme
t { implicitColour :: IdrisColour
implicitColour = IdrisColour
c }
          setColour' ColourType
FunctionColour  IdrisColour
c ColourTheme
t = ColourTheme
t { functionColour :: IdrisColour
functionColour = IdrisColour
c }
          setColour' ColourType
TypeColour      IdrisColour
c ColourTheme
t = ColourTheme
t { typeColour :: IdrisColour
typeColour = IdrisColour
c }
          setColour' ColourType
DataColour      IdrisColour
c ColourTheme
t = ColourTheme
t { dataColour :: IdrisColour
dataColour = IdrisColour
c }
          setColour' ColourType
PromptColour    IdrisColour
c ColourTheme
t = ColourTheme
t { promptColour :: IdrisColour
promptColour = IdrisColour
c }
          setColour' ColourType
PostulateColour IdrisColour
c ColourTheme
t = ColourTheme
t { postulateColour :: IdrisColour
postulateColour = IdrisColour
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]

-- | Log an action of the parser
logParser :: Int -> String -> Idris ()
logParser :: Int -> FilePath -> Idris ()
logParser = [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats [LogCat]
parserCats

-- | Log an action of the elaborator.
logElab :: Int -> String -> Idris ()
logElab :: Int -> FilePath -> Idris ()
logElab = [LogCat] -> Int -> FilePath -> Idris ()
logLvlCats [LogCat]
elabCats

-- | Log an action of the compiler.
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]

-- | Log aspect of Idris execution
--
-- An empty set of logging levels is used to denote all categories.
--
-- @TODO update IDE protocol
logLvlCats :: [LogCat] -- ^ The categories that the message should appear under.
           -> Int      -- ^ The Logging level the message should appear.
           -> String   -- ^ The message to show the developer.
           -> 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)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
lvl forall a. Ord a => a -> a -> Bool
>= Int
l) forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LogCat] -> [LogCat] -> Bool
inCat [LogCat]
cs [LogCat]
cats Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogCat]
cats) forall a b. (a -> b) -> a -> b
$
        case IState -> OutputMode
idris_outputmode IState
i of
          RawOutput Handle
h -> do
            forall a. IO a -> Idris a
runIO 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 (forall a. Integral a => a -> Integer
toInteger Int
l), forall a. SExpable a => a -> SExp
toSExp FilePath
msg]
            forall a. IO a -> Idris a
runIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Opt
x 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                Maybe FC
_       -> 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 :: Bool
opt_typecase = Bool
t }
                   IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

getIndentWith :: Idris Int
getIndentWith :: Idris Int
getIndentWith = do
  IState
i <- Idris IState
getIState
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: Int
interactiveOpts_indentWith = Int
indentWith }
  IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_interactiveOpts :: InteractiveOpts
idris_interactiveOpts = InteractiveOpts
opts' }

getIndentClause :: Idris Int
getIndentClause :: Idris Int
getIndentClause = do
  IState
i <- Idris IState
getIState
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: Int
interactiveOpts_indentClause = Int
indentClause }
  IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_interactiveOpts :: InteractiveOpts
idris_interactiveOpts = InteractiveOpts
opts' }

-- Dealing with parameters

expandParams :: (Name -> Name) -> [(Name, PTerm)] ->
                [Name] -> -- all names
                [Name] -> -- names with no declaration
                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
    -- if we shadow a name (say in a lambda binding) that is used in a call to
    -- a lifted function, we need access to both names - once in the scope of the
    -- binding and once to call the lifted functions. So we'll explicitly shadow
    -- it. (Yes, it's a hack. The alternative would be to resolve names earlier
    -- but we didn't...)

    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
iforall 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 -- ^ The quotation level - only transform terms that are used, not terms
              -- that are merely mentioned.
        -> PTerm -> PTerm
    en :: Int -> PTerm -> PTerm
en Int
0 (PLam FC
fc Name
n FC
nfc PTerm
t PTerm
s)
       | Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps forall a. [a] -> [a] -> [a]
++ [Name]
ns)
               = let n' :: Name
n' = Name -> Name
mkShadow Name
n in -- TODO THINK SHADOWING TacImp?
                     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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps 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)
    -- FIXME: Should only do this in a type signature!
    en Int
0 (PDPair FC
f [FC]
hls PunInfo
p (PRef FC
f' [FC]
fcs Name
n) PTerm
t PTerm
r)
       | Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps forall a. [a] -> [a] -> [a]
++ [Name]
ns) Bool -> Bool -> Bool
&& PTerm
t 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) (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 (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 (forall a b. (a -> b) -> [a] -> [b]
map (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 (forall a b. (a -> b) -> [a] -> [b]
map (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 (forall a b. (a -> b) -> [a] -> [b]
map (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))
                           (forall a b. (a -> b) -> [a] -> [b]
map ((forall {t}. t -> PArg' t
pexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map (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 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))
                           (forall a b. (a -> b) -> [a] -> [b]
map ((forall {t}. t -> PArg' t
pexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map (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))
                           (forall a b. (a -> b) -> [a] -> [b]
map ((forall {t}. t -> PArg' t
pexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map (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 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))
                           (forall a b. (a -> b) -> [a] -> [b]
map ((forall {t}. t -> PArg' t
pexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map (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))
                           (forall a b. (a -> b) -> [a] -> [b]
map ((forall {t}. t -> PArg' t
pexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map (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 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))
                           (forall a b. (a -> b) -> [a] -> [b]
map ((forall {t}. t -> PArg' t
pexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))
                           (forall a b. (a -> b) -> [a] -> [b]
map ((forall {t}. t -> PArg' t
pexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))
                           (forall a b. (a -> b) -> [a] -> [b]
map ((forall {t}. t -> PArg' t
pexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) (forall a b. (a -> b) -> [a] -> [b]
map (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) (forall a b. (a -> b) -> [a] -> [b]
map (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) (forall a b. (a -> b) -> [a] -> [b]
map (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 forall a. Num a => a -> a -> a
+ Int
1) PTerm
tm) (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 forall a. Num a => a -> a -> a
- Int
1) PTerm
tm)

    en Int
ql PTerm
t = 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 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 -> -- True = RHS only
                 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
rhsonly)
         then -- trace (show (n, expandParams dec ps ns ty)) $
              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 --trace (show (n, expandParams dec ps ns ty)) $
              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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
rhsonly)
         then -- trace (show (n, expandParams dec ps ns ty)) $
              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 --trace (show (n, expandParams dec ps ns ty)) $
              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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then Name -> Name
dec Name
n else Name
n in
          forall t. FC -> [FnOpt] -> Name -> [PClause' t] -> PDecl' t
PClauses FC
fc [FnOpt]
opts Name
n' (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' = updateps True (namesIn ist rhs) (zip ps [0..])
              ps'' :: [(Name, PTerm)]
ps'' = 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) (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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then Name -> Name
dec Name
n else Name
n
              -- names bound on the lhs should not be expanded on the rhs
              ns' :: [Name]
ns' = PTerm -> [Name] -> [Name]
removeBound PTerm
lhs [Name]
ns in
              forall t. FC -> Name -> t -> [t] -> t -> [PDecl' t] -> PClause' t
PClause FC
fc Name
n' PTerm
lhs'
                            (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)
                            (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' = updateps True (namesIn ist wval) (zip ps [0..])
              ps'' :: [(Name, PTerm)]
ps'' = 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) (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 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
              forall t.
FC
-> Name
-> t
-> [t]
-> t
-> Maybe (Name, FC)
-> [PDecl' t]
-> PClause' t
PWith FC
fc Name
n' PTerm
lhs'
                          (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
                          (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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Name
nm) forall a. Eq a => a -> a -> Bool
== Bool
yn = (Name
a, b
t) 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 (forall a. Show a => a -> FilePath
show Name
a forall a. [a] -> [a] -> [a]
++ FilePath
"_shadow"), b
t) 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 forall a. Eq a => [a] -> [a] -> [a]
\\ 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) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PTerm -> [Name]
bnames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PArg' t -> t
getTm) [PArg]
args
    bnames (PPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
r) = PTerm -> [Name]
bnames PTerm
l 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 forall a. [a] -> [a] -> [a]
++ PTerm -> [Name]
bnames PTerm
r
    bnames PTerm
_ = []

-- | Expands parameters defined in parameter and where blocks inside of declarations
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)
    = 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
    -- just do the type decl, leave constructors alone (parameters will be
    -- added implicitly)
    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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns
            then 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))
                           (forall a b. (a -> b) -> [a] -> [b]
map 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 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) (forall a b. (a -> b) -> [a] -> [b]
map 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)
   = forall t. FC -> [(Name, t)] -> [PDecl' t] -> PDecl' t
PParams FC
f ([(Name, PTerm)]
ps forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (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)
               (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)
--                (map (expandParamsD ist dec ps ns) pds)
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns (PMutual FC
f [PDecl]
pds)
   = forall t. FC -> [PDecl' t] -> PDecl' t
PMutual FC
f (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)
   = 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
           (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
           (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
           (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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then forall a. a -> Maybe a
Just (Name -> Name
dec Name
n) else forall a. a -> Maybe a
Just Name
n
                    Maybe Name
Nothing -> forall a. Maybe a
Nothing in
     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
                     (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
                     (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)
                     (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'
                     (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)
    = 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 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

-- | Calculate a priority for a type, for deciding elaboration order
-- * if it's just a type variable or concrete type, do it early (0)
-- * if there's only type variables and injective constructors, do it next (1)
-- * if there's a function type, next (2)
-- * finally, everything else (3)
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
              = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ case forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt FnInfo
idris_fninfo IState
ist) of
                           Just FnInfo
p -> 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 forall a. [a] -> [a] -> [a]
++
                                     forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IState -> Term -> [Name]
getParamNames IState
ist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, Term)]
statics
                           Maybe FnInfo
_ -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IState -> Term -> [Name]
getParamNames IState
ist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, Term)]
statics

       let stnames :: [Name]
stnames = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {a}. Eq a => TT a -> [a]
freeArgNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, Term)]
statics
       let dnames :: [Name]
dnames = (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {a}. Eq a => TT a -> [a]
freeArgNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, Term)]
dynamics)
                             forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
paramnames
       -- also get the arguments which are 'uniquely inferrable' from
       -- statics (see sec 4.2 of "Scrapping Your Inefficient Engine")
       -- or parameters to the type of a static
       let statics' :: [Name]
statics' = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, Term)]
statics forall a. [a] -> [a] -> [a]
++
                              forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
x -> Bool -> Bool
not (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
x [Name]
dnames)) [Name]
stnames
       let stpos :: [Bool]
stpos = forall {t :: * -> *} {a}.
(Foldable t, Eq a) =>
t a -> TT a -> [Bool]
staticList [Name]
statics' Term
tm
       IState
i <- Idris IState
getIState
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, Term)]
statics) forall a b. (a -> b) -> a -> b
$
          Int -> FilePath -> Idris ()
logLvl Int
3 forall a b. (a -> b) -> a -> b
$ FilePath
"Statics for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Name
n forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Term
tm forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
                        forall a. [a] -> [a] -> [a]
++ PTerm -> FilePath
showTmImpls PTerm
ptm forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
                        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [(Name, Term)]
statics forall a. [a] -> [a] -> [a]
++ FilePath
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [(Name, Term)]
dynamics
                        forall a. [a] -> [a] -> [a]
++ FilePath
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [Name]
paramnames
                        forall a. [a] -> [a] -> [a]
++ FilePath
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [Bool]
stpos
       IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_statics :: Ctxt [Bool]
idris_statics = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n [Bool]
stpos (IState -> Ctxt [Bool]
idris_statics IState
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 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) 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 (forall n. TT n -> TT n -> TT n
instantiate (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 forall a. Eq a => a -> a -> Bool
== Static
Static then ((Name
n, Term
ty) 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) 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) <- forall n. TT n -> (TT n, [TT n])
unApply Term
tm
       = case forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt TypeInfo
idris_datatypes IState
ist) of
              Just TypeInfo
ti -> 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t t
ps = a
n forall a. a -> [a] -> [a]
: t -> t t -> [TT a] -> [a]
getNamePos (t
i 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 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 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t t
ps = a
n forall a. a -> [a] -> [a]
: t -> t t -> TT a -> [a]
getNamesFrom (t
i 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 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)
          = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall {a}. Eq a => TT a -> [a]
freeNames TT a
ty forall a. [a] -> [a] -> [a]
++ forall {a}. Eq a => TT a -> [a]
freeNames TT a
sc -- treat '->' as fn here
    freeArgNames TT a
tm = let (TT a
_, [TT a]
args) = forall n. TT n -> (TT n, [TT n])
unApply TT a
tm in
                          forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Eq a => TT a -> [a]
freeNames [TT a]
args

    -- if a name appears in an interface or tactic implicit index, it doesn't
    -- affect its 'uniquely inferrable' from a static status since these are
    -- resolved by searching.
    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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
sts) forall a. a -> [a] -> [a]
: t a -> TT a -> [Bool]
staticList t a
sts TT a
sc
    staticList t a
_ TT a
_ = []

-- Dealing with implicit arguments

-- Add some bound implicits to the using block if they aren't there already

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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Using -> Maybe Name
impName [Using]
us = [Using] -> [(Name, PTerm)] -> [Using]
addToUsing ([Using]
us 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
_) = forall a. a -> Maybe a
Just Name
n
        impName Using
_ = forall a. Maybe a
Nothing

-- Add constraint bindings from using block

addUsingConstraints :: SyntaxInfo -> FC -> PTerm -> Idris PTerm
addUsingConstraints :: SyntaxInfo -> FC -> PTerm -> Idris PTerm
addUsingConstraints SyntaxInfo
syn FC
fc PTerm
t
   = do IState
ist <- 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 -- check declared constraints
        let addconsts :: [Using]
addconsts = [Using]
uconsts forall a. Eq a => [a] -> [a] -> [a]
\\ [Using]
cs
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall {t :: * -> *}.
Foldable t =>
[Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
addconsts [Name]
ns PTerm
t)
   where uconsts :: [Using]
uconsts = 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
         -- if all of args in ns, then add it
         doAdd (UConstraint Name
c [Name]
args : [Using]
cs) t Name
ns PTerm
t
             | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Name
n -> 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)
                           (forall a b. (a -> b) -> [a] -> [b]
map (forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp Int
0 [] (Int -> FilePath -> Name
sMN Int
0 FilePath
"carg") 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 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PArg -> [Name]
getName [PArg]
args
                  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)) = forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
         getName PArg
_ = []

-- | Add implicit bindings from using block, and bind any missing names
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 (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 forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
n -> Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls)) [Name]
ns_in

        let badnames :: [Name]
badnames = forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
n -> Bool -> Bool
not (Name -> Bool
implicitable Name
n) Bool -> Bool -> Bool
&&
                                     Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls)) [Name]
ns
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
badnames) forall a b. (a -> b) -> a -> b
$
           forall a. Err -> Idris a
throwError (forall t. FC -> Err' t -> Err' t
At FC
fc (forall t. FilePath -> Name -> Maybe t -> Err' t -> Err' t
Elaborating FilePath
"type of " Name
n forall a. Maybe a
Nothing
                         (forall t. Name -> Err' t
NoSuchVariable (forall a. [a] -> a
head [Name]
badnames))))
        let cs :: [Name]
cs = PTerm -> [Name]
getArgnames PTerm
t -- get already bound names
        let addimpls :: [Using]
addimpls = forall a. (a -> Bool) -> [a] -> [a]
filter (\Using
n -> Using -> Name
iname Using
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
cs) [Using]
uimpls
        -- if all names in the arguments of addconsts appear in ns,
        -- add the constraint implicitly
        forall (m :: * -> *) a. Monad m => a -> m a
return ([Name] -> PTerm -> PTerm
bindFree [Name]
ns (forall {t :: * -> *}.
Foldable t =>
[Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
addimpls [Name]
ns PTerm
t))
   where uimpls :: [Using]
uimpls = 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]
_) = forall a. HasCallStack => FilePath -> a
error FilePath
"Can't happen addUsingImpls"

         doAdd :: [Using] -> t Name -> PTerm -> PTerm
doAdd [] t Name
_ PTerm
t = PTerm
t
         -- if all of args in ns, then add it
         doAdd (UImplicit Name
n PTerm
ty : [Using]
cs) t Name
ns PTerm
t
             | 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

         -- bind the free names which weren't in the using block
         bindFree :: [Name] -> PTerm -> PTerm
bindFree [] PTerm
tm = PTerm
tm
         bindFree (Name
n:[Name]
ns) PTerm
tm
             | forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n (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 :: [ArgOpt]
pargopts = [ArgOpt
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 forall a. a -> [a] -> [a]
: PTerm -> [Name]
getArgnames PTerm
sc
         getArgnames PTerm
_ = []

-- Given the original type and the elaborated type, return the implicitness
-- status of each pi-bound argument, and whether it's inaccessible (True) or not.

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)) 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') <- 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' 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, 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
                          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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
                          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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
                          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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
                          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 = forall {p}. Name -> p -> (Bool, PArg)
impBind Name
n Term
t 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, 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 = []

-- Add implicit Pi bindings for any names in the term which appear in an
-- argument position.

-- This has become a right mess already. Better redo it some time...
-- TODO: This is obsoleted by the new way of elaborating types, (which
-- calls addUsingImpls) but there's still a couple of places which use
-- it. Clean them up!
--
-- Issue 1739 in the issue tracker
--     https://github.com/idris-lang/Idris-dev/issues/1739
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 forall a. [a] -> [a] -> [a]
++ forall k a. Map k a -> [k]
M.keys (IState -> Ctxt [PArg]
idris_implicits IState
i)) [PArg]
impdata
--          let (tm'', spos) = findStatics i tm'
         IState -> Idris ()
putIState forall a b. (a -> b) -> a -> b
$ IState
i { idris_implicits :: Ctxt [PArg]
idris_implicits = forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n [PArg]
impdata (IState -> Ctxt [PArg]
idris_implicits IState
i) }
         IBCWrite -> Idris ()
addIBC (Name -> IBCWrite
IBCImp Name
n)
         Int -> FilePath -> Idris ()
logLvl Int
5 (FilePath
"Implicit " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Name
n forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [PArg]
impdata)
--          i <- get
--          putIState $ i { idris_statics = addDef n spos (idris_statics i) }
         forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
tm'
  where
    --  Detect unknown names in default arguments and throw error if found.
    defaultArgCheck :: [Name] -> [PArg] -> Idris ()
    defaultArgCheck :: [Name] -> [PArg] -> Idris ()
defaultArgCheck [Name]
knowns [PArg]
params = 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     -> forall (m :: * -> *) a. Monad m => a -> m a
return (Name
nforall a. a -> [a] -> [a]
:[Name]
kns)
              Just Name
name   -> forall a. Err -> Idris a
throwError (forall t. Name -> Err' t
NoSuchVariable Name
name)
    notFoundInDefault [Name]
kns PArg
p = forall (m :: * -> *) a. Monad m => a -> m a
return ((forall t. PArg' t -> Name
pname PArg
p)forall a. a -> [a] -> [a]
:[Name]
kns)

    notFound :: [Name] -> [Name] -> Maybe Name
    notFound :: [Name] -> [Name] -> Maybe Name
notFound [Name]
kns [] = forall a. Maybe a
Nothing
    notFound [Name]
kns (SN (WhereN Int
_ Name
_ Name
_) : [Name]
ns) = [Name] -> [Name] -> Maybe Name
notFound [Name]
kns [Name]
ns --  Known already
    notFound [Name]
kns (Name
n:[Name]
ns) = if 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 forall a. a -> Maybe a
Just Name
n

-- | Even if auto_implicits is off, we need to call this so we record
-- which arguments are implicit
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 = -- trace ("INCOMING " ++ showImp True tm) $
      let ([PArg]
declimps, [Name]
ns') = forall s a. State s a -> s -> s
execState (forall {m :: * -> *}.
MonadState ([PArg], [Name]) m =>
Bool -> [Name] -> PTerm -> m ()
imps Bool
True [] PTerm
tm) ([], [])
          ns :: [Name]
ns = forall a. (a -> Bool) -> [a] -> [a]
filter (\Name
n -> Bool
auto Bool -> Bool -> Bool
&& Name -> Bool
implicitable Name
n Bool -> Bool -> Bool
|| forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, PTerm)]
uvars)) forall a b. (a -> b) -> a -> b
$
                  [Name]
ns' forall a. Eq a => [a] -> [a] -> [a]
\\ (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, PTerm)]
pvars forall a. [a] -> [a] -> [a]
++ SyntaxInfo -> [Name]
no_imp SyntaxInfo
syn forall a. [a] -> [a] -> [a]
++ [Name]
ignore)
          nsOrder :: [Name]
nsOrder = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Bool
inUsing) [Name]
ns forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
inUsing [Name]
ns in
          if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ns
            then (PTerm
tm, 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 = forall a b. (a -> b) -> [a] -> [b]
map Using -> (Name, PTerm)
ipair (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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map 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 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 forall a. a -> [a] -> [a]
: [a] -> t a -> [a]
dropAll [a]
xs t a
ys
    dropAll [] t a
ys = []

    -- Find names in argument position in a type, suitable for implicit
    -- binding
    -- Not the function position, but do everything else...
    implNamesIn :: [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, b)]
uv (PApp FC
fc PTerm
f [PArg]
args) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, b)]
uv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PArg' t -> t
getTm) [PArg]
args
    implNamesIn [(Name, b)]
uv PTerm
t = [Name] -> IState -> PTerm -> [Name]
implicitNamesIn (forall a b. (a -> b) -> [a] -> [b]
map 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) <- forall s (m :: * -> *). MonadState s m => m s
get
            let isn :: [Name]
isn = forall a. Eq a => [a] -> [a]
nub (forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty)
            forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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 = forall a. Eq a => [a] -> [a]
nub (forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty) forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
             ([PArg]
decls , [Name]
ns) <- forall s (m :: * -> *). MonadState s m => m s
get
             forall s (m :: * -> *). MonadState s m => s -> m ()
put (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 forall a. a -> [a] -> [a]
: [PArg]
decls,
                  forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
             Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nforall 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 = forall a. Eq a => [a] -> [a]
nub (forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty 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 forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
                            PTerm
_ -> [])
             ([PArg]
decls, [Name]
ns) <- forall s (m :: * -> *). MonadState s m => m s
get -- ignore decls in HO types
             forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp (IState -> PTerm -> Int
getPriority IState
ist PTerm
ty) [ArgOpt]
l Name
n PTerm
Placeholder forall a. a -> [a] -> [a]
: [PArg]
decls,
                  forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
             Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nforall 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 = forall a. Eq a => [a] -> [a]
nub (forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty 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 forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
                            PTerm
_ -> [])
             ([PArg]
decls, [Name]
ns) <- forall s (m :: * -> *). MonadState s m => m s
get -- ignore decls in HO types
             forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
10 [ArgOpt]
l Name
n PTerm
Placeholder forall a. a -> [a] -> [a]
: [PArg]
decls,
                  forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
             Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nforall 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 = forall a. Eq a => [a] -> [a]
nub (forall {b}. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty 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 forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
                            PTerm
_ -> [])
             ([PArg]
decls, [Name]
ns) <- forall s (m :: * -> *). MonadState s m => m s
get -- ignore decls in HO types
             forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
10 [ArgOpt]
l Name
n PTerm
scr PTerm
Placeholder forall a. a -> [a] -> [a]
: [PArg]
decls,
                  forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
             Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nforall 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) <- 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 forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r
             forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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) <- 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 forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r
             forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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) <- forall s (m :: * -> *). MonadState s m => m s
get
             let isn :: [Name]
isn = forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
t forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r) forall a. Eq a => [a] -> [a] -> [a]
\\ [Name
n]
             forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall a. Eq a => [a] -> [a] -> [a]
\\ ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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) <- 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 forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
t forall a. [a] -> [a] -> [a]
++
                       [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r
             forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall a. Eq a => [a] -> [a] -> [a]
\\ ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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) <- forall s (m :: * -> *). MonadState s m => m s
get
             let isn :: [Name]
isn = 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
             forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, forall a. Eq a => [a] -> [a]
nub ([Name]
ns forall a. [a] -> [a] -> [a]
++ ([Name]
isn forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map 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
nforall 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 -- ignore PConstSugar - it's for highlighting only!
    imps Bool
top [Name]
env PTerm
_               = 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 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 :: [ArgOpt]
pargopts = [ArgOpt
InaccessibleArg] })
                           Name
n FC
NoFC PTerm
Placeholder ([(Name, PTerm)] -> [Name] -> PTerm -> PTerm
pibind [(Name, PTerm)]
using [Name]
ns PTerm
sc)

-- | Add implicit arguments in function calls
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

-- | Add the implicit arguments to applications in the term [Name]
-- gives the names to always expend, even when under a binder of that
-- name (this is to expand methods with implicit arguments in
-- dependent interfaces).
addImpl :: [Name] -> IState -> PTerm -> PTerm
addImpl :: [Name] -> IState -> PTerm -> PTerm
addImpl = Bool -> [Name] -> [Name] -> [Name] -> IState -> PTerm -> PTerm
addImpl' Bool
False [] []

-- TODO: in patterns, don't add implicits to function names guarded by constructors
-- and *not* inside a PHidden

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 (forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
env (forall a. a -> [a]
repeat forall a. Maybe a
Nothing)) [] ([Name] -> [(Name, Name)] -> PTerm -> PTerm
mkUniqueNames [Name]
env [] PTerm
ptm)
  where
    allowcap :: Bool
allowcap = Opt
AllowCapitalizedPatternVariables 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
"" -- doesn't matter then

    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 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, Maybe PTerm)]
env) = Either Err PTerm -> PTerm
handleErr 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, Maybe PTerm)]
env) = PTerm -> PTerm
PHidden (Either Err PTerm -> PTerm
handleErr 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' = 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' = 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' = forall a b. (a -> b) -> [a] -> [b]
map (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 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, Maybe PTerm)]
env)
              = let as' :: [PArg]
as' = forall a b. (a -> b) -> [a] -> [b]
map (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 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) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
f [(Name, Maybe PTerm)]
env =
             let as' :: [PArg]
as' = forall a b. (a -> b) -> [a] -> [b]
map (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' = forall a b. (a -> b) -> [a] -> [b]
map (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
        -- leave lhs alone, because they get lifted into a new pattern match
        -- definition which is passed through addImpl again
            FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc PTerm
c' (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 forall a. [a] -> [a] -> [a]
++ forall {a}. PTerm -> [(Name, Maybe a)]
patnames PTerm
lhs) [[Text]]
ds PTerm
rhs)

       -- Anything beginning with a lower case letter, not applied,
       -- and no namespace is a pattern variable
       patnames :: PTerm -> [(Name, Maybe a)]
patnames (PApp FC
_ (PRef FC
_ [FC]
_ Name
f) [])
           | Name -> Bool
implicitable Name
f = [(Name
f, forall a. Maybe a
Nothing)]
       patnames (PRef FC
_ [FC]
_ Name
f)
           | Name -> Bool
implicitable Name
f = [(Name
f, forall a. Maybe a
Nothing)]
       patnames (PApp FC
_ (PRef FC
_ [FC]
_ Name
_) [PArg]
args)
           = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [(Name, Maybe a)]
patnames (forall a b. (a -> b) -> [a] -> [b]
map forall t. PArg' t -> t
getTm [PArg]
args)
       patnames (PPair FC
_ [FC]
_ PunInfo
_ PTerm
l PTerm
r) = PTerm -> [(Name, Maybe a)]
patnames PTerm
l 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 forall a. [a] -> [a] -> [a]
++ PTerm -> [(Name, Maybe a)]
patnames PTerm
t 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) = 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)

    -- If the name in a lambda is an unapplied data constructor name, do this
    -- as a 'case' instead because we'll expect to match on it
    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, forall a. a -> Maybe a
Just PTerm
ty)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, forall a. a -> Maybe a
Just PTerm
ty)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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
imp_meths then [(Name, Maybe PTerm)]
env
                      else
                      ((Name
n, forall a. a -> Maybe a
Just PTerm
ty) 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, forall a. Maybe a
Nothing)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)
    -- Don't do PProof or PTactics since implicits get added when scope is
    -- properly known in ElabTerm.runTac
    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)
                                                  (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

-- if in a pattern, and there are no arguments, and there's no possible
-- names with zero explicit arguments, don't add implicits.

aiFn :: Name -> Bool -- ^ Allow capitalization of pattern variables
     -> Bool -> Bool -> Bool
     -> [Name]
     -> IState -> FC
     -> Name -- ^ function being applied
     -> FC -> [[T.Text]]
     -> [PArg] -- ^ initial arguments (if in a pattern)
     -> 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 = forall a b. b -> Either a b
Right 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 forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
                else case Name
f of
                       MN Int
_ Text
_ -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
                       UN Text
xs | Char -> Bool
isDigit (Text -> Char
T.head Text
xs) -- for partial evaluation vars
                                 -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
                       Name
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t. FilePath -> Err' t
Msg forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show Name
f forall a. [a] -> [a] -> [a]
++ FilePath
" is not a valid name for a pattern variable"
        [Def]
alts -> let ialts :: [(Name, [PArg])]
ialts = forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
f (IState -> Ctxt [PArg]
idris_implicits IState
ist) in
                    -- trace (show f ++ " " ++ show (fc, any (all imp) ialts, ialts, any constructor alts)) $
                    if (Bool -> Bool
not (Name -> Bool
vname Name
f) Bool -> Bool -> Bool
|| Name -> Bool
tcname Name
f
                           Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall {t :: * -> *} {t}.
Foldable t =>
Context -> (Name, t (PArg' t)) -> Bool
conCaf (IState -> Context
tt_ctxt IState
ist)) [(Name, [PArg])]
ialts)
--                            any constructor alts || any allImp 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 [] -- use it as a constructor
                        else forall a b. b -> Either a b
Right 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 [] = False
          allImp :: t (PArg' t) -> Bool
allImp t (PArg' t)
xs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all 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
&& forall {t :: * -> *} {t}. Foldable t => t (PArg' t) -> Bool
allImp t (PArg' t)
cia

          vname :: Name -> Bool
vname (UN Text
n) = Bool
True -- non qualified
          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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
primNames = forall a b. b -> Either a b
Right 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
          -- This is where namespaces get resolved by adding PAlternative
     = do let ns :: [(Name, [PArg])]
ns = forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
f (IState -> Ctxt [PArg]
idris_implicits IState
ist)
          let nh :: [(Name, [PArg])]
nh = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
n, [PArg]
_) -> Name -> Bool
notHidden Name
n) [(Name, [PArg])]
ns
          let ns' :: [(Name, [PArg])]
ns' = case 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)] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc (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 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
ist)) of
                    Just Name
f' -> forall a b. b -> Either a b
Right 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 -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc (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 -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
                         [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [] (Bool -> PAltType
ExactlyOne Bool
True) forall a b. (a -> b) -> a -> b
$
                           forall a b. (a -> b) -> [a] -> [b]
map (\(Name
f', [PArg]
ns) -> FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc (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
    -- if the name is in imp_meths, we should actually refer to the bound
    -- name rather than the global one after expanding implicits
    isImpName :: Name -> Name -> Name
isImpName Name
f Name
f' | Name
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
imp_meths = Name
f
                   | Bool
otherwise = Name
f'

    -- If it's a metavariable name, try to qualify it from the list of
    -- unsolved metavariables
    metaVar :: Name -> [Name] -> Maybe Name
metaVar Name
f (Name
mvn : [Name]
ns) | Name
f forall a. Eq a => a -> a -> Bool
== Name -> Name
nsroot Name
mvn = 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 [] = forall a. Maybe a
Nothing

    trimAlts :: [[Text]] -> [(Name, b)] -> [(Name, b)]
trimAlts [] [(Name, b)]
alts = [(Name, b)]
alts
    trimAlts [[Text]]
ns [(Name, b)]
alts
        = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
x, b
_) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\[Text]
d -> [Text]
d 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] -- ^ expected argument types (from idris_implicits)
               -> [PArg] -- ^ given arguments
               -> [PArg]
    insertImpl :: [PArg] -> [PArg] -> [PArg]
insertImpl [PArg]
ps [PArg]
as
        = let ([PArg]
as', [PArg]
badimpls) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([PArg] -> PArg -> Bool
impIn [PArg]
ps) [PArg]
as in
              forall a b. (a -> b) -> [a] -> [b]
map forall {t}. PArg' t -> PArg' t
addUnknownImp [PArg]
badimpls forall a. [a] -> [a] -> [a]
++
              Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc forall {k} {a}. Map k a
M.empty [PArg]
ps (forall a. (a -> Bool) -> [a] -> [a]
filter forall {t}. PArg' t -> Bool
expArg [PArg]
as') (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t}. PArg' t -> Bool
expArg) [PArg]
as')

    insImpAcc :: M.Map Name PTerm -- accumulated param names & arg terms
              -> [PArg]           -- parameters
              -> [PArg]           -- explicit arguments
              -> [PArg]           -- implicits given
              -> [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 =
      forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp Int
p [ArgOpt]
l Name
n PTerm
tm forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (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 =
      forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
p [ArgOpt]
l Name
n PTerm
tm forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (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
        forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
p [ArgOpt]
l Name
n PTerm
rtc forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (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 forall {a}. Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n [PArg]
imps [] of
            Just (PTerm
tm, [PArg]
imps') ->
              forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
p Bool
False [ArgOpt]
l Name
n PTerm
tm forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (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 ->
              forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
p Bool
True [ArgOpt]
l Name
n PTerm
Placeholder forall a. a -> [a] -> [a]
:
                Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (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 (forall k a. Map k a -> [(k, a)]
M.toList Map Name PTerm
pnas) PTerm
sc') in
        case forall {a}. Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n [PArg]
imps [] of
            Just (PTerm
tm, [PArg]
imps') ->
              forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
tm forall a. a -> [a] -> [a]
:
                Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (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 forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
Placeholder forall a. a -> [a] -> [a]
:
                  Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (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 forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
sc forall a. a -> [a] -> [a]
:
                  Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (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 = forall a b. (a -> b) -> [a] -> [b]
map forall {t}. PArg' t -> PArg' t
addUnknownImp [PArg]
imps -- so that unused implicits give error
    insImpAcc Map Name PTerm
_ [PArg]
_        [PArg]
given [PArg]
imps = [PArg]
given forall a. [a] -> [a] -> [a]
++ [PArg]
imps

    addUnknownImp :: PArg' t -> PArg' t
addUnknownImp PArg' t
arg = PArg' t
arg { argopts :: [ArgOpt]
argopts = ArgOpt
UnknownImp forall a. a -> [a] -> [a]
: forall t. PArg' t -> [ArgOpt]
argopts PArg' t
arg }

    find :: Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n []               [PArg' a]
acc = forall a. Maybe a
Nothing
    find Name
n (PImp Int
_ Bool
_ [ArgOpt]
_ Name
n' a
t : [PArg' a]
gs) [PArg' a]
acc
         | Name
n forall a. Eq a => a -> a -> Bool
== Name
n' = forall a. a -> Maybe a
Just (a
t, forall {a}. [a] -> [a]
reverse [PArg' a]
acc 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 forall a. Eq a => a -> a -> Bool
== Name
n' = forall a. a -> Maybe a
Just (a
t, forall {a}. [a] -> [a]
reverse [PArg' a]
acc 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 forall a. a -> [a] -> [a]
: [PArg' a]
acc)

-- | return True if the second argument is an implicit argument which
-- is expected in the implicits, or if it's not an implicit
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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PArg
p -> Bool -> Bool
not (forall {t}. PArg' t -> Bool
expArg PArg
arg) Bool -> Bool -> Bool
&& forall t. PArg' t -> Name
pname PArg
arg forall a. Eq a => a -> a -> Bool
== 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

-- replace non-linear occurrences with _

stripLinear :: IState -> PTerm -> PTerm
stripLinear :: IState -> PTerm -> PTerm
stripLinear IState
i PTerm
tm = 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)
              = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
f
         | Bool
otherwise = do [Name]
ns <- forall s (m :: * -> *). MonadState s m => m s
get
                          if (Name
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns)
                             then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PTerm -> PTerm
PHidden (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
f) -- Placeholder
                             else do forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name
f forall a. a -> [a] -> [a]
: [Name]
ns)
                                     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 <- forall s (m :: * -> *). MonadState s m => m s
get
                          if (Name
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns)
                             then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PTerm -> PTerm
PHidden (FC -> Name -> PTerm
PPatvar FC
fc Name
f) -- Placeholder
                             else do forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name
f forall a. a -> [a] -> [a]
: [Name]
ns)
                                     forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> Name -> PTerm
PPatvar FC
fc Name
f)
    -- Assumption is that variables are all the same in each alternative
    sl t :: PTerm
t@(PAlternative [(Name, Name)]
ms PAltType
b [PTerm]
as) = do [Name]
ns <- forall s (m :: * -> *). MonadState s m => m s
get
                                     [PTerm]
as' <- [Name] -> [PTerm] -> StateT [Name] Identity [PTerm]
slAlts [Name]
ns [PTerm]
as
                                     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 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
                                     forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm
a' forall a. a -> [a] -> [a]
: [PTerm]
as')
             slAlts [Name]
ns [] = 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; 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
                                    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
                                     -- Just the args, fn isn't matchable as a var
                                          PRef FC
_ [FC]
_ Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
fn
                                          PTerm
t -> PTerm -> State [Name] PTerm
sl PTerm
t
                              [PArg]
args' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PArg -> StateT [Name] Identity PArg
slA [PArg]
args
                              forall (m :: * -> *) a. Monad m => a -> m a
return 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
                                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
                                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
                                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
                                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
t'
    sl PTerm
x = forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
x

-- | Remove functions which aren't applied to anything, which must then
-- be resolved by unification. Assume names resolved and alternatives
-- filled in (so no ambiguity).
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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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)
       -- here we use canBeDConName because the impossible pattern
       -- check will not necessarily fully resolve constructor names,
       -- and these bare names will otherwise get in the way of
       -- impossbility checking.
       | Name -> Context -> Bool
canBeDConName Name
fn Context
ctxt
          = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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' = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= PTerm
Placeholder) (forall a b. (a -> b) -> [a] -> [b]
map PTerm -> PTerm
su [PTerm]
alts) in
             if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PTerm]
alts' then PTerm
Placeholder
                           else PTerm -> PTerm
liftHidden 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

    -- If the ambiguous terms are all hidden, the PHidden needs to be outside
    -- because elaboration of PHidden gets delayed, and we need the elaboration
    -- to resolve the ambiguity.
    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 (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 = forall a. Int -> [a] -> [a]
drop Int
a [PArg]
as in
                       if Int
a 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 (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



-- | Find 'static' argument positions
-- (the declared ones, plus any names in argument position in the declared
-- statics)
-- FIXME: It's possible that this really has to happen after elaboration
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 forall s a. State s a -> s -> (a, s)
runState (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 forall a. a -> [a] -> [a]
: [[Name]]
ns, Name
n 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)
            | 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 <- forall s (m :: * -> *). MonadState s m => m s
get
                             forall s (m :: * -> *). MonadState s m => s -> m ()
put (Bool
True forall a. a -> [a] -> [a]
: [Bool]
spos)
                             forall (m :: * -> *) a. Monad m => a -> m a
return (Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi (Plicity
p { pstatic :: Static
pstatic = Static
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 <- forall s (m :: * -> *). MonadState s m => m s
get
                             forall s (m :: * -> *). MonadState s m => s -> m ()
put (Bool
False forall a. a -> [a] -> [a]
: [Bool]
spos)
                             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 = forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
t

-- for 6.12/7 compatibility
data EitherErr a b = LeftErr a | RightOK b deriving ( 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
<$ :: forall a b. a -> EitherErr a b -> EitherErr a a
$c<$ :: forall a a b. a -> EitherErr a b -> EitherErr a a
fmap :: forall a b. (a -> b) -> EitherErr a a -> EitherErr a b
$cfmap :: forall a a b. (a -> b) -> EitherErr a a -> EitherErr a b
Functor )

instance Applicative (EitherErr a) where
    pure :: forall a. a -> EitherErr a a
pure  = forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: forall 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 = 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
_ = 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)  = forall a b. a -> Either a b
Left a
e
toEither (RightOK b
ho) = forall a b. b -> Either a b
Right b
ho

-- | Syntactic match of a against b, returning pair of variables in a
-- and what they match. Returns the pair that failed if not a match.
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 = forall {a}.
Eq a =>
EitherErr (PTerm, PTerm) [(a, PTerm)]
-> Either (PTerm, PTerm) [(a, PTerm)]
checkRpts 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 (forall t. PArg' t -> t
getTm PArg
x)) (PTerm -> PTerm
fullApp (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 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 forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"fromInteger" Bool -> Bool -> Bool
&& Text
b forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"builtins",
          PConstant FC
_ (I Int
_) <- forall t. PArg' t -> t
getTm PArg
x = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (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 forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"fromInteger" Bool -> Bool -> Bool
&& Text
b forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"builtins",
          PConstant FC
_ (I Int
_) <- forall t. PArg' t -> t
getTm PArg
x = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (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 forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"lazy" = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (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 forall a. Eq a => a -> a -> Bool
== FilePath -> Text
txt FilePath
"lazy" = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x (forall t. PArg' t -> t
getTm PArg
x')
    match (PApp FC
_ PTerm
f [PArg]
args) (PApp FC
_ PTerm
f' [PArg]
args')
        | forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
args forall a. Eq a => a -> a -> Bool
== 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 <- 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'
                 forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mf forall a. [a] -> [a] -> [a]
++ 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 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 forall a. Eq a => a -> a -> Bool
== PTerm
Placeholder)
            = forall (m :: * -> *) a. Monad m => a -> m a
return [(Name
n, PTerm
tm)]
        -- if one namespace is missing, drop the other
        | Name
n forall a. Eq a => a -> a -> Bool
== Name
n' Bool -> Bool -> Bool
|| Name
n forall a. Eq a => a -> a -> Bool
== Name -> Name
dropNS Name
n' Bool -> Bool -> Bool
|| Name -> Name
dropNS Name
n forall a. Eq a => a -> a -> Bool
== Name
n' = 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 forall a. Eq a => a -> a -> Bool
== PTerm
Placeholder)
            = 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 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'
                                         forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml 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'
                                           forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml 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'
                                                     forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml 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'
                                                            forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mt 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 <- 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'
             forall (m :: * -> *) a. Monad m => a -> m a
return (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 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' [PTerm]
as (forall a. a -> [a]
repeat PTerm
b)
             case (forall a b. [Either a b] -> [b]
rights (forall a b. (a -> b) -> [a] -> [b]
map forall a b. EitherErr a b -> Either a b
toEither [EitherErr (PTerm, PTerm) [(Name, PTerm)]]
ms)) of
                ([(Name, PTerm)]
x: [[(Name, PTerm)]]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
x
                [[(Name, PTerm)]]
_ -> forall a b. a -> EitherErr a b
LeftErr (PTerm
a, PTerm
b)
    match (PCase FC
_ PTerm
_ [(PTerm, PTerm)]
_) PTerm
_ = forall (m :: * -> *) a. Monad m => a -> m a
return [] -- lifted out
    match (PMetavar FC
_ Name
_) PTerm
_ = forall (m :: * -> *) a. Monad m => a -> m a
return [] -- modified
    match (PInferRef FC
_ [FC]
_ Name
_) PTerm
_ = forall (m :: * -> *) a. Monad m => a -> m a
return [] -- modified
    match (PQuote Raw
_) PTerm
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PProof [PTactic]
_) PTerm
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PTactics [PTactic]
_) PTerm
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PResolveTC FC
_) (PResolveTC FC
_) = forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PTrue FC
_ PunInfo
_) (PTrue FC
_ PunInfo
_) = 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'
                                                 forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mt 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'
                                                   forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mt 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'
              forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mt forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mty 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 = forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
xs -- to collect variables
          | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return [] -- Otherwise hidden things are unmatchable
    match (PHidden PTerm
x) PTerm
y
          | RightOK [(Name, PTerm)]
xs <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x PTerm
y = forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
xs
          | Bool
otherwise = 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 = forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
xs
          | Bool
otherwise = 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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
    match PTerm
_ PTerm
Placeholder = forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PResolveTC FC
_) PTerm
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
    match PTerm
a PTerm
b | PTerm
a forall a. Eq a => a -> a -> Bool
== PTerm
b = forall (m :: * -> *) a. Monad m => a -> m a
return []
              | Bool
otherwise = 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) = 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' <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
n [(a, PTerm)]
xs = if PTerm
tforall a. Eq a => a -> a -> Bool
/=PTerm
t' Bool -> Bool -> Bool
&& PTerm
tforall a. Eq a => a -> a -> Bool
/=PTerm
Placeholder Bool -> Bool -> Bool
&& PTerm
t'forall a. Eq a => a -> a -> Bool
/=PTerm
Placeholder
                                                then 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 [] = forall a b. b -> Either a b
Right [(a, PTerm)]
ms
    checkRpts (LeftErr (PTerm, PTerm)
x) = 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 []

-- substMatchesShadow :: [(Name, PTerm)] -> [Name] -> PTerm -> PTerm
-- substMatchesShadow [] shs t = t
-- substMatchesShadow ((n,tm):ns) shs t
--    = substMatchShadow n shs tm (substMatchesShadow ns shs t)

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 <- 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 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'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'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 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 forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [PArg] -> PTerm
PApp FC
f ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) (forall a b. (a -> b) -> [a] -> [b]
map (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) (forall a b. (a -> b) -> [a] -> [b]
map (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)
                                                 (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 (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 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 = 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 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 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 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 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) (forall a b. (a -> b) -> [a] -> [b]
map (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) (forall a b. (a -> b) -> [a] -> [b]
map (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) (forall a b. (a -> b) -> [a] -> [b]
map (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) (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 (forall a b. (a -> b) -> [a] -> [b]
map (Name, Name) -> (Name, Name)
shadowAlt [(Name, Name)]
ms) PAltType
a (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 (forall a b. (a -> b) -> [a] -> [b]
map (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 (forall a b. (a -> b) -> [a] -> [b]
map (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 forall a. Num a => a -> a -> a
+ t
1) PTerm
tm) (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 forall a. Num a => a -> a -> a
- t
1) PTerm
tm)
    sm t
ql PTerm
x = 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 forall a. Eq a => a -> a -> Bool
== Name
oldn = Name
n'
                | Bool
otherwise = Name
oldn

-- | Rename any binders which are repeated (so that we don't have to
-- mess about with shadowing anywhere else).
mkUniqueNames :: [Name] -> [(Name, Name)] -> PTerm -> PTerm
mkUniqueNames :: [Name] -> [(Name, Name)] -> PTerm -> PTerm
mkUniqueNames [Name]
env [(Name, Name)]
shadows PTerm
tm
      = 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) (forall a. Ord a => [a] -> Set a
S.fromList [Name]
env) where

  initMap :: Map Name Name
initMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, Name)]
shadows

  inScope :: S.Set Name
  inScope :: Set Name
inScope = forall a. Ord a => [a] -> Set a
S.fromList 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 (forall t. PArg' t -> t
getTm PArg
arg)
                           forall (m :: * -> *) a. Monad m => a -> m a
return (PArg
arg { getTm :: PTerm
getTm = PTerm
t' })

  -- Initialise the unique name with the environment length (so we're not
  -- looking for too long...)
  initN :: Name -> Int -> Name
initN (UN Text
n) Int
l = Text -> Name
UN forall a b. (a -> b) -> a -> b
$ FilePath -> Text
txt (Text -> FilePath
str Text
n forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
l)
  initN (MN Int
i Text
s) Int
l = Int -> Text -> Name
MN (Int
iforall a. Num a => a -> a -> a
+Int
l) Text
s
  initN Name
n Int
_ = Name
n

  -- FIXME: Probably ought to do this for completeness! It's fine as
  -- long as there are no bindings inside tactics though.
  mkUniqT :: p -> p -> a -> m a
mkUniqT p
_ p
nmap a
tac = forall (m :: * -> *) a. Monad m => a -> m a
return a
tac

  mkUniq :: Int -- ^ The number of quotations that we're under
         -> 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 <- forall s (m :: * -> *). MonadState s m => m s
get
              (Name
n', PTerm
sc') <-
                    if Name
n 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 (forall a. Set a -> Int
S.size Set Name
env))
                                                      (forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
                               forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc) -- shadow n n' sc)
                       else forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
              forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
              let nmap' :: Map Name Name
nmap' = 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'
              forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall s (m :: * -> *). MonadState s m => m s
get
              (Name
n', PTerm
sc') <-
                    if Name
n 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 (forall a. Set a -> Int
S.size Set Name
env))
                                                      (forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
                               forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc) -- shadow n n' sc)
                       else forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
              forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
              let nmap' :: Map Name Name
nmap' = 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'
              forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall s (m :: * -> *). MonadState s m => m s
get
              (Name
n', PTerm
sc') <-
                    if Name
n 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 (forall a. Set a -> Int
S.size Set Name
env))
                                                      (forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
                               forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc) -- shadow n n' sc)
                       else forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
              forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
              let nmap' :: Map Name Name
nmap' = 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'
              forall (m :: * -> *) a. Monad m => a -> m a
return 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' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Map Name Name -> PArg -> StateT (Set Name) Identity PArg
mkUniqA Int
0 Map Name Name
nmap) [PArg]
args
              forall (m :: * -> *) a. Monad m => a -> m a
return 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' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Map Name Name -> PArg -> StateT (Set Name) Identity PArg
mkUniqA Int
0 Map Name Name
nmap) [PArg]
args
              forall (m :: * -> *) a. Monad m => a -> m a
return 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' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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
                                         forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm
x', PTerm
y')) [(PTerm, PTerm)]
alts
              forall (m :: * -> *) a. Monad m => a -> m a
return 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)
         = 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
              forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Eq a => a -> a -> Bool
/= PTerm
Placeholder
         = do Set Name
env <- forall s (m :: * -> *). MonadState s m => m s
get
              (Name
n', PTerm
sc') <- if Name
n 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 (forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
                                      forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc) -- shadow n n' sc)
                              else forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
              forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
              let nmap' :: Map Name Name
nmap' = 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'
              forall (m :: * -> *) a. Monad m => a -> m a
return 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
              forall (m :: * -> *) a. Monad m => a -> m a
return 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)
         -- store the nmap and defer the rest until we've pruned the set
         -- during elaboration
         = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative ([(Name, Name)]
ns forall a. [a] -> [a] -> [a]
++ 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) = 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) = 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) = 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) = 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) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [PTactic] -> PTerm
PProof (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [PTactic] -> PTerm
PTactics (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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) = 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) = 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) = 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> PTerm -> PTerm
shadowAll (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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                Just PTerm
t -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just 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
       forall (m :: * -> *) a. Monad m => a -> m a
return 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) = 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 forall a. Num a => a -> a -> a
- Int
1) Map Name Name
nmap PTerm
tm)

  mkUniq Int
ql Map Name Name
nmap PTerm
tm = forall on (m :: * -> *).
(Uniplate on, Applicative m) =>
(on -> m on) -> on -> m on
descendM (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
ql Map Name Name
nmap) PTerm
tm