{-|
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; Context -> Idris Context
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> Context
tt_ctxt IState
i)

forCodegen :: Codegen -> [(Codegen, a)] -> [a]
forCodegen :: Codegen -> [(Codegen, a)] -> [a]
forCodegen tgt :: Codegen
tgt xs :: [(Codegen, a)]
xs = [a
x | (tgt' :: Codegen
tgt', x :: a
x) <- [(Codegen, a)]
xs, Codegen -> Codegen -> Bool
eqLang Codegen
tgt Codegen
tgt']
    where
        eqLang :: Codegen -> Codegen -> Bool
eqLang (Via _ x :: String
x) (Via _ y :: String
y) = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y
        eqLang Bytecode Bytecode = Bool
True
        eqLang _ _ = Bool
False

getObjectFiles :: Codegen -> Idris [FilePath]
getObjectFiles :: Codegen -> Idris [String]
getObjectFiles tgt :: Codegen
tgt = do IState
i <- Idris IState
getIState; [String] -> Idris [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (Codegen -> [(Codegen, String)] -> [String]
forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt ([(Codegen, String)] -> [String])
-> [(Codegen, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, String)]
idris_objs IState
i)

addObjectFile :: Codegen -> FilePath -> Idris ()
addObjectFile :: Codegen -> String -> Idris ()
addObjectFile tgt :: Codegen
tgt f :: String
f = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_objs :: [(Codegen, String)]
idris_objs = [(Codegen, String)] -> [(Codegen, String)]
forall a. Eq a => [a] -> [a]
nub ([(Codegen, String)] -> [(Codegen, String)])
-> [(Codegen, String)] -> [(Codegen, String)]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, String)]
idris_objs IState
i [(Codegen, String)] -> [(Codegen, String)] -> [(Codegen, String)]
forall a. [a] -> [a] -> [a]
++ [(Codegen
tgt, String
f)] }

getLibs :: Codegen -> Idris [String]
getLibs :: Codegen -> Idris [String]
getLibs tgt :: Codegen
tgt = do IState
i <- Idris IState
getIState; [String] -> Idris [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (Codegen -> [(Codegen, String)] -> [String]
forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt ([(Codegen, String)] -> [String])
-> [(Codegen, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, String)]
idris_libs IState
i)

addLib :: Codegen -> String -> Idris ()
addLib :: Codegen -> String -> Idris ()
addLib tgt :: Codegen
tgt f :: String
f = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_libs :: [(Codegen, String)]
idris_libs = [(Codegen, String)] -> [(Codegen, String)]
forall a. Eq a => [a] -> [a]
nub ([(Codegen, String)] -> [(Codegen, String)])
-> [(Codegen, String)] -> [(Codegen, String)]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, String)]
idris_libs IState
i [(Codegen, String)] -> [(Codegen, String)] -> [(Codegen, String)]
forall a. [a] -> [a] -> [a]
++ [(Codegen
tgt, String
f)] }

getFlags :: Codegen -> Idris [String]
getFlags :: Codegen -> Idris [String]
getFlags tgt :: Codegen
tgt = do IState
i <- Idris IState
getIState; [String] -> Idris [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (Codegen -> [(Codegen, String)] -> [String]
forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt ([(Codegen, String)] -> [String])
-> [(Codegen, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, String)]
idris_cgflags IState
i)

addFlag :: Codegen -> String -> Idris ()
addFlag :: Codegen -> String -> Idris ()
addFlag tgt :: Codegen
tgt f :: String
f = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_cgflags :: [(Codegen, String)]
idris_cgflags = [(Codegen, String)] -> [(Codegen, String)]
forall a. Eq a => [a] -> [a]
nub ([(Codegen, String)] -> [(Codegen, String)])
-> [(Codegen, String)] -> [(Codegen, String)]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, String)]
idris_cgflags IState
i [(Codegen, String)] -> [(Codegen, String)] -> [(Codegen, String)]
forall a. [a] -> [a] -> [a]
++ [(Codegen
tgt, String
f)] }

addDyLib :: [String] -> Idris (Either DynamicLib String)
addDyLib :: [String] -> Idris (Either DynamicLib String)
addDyLib libs :: [String]
libs = do IState
i <- Idris IState
getIState
                   let ls :: [DynamicLib]
ls = IState -> [DynamicLib]
idris_dynamic_libs IState
i
                   let importdirs :: [String]
importdirs = IOption -> [String]
opt_importdirs (IState -> IOption
idris_options IState
i)
                   case (String -> Maybe DynamicLib) -> [String] -> [DynamicLib]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([DynamicLib] -> String -> Maybe DynamicLib
findDyLib [DynamicLib]
ls) [String]
libs of
                     x :: DynamicLib
x:_ -> Either DynamicLib String -> Idris (Either DynamicLib String)
forall (m :: * -> *) a. Monad m => a -> m a
return (DynamicLib -> Either DynamicLib String
forall a b. a -> Either a b
Left DynamicLib
x)
                     [] -> do
                       [Maybe DynamicLib]
handle <- ExceptT Err IO [Maybe DynamicLib]
-> StateT IState (ExceptT Err IO) [Maybe DynamicLib]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Err IO [Maybe DynamicLib]
 -> StateT IState (ExceptT Err IO) [Maybe DynamicLib])
-> ([String] -> ExceptT Err IO [Maybe DynamicLib])
-> [String]
-> StateT IState (ExceptT Err IO) [Maybe DynamicLib]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [Maybe DynamicLib] -> ExceptT Err IO [Maybe DynamicLib]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [Maybe DynamicLib] -> ExceptT Err IO [Maybe DynamicLib])
-> ([String] -> IO [Maybe DynamicLib])
-> [String]
-> ExceptT Err IO [Maybe DynamicLib]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 (String -> IO (Maybe DynamicLib))
-> [String] -> IO [Maybe DynamicLib]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\l :: String
l -> IO (Maybe DynamicLib)
-> (IOError -> IO (Maybe DynamicLib)) -> IO (Maybe DynamicLib)
forall a. IO a -> (IOError -> IO a) -> IO a
catchIO ([String] -> String -> IO (Maybe DynamicLib)
tryLoadLib [String]
importdirs String
l)
                                                     (\_ -> Maybe DynamicLib -> IO (Maybe DynamicLib)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DynamicLib
forall a. Maybe a
Nothing)) ([String] -> StateT IState (ExceptT Err IO) [Maybe DynamicLib])
-> [String] -> StateT IState (ExceptT Err IO) [Maybe DynamicLib]
forall a b. (a -> b) -> a -> b
$ [String]
libs
                       case [Maybe DynamicLib] -> Maybe DynamicLib
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Maybe DynamicLib]
handle of
                         Nothing -> Either DynamicLib String -> Idris (Either DynamicLib String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either DynamicLib String
forall a b. b -> Either a b
Right (String -> Either DynamicLib String)
-> String -> Either DynamicLib String
forall a b. (a -> b) -> a -> b
$ "Could not load dynamic alternatives \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "," [String]
libs String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\"")
                         Just x :: DynamicLib
x -> do IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_dynamic_libs :: [DynamicLib]
idris_dynamic_libs = DynamicLib
xDynamicLib -> [DynamicLib] -> [DynamicLib]
forall a. a -> [a] -> [a]
:[DynamicLib]
ls }
                                      Either DynamicLib String -> Idris (Either DynamicLib String)
forall (m :: * -> *) a. Monad m => a -> m a
return (DynamicLib -> Either DynamicLib String
forall a b. a -> Either a b
Left DynamicLib
x)
    where findDyLib :: [DynamicLib] -> String -> Maybe DynamicLib
          findDyLib :: [DynamicLib] -> String -> Maybe DynamicLib
findDyLib []         _                     = Maybe DynamicLib
forall a. Maybe a
Nothing
          findDyLib (lib :: DynamicLib
lib:libs' :: [DynamicLib]
libs') l :: String
l | String
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== DynamicLib -> String
lib_name DynamicLib
lib = DynamicLib -> Maybe DynamicLib
forall a. a -> Maybe a
Just DynamicLib
lib
                                  | Bool
otherwise         = [DynamicLib] -> String -> Maybe DynamicLib
findDyLib [DynamicLib]
libs' String
l

getAutoImports :: Idris [FilePath]
getAutoImports :: Idris [String]
getAutoImports = do IState
i <- Idris IState
getIState
                    [String] -> Idris [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> [String]
opt_autoImport (IState -> IOption
idris_options IState
i))

addAutoImport :: FilePath -> Idris ()
addAutoImport :: String -> Idris ()
addAutoImport fp :: String
fp = do IState
i <- Idris IState
getIState
                      let opts :: IOption
opts = IState -> IOption
idris_options IState
i
                      IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_options :: IOption
idris_options = IOption
opts { opt_autoImport :: [String]
opt_autoImport =
                                                       String
fp String -> [String] -> [String]
forall a. a -> [a] -> [a]
: IOption -> [String]
opt_autoImport IOption
opts } } )

addDefinedName :: Name -> Idris ()
addDefinedName :: Name -> Idris ()
addDefinedName n :: Name
n = do IState
ist <- Idris IState
getIState
                      IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_inmodule :: Set Name
idris_inmodule = Name -> Set Name -> Set Name
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
                     [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Name -> [Name]
forall a. Set a -> [a]
S.toList (IState -> Set Name
idris_inmodule IState
ist))

addTT :: Term -> Idris (Maybe Term)
addTT :: Term -> Idris (Maybe Term)
addTT t :: Term
t = do IState
ist <- Idris IState
getIState
             case Term -> Map Term (Int, Term) -> Maybe (Int, Term)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Term
t (IState -> Map Term (Int, Term)
idris_ttstats IState
ist) of
                  Nothing -> do let tt' :: Map Term (Int, Term)
tt' = Term -> (Int, Term) -> Map Term (Int, Term) -> Map Term (Int, Term)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Term
t (1, Term
t) (IState -> Map Term (Int, Term)
idris_ttstats IState
ist)
                                IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_ttstats :: Map Term (Int, Term)
idris_ttstats = Map Term (Int, Term)
tt' }
                                Maybe Term -> Idris (Maybe Term)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Term
forall a. Maybe a
Nothing
                  Just (i :: Int
i, t' :: Term
t') -> do let tt' :: Map Term (Int, Term)
tt' = Term -> (Int, Term) -> Map Term (Int, Term) -> Map Term (Int, Term)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Term
t' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, Term
t') (IState -> Map Term (Int, Term)
idris_ttstats IState
ist)
                                     IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_ttstats :: Map Term (Int, Term)
idris_ttstats = Map Term (Int, Term)
tt' }
                                     Maybe Term -> Idris (Maybe Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Maybe Term
forall a. a -> Maybe a
Just Term
t')

dumpTT :: Idris ()
dumpTT :: Idris ()
dumpTT = do IState
ist <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
            let sts :: [(Term, (Int, Term))]
sts = ((Term, (Int, Term)) -> (Term, (Int, Term)) -> Ordering)
-> [(Term, (Int, Term))] -> [(Term, (Int, Term))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Term, (Int, Term)) -> (Term, (Int, Term)) -> Ordering
forall a a a. Ord a => (a, a) -> (a, a) -> Ordering
count (Map Term (Int, Term) -> [(Term, (Int, Term))]
forall k a. Map k a -> [(k, a)]
M.toList (IState -> Map Term (Int, Term)
idris_ttstats IState
ist))
            ((Term, (Int, Term)) -> Idris ())
-> [(Term, (Int, Term))] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term, (Int, Term)) -> Idris ()
forall a a. (Show a, Show a) => (a, a) -> Idris ()
dump [(Term, (Int, Term))]
sts
            () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    count :: (a, a) -> (a, a) -> Ordering
count (_,x :: a
x) (_,y :: a
y) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
y a
x
    dump :: (a, a) -> Idris ()
dump (tm :: a
tm, val :: a
val) = IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> IO () -> Idris ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
val String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
tm)

addHdr :: Codegen -> String -> Idris ()
addHdr :: Codegen -> String -> Idris ()
addHdr tgt :: Codegen
tgt f :: String
f = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_hdrs :: [(Codegen, String)]
idris_hdrs = [(Codegen, String)] -> [(Codegen, String)]
forall a. Eq a => [a] -> [a]
nub ([(Codegen, String)] -> [(Codegen, String)])
-> [(Codegen, String)] -> [(Codegen, String)]
forall a b. (a -> b) -> a -> b
$ (Codegen
tgt, String
f) (Codegen, String) -> [(Codegen, String)] -> [(Codegen, String)]
forall a. a -> [a] -> [a]
: IState -> [(Codegen, String)]
idris_hdrs IState
i }

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

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

dropLangExt :: LanguageExt -> Idris ()
dropLangExt :: LanguageExt -> Idris ()
dropLangExt e :: LanguageExt
e = do IState
i <- Idris IState
getIState
                   IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i {
                     idris_language_extensions :: [LanguageExt]
idris_language_extensions = IState -> [LanguageExt]
idris_language_extensions IState
i [LanguageExt] -> [LanguageExt] -> [LanguageExt]
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 basefn :: Name
basefn t :: (Term, Term)
t
           = do IState
i <- Idris IState
getIState
                let t' :: [(Term, Term)]
t' = case Name -> Ctxt [(Term, Term)] -> Maybe [(Term, Term)]
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
basefn (IState -> Ctxt [(Term, Term)]
idris_transforms IState
i) of
                              Just def :: [(Term, Term)]
def -> ((Term, Term)
t (Term, Term) -> [(Term, Term)] -> [(Term, Term)]
forall a. a -> [a] -> [a]
: [(Term, Term)]
def)
                              Nothing -> [(Term, Term)
t]
                IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_transforms :: Ctxt [(Term, Term)]
idris_transforms = Name
-> [(Term, Term)] -> Ctxt [(Term, Term)] -> Ctxt [(Term, Term)]
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 t :: (Term, Term)
t = do IState
i <- Idris IState
getIState
                 IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_errRev :: [(Term, Term)]
idris_errRev = (Term, Term)
t (Term, Term) -> [(Term, Term)] -> [(Term, Term)]
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 t :: Name
t = do IState
i <- Idris IState
getIState
                    IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_errReduce :: [Name]
idris_errReduce = Name
t Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: IState -> [Name]
idris_errReduce IState
i }

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

addExport :: Name -> Idris ()
addExport :: Name -> Idris ()
addExport n :: Name
n = do IState
ist <- Idris IState
getIState
                 IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_exports :: [Name]
idris_exports = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: IState -> [Name]
idris_exports IState
ist }

addUsedName :: FC -> Name -> Name -> Idris ()
addUsedName :: FC -> Name -> Name -> Idris ()
addUsedName fc :: FC
fc n :: Name
n arg :: Name
arg
    = do IState
ist <- Idris IState
getIState
         case Name -> Context -> [(Name, Term)]
lookupTyName Name
n (IState -> Context
tt_ctxt IState
ist) of
              [(n' :: Name
n', ty :: Term
ty)] -> Name -> Int -> Term -> Idris ()
addUsage Name
n' 0 Term
ty
              [] -> Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc (Name -> Err
forall t. Name -> Err' t
NoSuchVariable Name
n))
              xs :: [(Name, Term)]
xs -> Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc ([Name] -> Err
forall t. [Name] -> Err' t
CantResolveAlts (((Name, Term) -> Name) -> [(Name, Term)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Term) -> Name
forall a b. (a, b) -> a
fst [(Name, Term)]
xs)))
  where addUsage :: Name -> Int -> Term -> Idris ()
addUsage n :: Name
n i :: Int
i (Bind x :: Name
x _ sc :: Term
sc) | Name
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
arg = do IBCWrite -> Idris ()
addIBC ((Name, Int) -> IBCWrite
IBCUsage (Name
n, Int
i))
                                                   Name -> Int -> Idris ()
addErasureUsage Name
n Int
i
                                   | Bool
otherwise = Name -> Int -> Term -> Idris ()
addUsage Name
n (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Term
sc
        addUsage _ _ _ = Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc (String -> Err
forall t. String -> Err' t
Msg ("No such argument name " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
arg)))

getErasureUsage :: Idris [(Name, Int)]
getErasureUsage :: Idris [(Name, Int)]
getErasureUsage = do IState
ist <- Idris IState
getIState;
                     [(Name, Int)] -> Idris [(Name, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> [(Name, Int)]
idris_erasureUsed IState
ist)

getExports :: Idris [Name]
getExports :: Idris [Name]
getExports = do IState
ist <- Idris IState
getIState
                [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> [Name]
idris_exports IState
ist)

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

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

setFlags :: Name -> [FnOpt] -> Idris ()
setFlags :: Name -> [FnOpt] -> Idris ()
setFlags n :: Name
n fs :: [FnOpt]
fs = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_flags :: Ctxt [FnOpt]
idris_flags = Name -> [FnOpt] -> Ctxt [FnOpt] -> Ctxt [FnOpt]
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 n :: Name
n f :: FnOpt
f = do IState
i <- Idris IState
getIState
                  let fls :: [FnOpt]
fls = case Name -> Ctxt [FnOpt] -> Maybe [FnOpt]
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt [FnOpt]
idris_flags IState
i) of
                                 Nothing -> []
                                 Just x :: [FnOpt]
x -> [FnOpt]
x
                  Name -> [FnOpt] -> Idris ()
setFlags Name
n (FnOpt
f FnOpt -> [FnOpt] -> [FnOpt]
forall a. a -> [a] -> [a]
: [FnOpt]
fls)

setFnInfo :: Name -> FnInfo -> Idris ()
setFnInfo :: Name -> FnInfo -> Idris ()
setFnInfo n :: Name
n fs :: FnInfo
fs = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_fninfo :: Ctxt FnInfo
idris_fninfo = Name -> FnInfo -> Ctxt FnInfo -> Ctxt 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 n :: Name
n a :: Accessibility
a
         = do IState
i <- Idris IState
getIState
              let ctxt :: Context
ctxt = Name -> Accessibility -> Context -> Context
setAccess Name
n Accessibility
a (IState -> Context
tt_ctxt IState
i)
              IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt :: 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 n :: Name
n = do IState
i <- Idris IState
getIState
                       Maybe Accessibility -> Idris (Maybe Accessibility)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Accessibility -> Idris (Maybe Accessibility))
-> Maybe Accessibility -> Idris (Maybe Accessibility)
forall a b. (a -> b) -> a -> b
$ Name -> Ctxt Accessibility -> Maybe Accessibility
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt Accessibility
hide_list IState
i)

setTotality :: Name -> Totality -> Idris ()
setTotality :: Name -> Totality -> Idris ()
setTotality n :: Name
n a :: Totality
a
         = do IState
i <- Idris IState
getIState
              let ctxt :: Context
ctxt = Name -> Totality -> Context -> Context
setTotal Name
n Totality
a (IState -> Context
tt_ctxt IState
i)
              IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt :: Context
tt_ctxt = Context
ctxt }

setInjectivity :: Name -> Injectivity -> Idris ()
setInjectivity :: Name -> Bool -> Idris ()
setInjectivity n :: Name
n a :: Bool
a
         = do IState
i <- Idris IState
getIState
              let ctxt :: Context
ctxt = Name -> Bool -> Context -> Context
setInjective Name
n Bool
a (IState -> Context
tt_ctxt IState
i)
              IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt :: Context
tt_ctxt = Context
ctxt }

getTotality :: Name -> Idris Totality
getTotality :: Name -> Idris Totality
getTotality n :: Name
n
         = do IState
i <- Idris IState
getIState
              case Name -> Context -> [Totality]
lookupTotal Name
n (IState -> Context
tt_ctxt IState
i) of
                [t :: Totality
t] -> Totality -> Idris Totality
forall (m :: * -> *) a. Monad m => a -> m a
return Totality
t
                _ -> Totality -> Idris 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 i :: IState
i ty :: Term
ty =
    let cs :: [Name]
cs = IState -> [Name]
idris_coercions IState
i
        (fn :: Term
fn,_) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply (Term -> Term
forall n. TT n -> TT n
getRetTy Term
ty) in
        Term -> [Name] -> [Name]
findCoercions Term
fn [Name]
cs
    where findCoercions :: Term -> [Name] -> [Name]
findCoercions _ [] = []
          findCoercions t :: Term
t (n :: Name
n : ns :: [Name]
ns) =
             let ps :: [Name]
ps = case Name -> Context -> [Term]
lookupTy Name
n (IState -> Context
tt_ctxt IState
i) of
                        [ty' :: Term
ty'] -> case Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply (Term -> Term
forall n. TT n -> TT n
getRetTy (Context -> Env -> Term -> Term
normalise (IState -> Context
tt_ctxt IState
i) [] Term
ty')) of
                                   (t' :: Term
t', _) -> [Name
n | Term
t Term -> Term -> Bool
forall a. Eq a => a -> a -> Bool
== Term
t']
                        _ -> [] in
                 [Name]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ Term -> [Name] -> [Name]
findCoercions Term
t [Name]
ns

addToCG :: Name -> CGInfo -> Idris ()
addToCG :: Name -> CGInfo -> Idris ()
addToCG n :: Name
n cg :: CGInfo
cg
   = do IState
i <- Idris IState
getIState
        IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_callgraph :: Ctxt CGInfo
idris_callgraph = Name -> CGInfo -> Ctxt CGInfo -> Ctxt CGInfo
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 n :: Name
n calls :: [Name]
calls
   = do IState
i <- Idris IState
getIState
        case Name -> Ctxt CGInfo -> Maybe CGInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt CGInfo
idris_callgraph IState
i) of
             Nothing -> Name -> CGInfo -> Idris ()
addToCG Name
n ([Name]
-> Maybe [Name] -> [SCGEntry] -> [(Int, [(Name, Int)])] -> CGInfo
CGInfo [Name]
calls Maybe [Name]
forall a. Maybe a
Nothing [] [])
             Just (CGInfo cs :: [Name]
cs ans :: Maybe [Name]
ans scg :: [SCGEntry]
scg used :: [(Int, [(Name, Int)])]
used) ->
                Name -> CGInfo -> Idris ()
addToCG Name
n ([Name]
-> Maybe [Name] -> [SCGEntry] -> [(Int, [(Name, Int)])] -> CGInfo
CGInfo ([Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
calls [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
cs)) Maybe [Name]
ans [SCGEntry]
scg [(Int, [(Name, Int)])]
used)

addTyInferred :: Name -> Idris ()
addTyInferred :: Name -> Idris ()
addTyInferred n :: Name
n
   = do IState
i <- Idris IState
getIState
        IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_tyinfodata :: Ctxt TIData
idris_tyinfodata =
                        Name -> TIData -> Ctxt TIData -> Ctxt TIData
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
fc ts :: [(Term, Term)]
ts = do Int -> String -> Idris ()
logLvl 2 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "TI missing: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Term, Term)] -> String
forall a. Show a => a -> String
show [(Term, Term)]
ts
                               ((Term, Term) -> Idris ()) -> [(Term, Term)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term, Term) -> Idris ()
addConstraint [(Term, Term)]
ts
                               () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where addConstraint :: (Term, Term) -> Idris ()
addConstraint (x :: Term
x, y :: Term
y) = Term -> Term -> Idris ()
findMVApps Term
x Term
y

          findMVApps :: Term -> Term -> Idris ()
findMVApps x :: Term
x y :: Term
y
             = do let (fx :: Term
fx, argsx :: [Term]
argsx) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
x
                  let (fy :: Term
fy, argsy :: [Term]
argsy) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
y
                  if (Term
fx Term -> Term -> Bool
forall a. Eq a => a -> a -> Bool
/= Term
fy)
                     then do
                       Term -> Term -> Idris ()
tryAddMV Term
fx Term
y
                       Term -> Term -> Idris ()
tryAddMV Term
fy Term
x
                     else ((Term, Term) -> Idris ()) -> [(Term, Term)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term, Term) -> Idris ()
addConstraint ([Term] -> [Term] -> [(Term, Term)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Term]
argsx [Term]
argsy)

          tryAddMV :: Term -> Term -> Idris ()
tryAddMV (P _ mv :: Name
mv _) y :: Term
y =
               do IState
ist <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
                  case Name
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
-> Maybe (Maybe Name, Int, [Name], Bool, Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
mv (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
ist) of
                       Just _ -> Name -> Term -> Idris ()
addConstraintRule Name
mv Term
y
                       _ -> () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          tryAddMV _ _ = () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

          addConstraintRule :: Name -> Term -> Idris ()
          addConstraintRule :: Name -> Term -> Idris ()
addConstraintRule n :: Name
n t :: Term
t
             = do IState
ist <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
                  Int -> String -> Idris ()
logLvl 1 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "TI constraint: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Name, Term) -> String
forall a. Show a => a -> String
show (Name
n, Term
t)
                  case Name -> Ctxt TIData -> [TIData]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt TIData
idris_tyinfodata IState
ist) of
                     [TISolution ts :: [Term]
ts] ->
                         do (Term -> Idris ()) -> [Term] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Term -> Term -> Idris ()
checkConsistent Term
t) [Term]
ts
                            let ti' :: Ctxt TIData
ti' = Name -> TIData -> Ctxt TIData -> Ctxt TIData
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n ([Term] -> TIData
TISolution (Term
t Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: [Term]
ts))
                                               (IState -> Ctxt TIData
idris_tyinfodata IState
ist)
                            IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_tyinfodata :: Ctxt TIData
idris_tyinfodata = Ctxt TIData
ti' }
                     _ ->
                         do let ti' :: Ctxt TIData
ti' = Name -> TIData -> Ctxt TIData -> Ctxt TIData
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n ([Term] -> TIData
TISolution [Term
t])
                                               (IState -> Ctxt TIData
idris_tyinfodata IState
ist)
                            IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_tyinfodata :: 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 x :: Term
x y :: Term
y =
              do let (fx :: Term
fx, _) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
x
                 let (fy :: Term
fy, _) = Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
y
                 case (Term
fx, Term
fy) of
                      (P (TCon _ _) n :: Name
n _, P (TCon _ _) n' :: Name
n' _) -> Bool -> Idris ()
errWhen (Name
nName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
n')
                      (P (TCon _ _) n :: Name
n _, Constant _) -> Bool -> Idris ()
errWhen Bool
True
                      (Constant _, P (TCon _ _) n' :: Name
n' _) -> Bool -> Idris ()
errWhen Bool
True
                      (P (DCon _ _ _) n :: Name
n _, P (DCon _ _ _) n' :: Name
n' _) -> Bool -> Idris ()
errWhen (Name
nName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
n')
                      _ -> () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

              where errWhen :: Bool -> Idris ()
errWhen True
                       = Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc
                            (Bool
-> (Term, Maybe Provenance)
-> (Term, Maybe Provenance)
-> Err
-> [(Name, Term)]
-> Int
-> Err
forall t.
Bool
-> (t, Maybe Provenance)
-> (t, Maybe Provenance)
-> Err' t
-> [(Name, t)]
-> Int
-> Err' t
CantUnify Bool
False (Term
x, Maybe Provenance
forall a. Maybe a
Nothing) (Term
y, Maybe Provenance
forall a. Maybe a
Nothing) (String -> Err
forall t. String -> Err' t
Msg "") [] 0))
                    errWhen False = () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isTyInferred :: Name -> Idris Bool
isTyInferred :: Name -> Idris Bool
isTyInferred n :: Name
n
   = do IState
i <- Idris IState
getIState
        case Name -> Ctxt TIData -> [TIData]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt TIData
idris_tyinfodata IState
i) of
             [TIPartial] -> Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
             _ -> Bool -> Idris Bool
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 f :: Name
f arg :: Name
arg hs :: [Name]
hs =
 do IState
i <- Idris IState
getIState
    let oldHandlers :: Ctxt (Map Name (Set Name))
oldHandlers = IState -> Ctxt (Map Name (Set Name))
idris_function_errorhandlers IState
i
    let newHandlers :: Ctxt (Map Name (Set Name))
newHandlers = (Map Name (Set Name)
 -> Ctxt (Map Name (Set Name)) -> Ctxt (Map Name (Set Name)))
-> Ctxt (Map Name (Set Name))
-> Map Name (Set Name)
-> Ctxt (Map Name (Set Name))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name
-> Map Name (Set Name)
-> Ctxt (Map Name (Set Name))
-> Ctxt (Map Name (Set Name))
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
f) Ctxt (Map Name (Set Name))
oldHandlers (Map Name (Set Name) -> Ctxt (Map Name (Set Name)))
-> Map Name (Set Name) -> Ctxt (Map Name (Set Name))
forall a b. (a -> b) -> a -> b
$
                      case Name -> Ctxt (Map Name (Set Name)) -> Maybe (Map Name (Set Name))
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
f Ctxt (Map Name (Set Name))
oldHandlers of
                        Nothing            -> Name -> Set Name -> Map Name (Set Name)
forall k a. k -> a -> Map k a
M.singleton Name
arg ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList [Name]
hs)
                        Just (Map Name (Set Name)
oldHandlers) -> (Set Name -> Set Name -> Set Name)
-> Name -> Set Name -> Map Name (Set Name) -> Map Name (Set Name)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Name
arg ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList [Name]
hs) Map Name (Set Name)
oldHandlers
                        -- will always be one of those two, thus no extra case
    IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
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 n :: Name
n = do IState
i <- Idris IState
getIState
                   case IState -> Name -> Maybe [Name]
getCGAllNames IState
i Name
n of
                        Just ns :: [Name]
ns -> [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns
                        Nothing -> do [Name]
ns <- [Name] -> Name -> Idris [Name]
allNames [] Name
n
                                      IState -> Name -> [Name] -> Idris ()
addCGAllNames IState
i Name
n [Name]
ns
                                      [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns

getCGAllNames :: IState -> Name -> Maybe [Name]
getCGAllNames :: IState -> Name -> Maybe [Name]
getCGAllNames i :: IState
i n :: Name
n = case Name -> Ctxt CGInfo -> Maybe CGInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt CGInfo
idris_callgraph IState
i) of
                         Just ci :: CGInfo
ci -> CGInfo -> Maybe [Name]
allCalls CGInfo
ci
                         _ -> Maybe [Name]
forall a. Maybe a
Nothing

addCGAllNames :: IState -> Name -> [Name] -> Idris ()
addCGAllNames :: IState -> Name -> [Name] -> Idris ()
addCGAllNames i :: IState
i n :: Name
n ns :: [Name]
ns
      = case Name -> Ctxt CGInfo -> Maybe CGInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt CGInfo
idris_callgraph IState
i) of
             Just ci :: CGInfo
ci -> Name -> CGInfo -> Idris ()
addToCG Name
n (CGInfo
ci { allCalls :: Maybe [Name]
allCalls = [Name] -> Maybe [Name]
forall a. a -> Maybe a
Just [Name]
ns })
             _ -> Name -> CGInfo -> Idris ()
addToCG Name
n ([Name]
-> Maybe [Name] -> [SCGEntry] -> [(Int, [(Name, Int)])] -> CGInfo
CGInfo [] ([Name] -> Maybe [Name]
forall a. a -> Maybe a
Just [Name]
ns) [] [])

allNames :: [Name] -> Name -> Idris [Name]
allNames :: [Name] -> Name -> Idris [Name]
allNames ns :: [Name]
ns n :: Name
n | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns = [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return []
allNames ns :: [Name]
ns n :: Name
n = do IState
i <- Idris IState
getIState
                   case IState -> Name -> Maybe [Name]
getCGAllNames IState
i Name
n of
                        Just ns :: [Name]
ns -> [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns
                        Nothing -> case Name -> Ctxt CGInfo -> Maybe CGInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt CGInfo
idris_callgraph IState
i) of
                                        Just ci :: CGInfo
ci ->
                                          do [[Name]]
more <- (Name -> Idris [Name])
-> [Name] -> StateT IState (ExceptT Err IO) [[Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Name] -> Name -> Idris [Name]
allNames (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ns)) (CGInfo -> [Name]
calls CGInfo
ci)
                                             let ns' :: [Name]
ns' = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
more)
                                             IState -> Name -> [Name] -> Idris ()
addCGAllNames IState
i Name
n [Name]
ns'
                                             [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns'
                                        _ -> [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
n]

addCoercion :: Name -> Idris ()
addCoercion :: Name -> Idris ()
addCoercion n :: Name
n = do IState
i <- Idris IState
getIState
                   IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_coercions :: [Name]
idris_coercions = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ Name
n Name -> [Name] -> [Name]
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 n :: Name
n doc :: Docstring DocTerm
doc args :: [(Name, Docstring DocTerm)]
args
   = do IState
i <- Idris IState
getIState
        IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_docstrings :: Ctxt (Docstring DocTerm, [(Name, Docstring DocTerm)])
idris_docstrings = Name
-> (Docstring DocTerm, [(Name, Docstring DocTerm)])
-> Ctxt (Docstring DocTerm, [(Name, Docstring DocTerm)])
-> Ctxt (Docstring DocTerm, [(Name, Docstring DocTerm)])
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 ty :: Name
ty n :: Name
n
   = do IState
i <- Idris IState
getIState
        Name
ty' <- case Name -> Ctxt [PArg] -> [(Name, [PArg])]
forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
ty (IState -> Ctxt [PArg]
idris_implicits IState
i) of
                       [(tyn :: Name
tyn, _)] -> Name -> StateT IState (ExceptT Err IO) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
tyn
                       [] -> Err -> StateT IState (ExceptT Err IO) Name
forall a. Err -> Idris a
throwError (Name -> Err
forall t. Name -> Err' t
NoSuchVariable Name
ty)
                       tyns :: [(Name, [PArg])]
tyns -> Err -> StateT IState (ExceptT Err IO) Name
forall a. Err -> Idris a
throwError ([Name] -> Err
forall t. [Name] -> Err' t
CantResolveAlts (((Name, [PArg]) -> Name) -> [(Name, [PArg])] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [PArg]) -> Name
forall a b. (a, b) -> a
fst [(Name, [PArg])]
tyns))
        let ns' :: [Name]
ns' = case Name -> Ctxt [Name] -> [[Name]]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
ty' (IState -> Ctxt [Name]
idris_namehints IState
i) of
                       [ns :: [Name]
ns] -> [Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
n]
                       _ -> [Name
n]
        IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_namehints :: Ctxt [Name]
idris_namehints = Name -> [Name] -> Ctxt [Name] -> Ctxt [Name]
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 _ (UN arr :: Text
arr) | Text
arr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
txt "->" = [String -> Name
sUN "f",String -> Name
sUN "g"]
getNameHints i :: IState
i n :: Name
n =
        case Name -> Ctxt [Name] -> [[Name]]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt [Name]
idris_namehints IState
i) of
             [ns :: [Name]
ns] -> [Name]
ns
             _ -> []

addDeprecated :: Name -> String -> Idris ()
addDeprecated :: Name -> String -> Idris ()
addDeprecated n :: Name
n reason :: String
reason = do
  IState
i <- Idris IState
getIState
  IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_deprecated :: Ctxt String
idris_deprecated = Name -> String -> Ctxt String -> Ctxt String
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n String
reason (IState -> Ctxt String
idris_deprecated IState
i) }

getDeprecated :: Name -> Idris (Maybe String)
getDeprecated :: Name -> Idris (Maybe String)
getDeprecated n :: Name
n = do
  IState
i <- Idris IState
getIState
  Maybe String -> Idris (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Idris (Maybe String))
-> Maybe String -> Idris (Maybe String)
forall a b. (a -> b) -> a -> b
$ Name -> Ctxt String -> Maybe String
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt String
idris_deprecated IState
i)

addFragile :: Name -> String -> Idris ()
addFragile :: Name -> String -> Idris ()
addFragile n :: Name
n reason :: String
reason = do
  IState
i <- Idris IState
getIState
  IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_fragile :: Ctxt String
idris_fragile = Name -> String -> Ctxt String -> Ctxt String
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n String
reason (IState -> Ctxt String
idris_fragile IState
i) }

getFragile :: Name -> Idris (Maybe String)
getFragile :: Name -> Idris (Maybe String)
getFragile n :: Name
n = do
  IState
i <- Idris IState
getIState
  Maybe String -> Idris (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Idris (Maybe String))
-> Maybe String -> Idris (Maybe String)
forall a b. (a -> b) -> a -> b
$ Name -> Ctxt String -> Maybe String
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt String
idris_fragile IState
i)

push_estack :: Name -> Bool -> Idris ()
push_estack :: Name -> Bool -> Idris ()
push_estack n :: Name
n implementation :: Bool
implementation
    = do IState
i <- Idris IState
getIState
         IState -> Idris ()
putIState (IState
i { elab_stack :: [(Name, Bool)]
elab_stack = (Name
n, Bool
implementation) (Name, Bool) -> [(Name, Bool)] -> [(Name, Bool)]
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 = [(Name, Bool)] -> [(Name, Bool)]
forall a. [a] -> [a]
ptail (IState -> [(Name, Bool)]
elab_stack IState
i) })
    where ptail :: [a] -> [a]
ptail [] = []
          ptail (_ : xs :: [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 int :: Bool
int res :: Bool
res n :: Name
n i :: Name
i
    = do IState
ist <- Idris IState
getIState
         case Name -> Ctxt InterfaceInfo -> [InterfaceInfo]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist) of
                [CI a :: Name
a b :: [(Name, (Bool, [FnOpt], PTerm))]
b c :: [(Name, (Name, PDecl))]
c d :: [PDecl]
d e :: [Name]
e f :: [Name]
f g :: [PTerm]
g ins :: [(Name, Bool)]
ins fds :: [Int]
fds] ->
                     do let cs :: Ctxt InterfaceInfo
cs = Name -> InterfaceInfo -> Ctxt InterfaceInfo -> Ctxt InterfaceInfo
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n (Name
-> [(Name, (Bool, [FnOpt], PTerm))]
-> [(Name, (Name, PDecl))]
-> [PDecl]
-> [Name]
-> [Name]
-> [PTerm]
-> [(Name, Bool)]
-> [Int]
-> InterfaceInfo
CI Name
a [(Name, (Bool, [FnOpt], PTerm))]
b [(Name, (Name, PDecl))]
c [PDecl]
d [Name]
e [Name]
f [PTerm]
g (Name -> [(Name, Bool)] -> [(Name, Bool)]
addI Name
i [(Name, Bool)]
ins) [Int]
fds) (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist)
                        IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces :: Ctxt InterfaceInfo
idris_interfaces = Ctxt InterfaceInfo
cs }
                _ -> do let cs :: Ctxt InterfaceInfo
cs = Name -> InterfaceInfo -> Ctxt InterfaceInfo -> Ctxt InterfaceInfo
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
n (Name
-> [(Name, (Bool, [FnOpt], PTerm))]
-> [(Name, (Name, PDecl))]
-> [PDecl]
-> [Name]
-> [Name]
-> [PTerm]
-> [(Name, Bool)]
-> [Int]
-> InterfaceInfo
CI (Int -> String -> Name
sMN 0 "none") [] [] [] [] [] [] [(Name
i, Bool
res)] []) (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist)
                        IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces :: Ctxt InterfaceInfo
idris_interfaces = Ctxt InterfaceInfo
cs }
  where addI, insI :: Name -> [(Name, Bool)] -> [(Name, Bool)]
        addI :: Name -> [(Name, Bool)] -> [(Name, Bool)]
addI i :: Name
i ins :: [(Name, Bool)]
ins | Bool
int = (Name
i, Bool
res) (Name, Bool) -> [(Name, Bool)] -> [(Name, Bool)]
forall a. a -> [a] -> [a]
: [(Name, Bool)]
ins
                   | Name -> Bool
chaser Name
n = [(Name, Bool)]
ins [(Name, Bool)] -> [(Name, Bool)] -> [(Name, Bool)]
forall a. [a] -> [a] -> [a]
++ [(Name
i, Bool
res)]
                   | Bool
otherwise = Name -> [(Name, Bool)] -> [(Name, Bool)]
insI Name
i [(Name, Bool)]
ins
        insI :: Name -> [(Name, Bool)] -> [(Name, Bool)]
insI i :: Name
i [] = [(Name
i, Bool
res)]
        insI i :: Name
i (n :: (Name, Bool)
n : ns :: [(Name, Bool)]
ns) | Name -> Bool
chaser ((Name, Bool) -> Name
forall a b. (a, b) -> a
fst (Name, Bool)
n) = (Name
i, Bool
res) (Name, Bool) -> [(Name, Bool)] -> [(Name, Bool)]
forall a. a -> [a] -> [a]
: (Name, Bool)
n (Name, Bool) -> [(Name, Bool)] -> [(Name, Bool)]
forall a. a -> [a] -> [a]
: [(Name, Bool)]
ns
                        | Bool
otherwise = (Name, Bool)
n (Name, Bool) -> [(Name, Bool)] -> [(Name, Bool)]
forall a. a -> [a] -> [a]
: Name -> [(Name, Bool)] -> [(Name, Bool)]
insI Name
i [(Name, Bool)]
ns

        chaser :: Name -> Bool
chaser (SN (ParentN _ _)) = Bool
True
        chaser (NS n :: Name
n _) = Name -> Bool
chaser Name
n
        chaser _ = 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 ns :: [Name]
ns = do IState
ist <- Idris IState
getIState
                    [Name]
ns' <- (Name -> StateT IState (ExceptT Err IO) Name)
-> [Name] -> Idris [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IState -> Name -> StateT IState (ExceptT Err IO) Name
checkValid IState
ist) [Name]
ns
                    let open :: [Name]
open = IState -> [Name]
idris_openimpls IState
ist
                    IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_openimpls :: [Name]
idris_openimpls = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns' [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
open) }
                    [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
open
  where
    checkValid :: IState -> Name -> StateT IState (ExceptT Err IO) Name
checkValid ist :: IState
ist n :: Name
n
      = case Name -> Ctxt [PArg] -> [(Name, [PArg])]
forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
n (IState -> Ctxt [PArg]
idris_implicits IState
ist) of
             [(n' :: Name
n', _)] -> Name -> StateT IState (ExceptT Err IO) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n'
             []        -> Err -> StateT IState (ExceptT Err IO) Name
forall a. Err -> Idris a
throwError (Name -> Err
forall t. Name -> Err' t
NoSuchVariable Name
n)
             more :: [(Name, [PArg])]
more      -> Err -> StateT IState (ExceptT Err IO) Name
forall a. Err -> Idris a
throwError ([Name] -> Err
forall t. [Name] -> Err' t
CantResolveAlts (((Name, [PArg]) -> Name) -> [(Name, [PArg])] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [PArg]) -> Name
forall a b. (a, b) -> a
fst [(Name, [PArg])]
more))

setOpenImpl :: [Name] -> Idris ()
setOpenImpl :: [Name] -> Idris ()
setOpenImpl ns :: [Name]
ns = do IState
ist <- Idris IState
getIState
                    IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_openimpls :: [Name]
idris_openimpls = [Name]
ns }

getOpenImpl :: Idris [Name]
getOpenImpl :: Idris [Name]
getOpenImpl = do IState
ist <- Idris IState
getIState
                 [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> [Name]
idris_openimpls IState
ist)

addInterface :: Name -> InterfaceInfo -> Idris ()
addInterface :: Name -> InterfaceInfo -> Idris ()
addInterface n :: Name
n i :: InterfaceInfo
i
   = do IState
ist <- Idris IState
getIState
        let i' :: InterfaceInfo
i' = case Name -> Ctxt InterfaceInfo -> [InterfaceInfo]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist) of
                      [c :: InterfaceInfo
c] -> InterfaceInfo
i { interface_implementations :: [(Name, Bool)]
interface_implementations = InterfaceInfo -> [(Name, Bool)]
interface_implementations InterfaceInfo
c [(Name, Bool)] -> [(Name, Bool)] -> [(Name, Bool)]
forall a. [a] -> [a] -> [a]
++
                                                             InterfaceInfo -> [(Name, Bool)]
interface_implementations InterfaceInfo
i }
                      _ -> InterfaceInfo
i
        IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces :: Ctxt InterfaceInfo
idris_interfaces = Name -> InterfaceInfo -> Ctxt InterfaceInfo -> Ctxt InterfaceInfo
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 n :: Name
n meths :: [(Name, PTerm)]
meths
   = do IState
ist <- Idris IState
getIState
        let i :: InterfaceInfo
i = case Name -> Ctxt InterfaceInfo -> Maybe InterfaceInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt InterfaceInfo
idris_interfaces IState
ist) of
                     Just c :: InterfaceInfo
c -> InterfaceInfo
c { interface_methods :: [(Name, (Bool, [FnOpt], PTerm))]
interface_methods = [(Name, (Bool, [FnOpt], PTerm))]
-> [(Name, (Bool, [FnOpt], PTerm))]
forall a b. [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
update (InterfaceInfo -> [(Name, (Bool, [FnOpt], PTerm))]
interface_methods InterfaceInfo
c) }
                     Nothing -> String -> InterfaceInfo
forall a. HasCallStack => String -> a
error "Can't happen updateIMethods"
        IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
ist { idris_interfaces :: Ctxt InterfaceInfo
idris_interfaces = Name -> InterfaceInfo -> Ctxt InterfaceInfo -> Ctxt InterfaceInfo
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@(n :: Name
n, (b :: a
b, opts :: b
opts, t :: PTerm
t)) : rest :: [(Name, (a, b, PTerm))]
rest)
        | Just ty :: PTerm
ty <- Name -> [(Name, PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, PTerm)]
meths
             = (Name
n, (a
b, b
opts, PTerm
ty)) (Name, (a, b, PTerm))
-> [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
forall a. a -> [a] -> [a]
: [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
update [(Name, (a, b, PTerm))]
rest
        | Bool
otherwise = (Name, (a, b, PTerm))
m (Name, (a, b, PTerm))
-> [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
forall a. a -> [a] -> [a]
: [(Name, (a, b, PTerm))] -> [(Name, (a, b, PTerm))]
update [(Name, (a, b, PTerm))]
rest

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

getAutoHints :: Name -> Idris [Name]
getAutoHints :: Name -> Idris [Name]
getAutoHints n :: Name
n = do IState
ist <- Idris IState
getIState
                    case Name -> Ctxt [Name] -> Maybe [Name]
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt [Name]
idris_autohints IState
ist) of
                         Nothing -> [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                         Just ns :: [Name]
ns -> [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
ns

addIBC :: IBCWrite -> Idris ()
addIBC :: IBCWrite -> Idris ()
addIBC ibc :: IBCWrite
ibc@(IBCDef n :: Name
n)
           = do IState
i <- Idris IState
getIState
                Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([IBCWrite] -> Bool
notDef (IState -> [IBCWrite]
ibc_write IState
i)) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
                  IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { ibc_write :: [IBCWrite]
ibc_write = IBCWrite
ibc IBCWrite -> [IBCWrite] -> [IBCWrite]
forall a. a -> [a] -> [a]
: IState -> [IBCWrite]
ibc_write IState
i }
   where notDef :: [IBCWrite] -> Bool
notDef [] = Bool
True
         notDef (IBCDef n' :: Name
n': _) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = Bool
False
         notDef (_ : is :: [IBCWrite]
is) = [IBCWrite] -> Bool
notDef [IBCWrite]
is
addIBC ibc :: IBCWrite
ibc = do IState
i <- Idris IState
getIState; IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { ibc_write :: [IBCWrite]
ibc_write = IBCWrite
ibc IBCWrite -> [IBCWrite] -> [IBCWrite]
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 (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { ibc_write :: [IBCWrite]
ibc_write = [],
                                              idris_inmodule :: Set Name
idris_inmodule = Set Name
forall a. Set a
S.empty }

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

-- | Used to preserve sharing of names
addNameIdx :: Name -> Idris (Int, Name)
addNameIdx :: Name -> Idris (Int, Name)
addNameIdx n :: Name
n = do IState
i <- Idris IState
getIState
                  let (i' :: IState
i', x :: (Int, Name)
x) = IState -> Name -> (IState, (Int, Name))
addNameIdx' IState
i Name
n
                  IState -> Idris ()
putIState IState
i'
                  (Int, Name) -> Idris (Int, Name)
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' i :: IState
i n :: Name
n
   = let idxs :: Ctxt (Int, Name)
idxs = (Int, Ctxt (Int, Name)) -> Ctxt (Int, Name)
forall a b. (a, b) -> b
snd (IState -> (Int, Ctxt (Int, Name))
idris_nameIdx IState
i) in
         case Name -> Ctxt (Int, Name) -> [(Int, Name)]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
n Ctxt (Int, Name)
idxs of
            [x :: (Int, Name)
x] -> (IState
i, (Int, Name)
x)
            _ -> let i' :: Int
i' = (Int, Ctxt (Int, Name)) -> Int
forall a b. (a, b) -> a
fst (IState -> (Int, Ctxt (Int, Name))
idris_nameIdx IState
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 in
                    (IState
i { idris_nameIdx :: (Int, Ctxt (Int, Name))
idris_nameIdx = (Int
i', Name -> (Int, Name) -> Ctxt (Int, Name) -> Ctxt (Int, Name)
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 n :: Name
n = do IState
i <- Idris IState
getIState
                 case Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n (IState -> Map Name Name
idris_symbols IState
i) of
                      Just n' :: Name
n' -> Name -> StateT IState (ExceptT Err IO) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n'
                      Nothing -> do let sym' :: Map Name Name
sym' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n (IState -> Map Name Name
idris_symbols IState
i)
                                    IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_symbols :: Map Name Name
idris_symbols = Map Name Name
sym' })
                                    Name -> StateT IState (ExceptT Err IO) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n

getHdrs :: Codegen -> Idris [String]
getHdrs :: Codegen -> Idris [String]
getHdrs tgt :: Codegen
tgt = do IState
i <- Idris IState
getIState; [String] -> Idris [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (Codegen -> [(Codegen, String)] -> [String]
forall a. Codegen -> [(Codegen, a)] -> [a]
forCodegen Codegen
tgt ([(Codegen, String)] -> [String])
-> [(Codegen, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ IState -> [(Codegen, String)]
idris_hdrs IState
i)

getImported ::  Idris [(FilePath, Bool)]
getImported :: Idris [(String, Bool)]
getImported = IState -> [(String, Bool)]
idris_imported (IState -> [(String, Bool)])
-> Idris IState -> Idris [(String, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Idris IState
getIState

setErrSpan :: FC -> Idris ()
setErrSpan :: FC -> Idris ()
setErrSpan x :: FC
x = do IState
i <- Idris IState
getIState;
                  case (IState -> Maybe FC
errSpan IState
i) of
                      Nothing -> IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { errSpan :: Maybe FC
errSpan = FC -> Maybe FC
forall a. a -> Maybe a
Just FC
x }
                      Just _ -> () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

getSO :: Idris (Maybe String)
getSO :: Idris (Maybe String)
getSO = do IState
i <- Idris IState
getIState
           Maybe String -> Idris (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (IState -> Maybe String
compiled_so IState
i)

setSO :: Maybe String -> Idris ()
setSO :: Maybe String -> Idris ()
setSO s :: Maybe String
s = do IState
i <- Idris IState
getIState
             IState -> Idris ()
putIState (IState
i { compiled_so :: Maybe String
compiled_so = Maybe String
s })

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

putIState :: IState -> Idris ()
putIState :: IState -> Idris ()
putIState = IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

updateIState :: (IState -> IState) -> Idris ()
updateIState :: (IState -> IState) -> Idris ()
updateIState f :: IState -> IState
f = do IState
i <- Idris IState
getIState
                    IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState -> IState
f IState
i

withContext :: (IState -> Ctxt a) -> Name -> b -> (a -> Idris b) -> Idris b
withContext :: (IState -> Ctxt a) -> Name -> b -> (a -> Idris b) -> Idris b
withContext ctx :: IState -> Ctxt a
ctx name :: Name
name dflt :: b
dflt action :: a -> Idris b
action = do
    IState
ist <- Idris IState
getIState
    case Name -> Ctxt a -> [a]
forall a. Name -> Ctxt a -> [a]
lookupCtxt Name
name (IState -> Ctxt a
ctx IState
ist) of
        [x :: a
x] -> a -> Idris b
action a
x
        _   -> b -> Idris b
forall (m :: * -> *) a. Monad m => a -> m a
return b
dflt

withContext_ :: (IState -> Ctxt a) -> Name -> (a -> Idris ()) -> Idris ()
withContext_ :: (IState -> Ctxt a) -> Name -> (a -> Idris ()) -> Idris ()
withContext_ ctx :: IState -> Ctxt a
ctx name :: Name
name action :: a -> Idris ()
action = (IState -> Ctxt a) -> Name -> () -> (a -> Idris ()) -> Idris ()
forall a b.
(IState -> Ctxt a) -> Name -> b -> (a -> Idris b) -> Idris b
withContext IState -> Ctxt a
ctx Name
name () a -> Idris ()
action

-- | A version of liftIO that puts errors into the exception type of
-- the Idris monad
runIO :: IO a -> Idris a
runIO :: IO a -> Idris a
runIO x :: IO a
x = IO (Either IOError a)
-> StateT IState (ExceptT Err IO) (Either IOError a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either IOError a)
forall a. IO a -> IO (Either IOError a)
tryIOError IO a
x) StateT IState (ExceptT Err IO) (Either IOError a)
-> (Either IOError a -> Idris a) -> Idris a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> Idris a)
-> (a -> Idris a) -> Either IOError a -> Idris a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Err -> Idris a
forall a. Err -> Idris a
throwError (Err -> Idris a) -> (IOError -> Err) -> IOError -> Idris a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Err
forall t. String -> Err' t
Msg (String -> Err) -> (IOError -> String) -> IOError -> Err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> String
forall a. Show a => a -> String
show) a -> Idris a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 })
             Int -> Idris Int
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 :: String -> Int -> PTerm -> Idris ()
addInternalApp fp :: String
fp l :: Int
l t :: PTerm
t
    = do IState
i <- Idris IState
getIState
         -- We canonicalise the path to make "./Test/Module.idr" equal
         -- to "Test/Module.idr"
         Bool
exists <- IO Bool -> Idris Bool
forall a. IO a -> Idris a
runIO (IO Bool -> Idris Bool) -> IO Bool -> Idris Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
         Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
           do String
fp' <- IO String -> Idris String
forall a. IO a -> Idris a
runIO (IO String -> Idris String) -> IO String -> Idris String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
fp
              IState -> Idris ()
putIState (IState
i { idris_lineapps :: [((String, Int), PTerm)]
idris_lineapps = ((String
fp', Int
l), PTerm
t) ((String, Int), PTerm)
-> [((String, Int), PTerm)] -> [((String, Int), PTerm)]
forall a. a -> [a] -> [a]
: IState -> [((String, Int), PTerm)]
idris_lineapps IState
i })

getInternalApp :: FilePath -> Int -> Idris PTerm
getInternalApp :: String -> Int -> Idris PTerm
getInternalApp fp :: String
fp l :: Int
l = do IState
i <- Idris IState
getIState
                         -- We canonicalise the path to make
                         -- "./Test/Module.idr" equal to
                         -- "Test/Module.idr"
                         Bool
exists <- IO Bool -> Idris Bool
forall a. IO a -> Idris a
runIO (IO Bool -> Idris Bool) -> IO Bool -> Idris Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
                         if Bool
exists
                           then do String
fp' <- IO String -> Idris String
forall a. IO a -> Idris a
runIO (IO String -> Idris String) -> IO String -> Idris String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
fp
                                   case (String, Int) -> [((String, Int), PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String
fp', Int
l) (IState -> [((String, Int), PTerm)]
idris_lineapps IState
i) of
                                     Just n' :: PTerm
n' -> PTerm -> Idris PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
n'
                                     Nothing -> PTerm -> Idris PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
Placeholder
                                     -- TODO: What if it's not there?
                           else PTerm -> Idris PTerm
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 <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
                   let ps :: Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
ps = IState -> Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
idris_patdefs IState
i
                   let ps' :: Ctxt ([a], [PTerm])
ps' = (([([(Name, Term)], Term, Term)], [PTerm]) -> ([a], [PTerm]))
-> Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
-> Ctxt ([a], [PTerm])
forall a b. (a -> b) -> Ctxt a -> Ctxt b
mapCtxt (\ (_,miss :: [PTerm]
miss) -> ([], [PTerm]
miss)) Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
ps
                   IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { idris_patdefs :: Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
idris_patdefs = Ctxt ([([(Name, Term)], Term, Term)], [PTerm])
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 <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
                 let ctxt :: Context
ctxt = IState -> Context
tt_ctxt IState
i
                 IState -> Idris ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { tt_ctxt :: Context
tt_ctxt = (Def -> Def) -> Context -> Context
mapDefCtxt Def -> Def
pErase Context
ctxt })
   where pErase :: Def -> Def
pErase (CaseOp c :: CaseInfo
c t :: Term
t tys :: [(Term, Bool)]
tys orig :: [Either Term (Term, Term)]
orig _ cds :: 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 x :: Def
x = Def
x
         pErase' :: CaseDefs -> CaseDefs
pErase' (CaseDefs (cs :: [Name]
cs, c :: SC
c) rs :: ([Name], SC)
rs)
             = let c' :: ([Name], SC)
c' = ([Name]
cs, (Term -> Term) -> SC -> SC
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Term
forall n. TT n -> TT n
pEraseType SC
c) in
                   ([Name], SC) -> ([Name], SC) -> CaseDefs
CaseDefs ([Name], SC)
c' ([Name], SC)
rs

checkUndefined :: FC -> Name -> Idris ()
checkUndefined :: FC -> Name -> Idris ()
checkUndefined fc :: FC
fc n :: Name
n
    = do Context
i <- Idris Context
getContext
         case Name -> Context -> [Term]
lookupTy Name
n Context
i of
             (_:_)  -> Err -> Idris ()
forall a. Err -> Idris a
throwError (Err -> Idris ()) -> (String -> Err) -> String -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Err
forall t. String -> Err' t
Msg (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ FC -> String
forall a. Show a => a -> String
show FC
fc String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                          Name -> String
forall a. Show a => a -> String
show Name
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " already defined"
             _ -> () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isUndefined :: FC -> Name -> Idris Bool
isUndefined :: FC -> Name -> Idris Bool
isUndefined _ n :: Name
n
    = do Context
i <- Idris Context
getContext
         case Name -> Context -> Maybe Term
lookupTyExact Name
n Context
i of
             Just _ -> Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
             _ -> Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

setContext :: Context -> Idris ()
setContext :: Context -> Idris ()
setContext ctxt :: 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 f :: 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
fc (v :: Int
v, cs :: [UConstraint]
cs)
    = do Bool
tit <- Idris Bool
typeInType
         Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
tit) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$ do
             IState
i <- Idris IState
getIState
             let ctxt :: Context
ctxt = IState -> Context
tt_ctxt IState
i
             let ctxt' :: Context
ctxt' = Context
ctxt { next_tvar :: Int
next_tvar = Int
v }
             let ics :: Set ConstraintFC
ics = [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll ([UConstraint] -> [FC] -> [(UConstraint, FC)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UConstraint]
cs (FC -> [FC]
forall a. a -> [a]
repeat FC
fc)) (IState -> Set ConstraintFC
idris_constraints IState
i)
             IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { tt_ctxt :: Context
tt_ctxt = Context
ctxt', idris_constraints :: Set ConstraintFC
idris_constraints = Set ConstraintFC
ics }
  where
    insertAll :: [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll [] c :: Set ConstraintFC
c = Set ConstraintFC
c
    insertAll ((ULE (UVal 0) _, fc :: FC
fc) : cs :: [(UConstraint, FC)]
cs) ics :: Set ConstraintFC
ics = [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll [(UConstraint, FC)]
cs Set ConstraintFC
ics
    insertAll ((ULE x :: UExp
x y :: UExp
y, fc :: FC
fc) : cs :: [(UConstraint, FC)]
cs) ics :: Set ConstraintFC
ics | UExp
x UExp -> UExp -> Bool
forall a. Eq a => a -> a -> Bool
== UExp
y = [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll [(UConstraint, FC)]
cs Set ConstraintFC
ics
    insertAll ((c :: UConstraint
c, fc :: FC
fc) : cs :: [(UConstraint, FC)]
cs) ics :: Set ConstraintFC
ics
       = [(UConstraint, FC)] -> Set ConstraintFC -> Set ConstraintFC
insertAll [(UConstraint, FC)]
cs (Set ConstraintFC -> Set ConstraintFC)
-> Set ConstraintFC -> Set ConstraintFC
forall a b. (a -> b) -> a -> b
$ ConstraintFC -> Set ConstraintFC -> Set ConstraintFC
forall a. Ord a => a -> Set a -> Set a
S.insert (UConstraint -> FC -> ConstraintFC
ConstraintFC UConstraint
c FC
fc) Set ConstraintFC
ics

addDeferred :: [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))] -> Idris ()
addDeferred = NameType
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> Idris ()
addDeferred' NameType
Ref
addDeferredTyCon :: [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))] -> Idris ()
addDeferredTyCon = NameType
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> Idris ()
addDeferred' (Int -> Int -> NameType
TCon 0 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' nt :: NameType
nt ns :: [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
ns
  = do ((Name, (Int, Maybe Name, Term, [Name], Bool, Bool)) -> Idris ())
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(n :: Name
n, (i :: Int
i, _, t :: Term
t, _, _, _)) -> (Context -> Context) -> Idris ()
updateContext (Name -> NameType -> Term -> Context -> Context
addTyDecl Name
n NameType
nt (Set Name -> Term -> Term
tidyNames Set Name
forall a. Set a
S.empty Term
t))) [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
ns
       ((Name, (Int, Maybe Name, Term, [Name], Bool, Bool)) -> Idris ())
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(n :: Name
n, _) -> Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
primDefs)) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$ IBCWrite -> Idris ()
addIBC (Name -> IBCWrite
IBCMetavar Name
n)) [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
ns
       IState
i <- Idris IState
getIState
       IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_metavars :: [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars = ((Name, (Int, Maybe Name, Term, [Name], Bool, Bool))
 -> (Name, (Maybe Name, Int, [Name], Bool, Bool)))
-> [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
forall a b. (a -> b) -> [a] -> [b]
map (\(n :: Name
n, (i :: Int
i, top :: Maybe Name
top, _, ns :: [Name]
ns, isTopLevel :: Bool
isTopLevel, isDefinable :: Bool
isDefinable)) ->
                                                  (Name
n, (Maybe Name
top, Int
i, [Name]
ns, Bool
isTopLevel, Bool
isDefinable))) [(Name, (Int, Maybe Name, Term, [Name], Bool, Bool))]
ns [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
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 used :: Set Name
used (Bind (MN i :: Int
i x :: Text
x) b :: Binder Term
b sc :: Term
sc)
            = let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet (Text -> Name
UN Text
x) Set Name
used in
                  Name -> Binder Term -> Term -> Term
forall n. n -> Binder (TT n) -> TT n -> TT n
Bind Name
n' Binder Term
b (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Set Name -> Term -> Term
tidyNames (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
used) Term
sc
        tidyNames used :: Set Name
used (Bind n :: Name
n b :: Binder Term
b sc :: Term
sc)
            = let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet Name
n Set Name
used in
                  Name -> Binder Term -> Term -> Term
forall n. n -> Binder (TT n) -> TT n -> TT n
Bind Name
n' Binder Term
b (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ Set Name -> Term -> Term
tidyNames (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
used) Term
sc
        tidyNames _    b :: Term
b = Term
b

solveDeferred :: FC -> Name -> Idris ()
solveDeferred :: FC -> Name -> Idris ()
solveDeferred fc :: FC
fc n :: Name
n
    = do IState
i <- Idris IState
getIState
         case Name
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
-> Maybe (Maybe Name, Int, [Name], Bool, Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
i) of
              Just (_, _, _, _, False) ->
                   Err -> Idris ()
forall a. Err -> Idris a
throwError (Err -> Idris ()) -> Err -> Idris ()
forall a b. (a -> b) -> a -> b
$ FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc (Err -> Err) -> Err -> Err
forall a b. (a -> b) -> a -> b
$ String -> Err
forall t. String -> Err' t
Msg ("Can't define hole " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " as it depends on other holes")
              _ -> IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_metavars :: [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars =
                                       ((Name, (Maybe Name, Int, [Name], Bool, Bool)) -> Bool)
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(n' :: Name
n', _) -> Name
nName -> Name -> Bool
forall 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 =
                                       (IBCWrite -> Bool) -> [IBCWrite] -> [IBCWrite]
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 n :: Name
n (IBCMetavar n' :: Name
n') = Bool -> Bool
not (Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n')
          notMV n :: Name
n _ = Bool
True

getUndefined :: Idris [Name]
getUndefined :: Idris [Name]
getUndefined = do IState
i <- Idris IState
getIState
                  [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return (((Name, (Maybe Name, Int, [Name], Bool, Bool)) -> Name)
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, (Maybe Name, Int, [Name], Bool, Bool)) -> Name
forall a b. (a, b) -> a
fst (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
i) [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
primDefs)

isMetavarName :: Name -> IState -> Bool
isMetavarName :: Name -> IState -> Bool
isMetavarName n :: Name
n ist :: IState
ist
     = case Name -> Context -> [Name]
lookupNames Name
n (IState -> Context
tt_ctxt IState
ist) of
            (t :: Name
t:_) -> Maybe (Maybe Name, Int, [Name], Bool, Bool) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Maybe Name, Int, [Name], Bool, Bool) -> Bool)
-> Maybe (Maybe Name, Int, [Name], Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ Name
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
-> Maybe (Maybe Name, Int, [Name], Bool, Bool)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
t (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
ist)
            _     -> Bool
False

getWidth :: Idris ConsoleWidth
getWidth :: Idris ConsoleWidth
getWidth = (IState -> ConsoleWidth) -> Idris IState -> Idris ConsoleWidth
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 w :: ConsoleWidth
w = do IState
ist <- Idris IState
getIState
                IState -> Idris ()
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 d :: Maybe Int
d = do IState
ist <- Idris IState
getIState
                IState -> Idris ()
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 :: String
typeDescription = "The type of types"


type1Doc :: Doc OutputAnnotation
type1Doc :: Doc OutputAnnotation
type1Doc = (OutputAnnotation -> Doc OutputAnnotation -> Doc OutputAnnotation
forall a. a -> Doc a -> Doc a
annotate (String -> String -> OutputAnnotation
AnnType "Type" "The type of types, one level up") (Doc OutputAnnotation -> Doc OutputAnnotation)
-> Doc OutputAnnotation -> Doc OutputAnnotation
forall a b. (a -> b) -> a -> b
$ String -> Doc OutputAnnotation
forall a. String -> Doc a
text "Type 1")


isetPrompt :: String -> Idris ()
isetPrompt :: String -> Idris ()
isetPrompt p :: String
p = do IState
i <- Idris IState
getIState
                  case IState -> OutputMode
idris_outputmode IState
i of
                    IdeMode n :: Integer
n h :: Handle
h -> IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> (String -> IO ()) -> String -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
h (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Integer -> String
forall a. SExpable a => String -> a -> Integer -> String
convSExp "set-prompt" String
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
fc ->
                          case IState -> OutputMode
idris_outputmode IState
i of
                            IdeMode n :: Integer
n h :: Handle
h ->
                              IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> (String -> IO ()) -> String -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
h (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$
                                String -> FC -> Integer -> String
forall a. SExpable a => String -> a -> Integer -> String
convSExp "set-loaded-region" FC
fc Integer
n
                        Nothing -> () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

setLogLevel :: Int -> Idris ()
setLogLevel :: Int -> Idris ()
setLogLevel l :: 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 (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

setLogCats :: [LogCat] -> Idris ()
setLogCats :: [LogCat] -> Idris ()
setLogCats cs :: [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 (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

setCmdLine :: [Opt] -> Idris ()
setCmdLine :: [Opt] -> Idris ()
setCmdLine opts :: [Opt]
opts = do IState
i <- Idris IState
getIState
                     let iopts :: IOption
iopts = IState -> IOption
idris_options IState
i
                     IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: 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
                [Opt] -> Idris [Opt]
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
i))

getDumpHighlighting :: Idris Bool
getDumpHighlighting :: Idris Bool
getDumpHighlighting = do IState
ist <- Idris IState
getIState
                         Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ([Opt] -> Bool
findC (IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
ist)))
  where findC :: [Opt] -> Bool
findC = Opt -> [Opt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Opt
DumpHighlights

getDumpDefun :: Idris (Maybe FilePath)
getDumpDefun :: Idris (Maybe String)
getDumpDefun = do IState
i <- Idris IState
getIState
                  Maybe String -> Idris (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Idris (Maybe String))
-> Maybe String -> Idris (Maybe String)
forall a b. (a -> b) -> a -> b
$ [Opt] -> Maybe String
findC (IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
i))
    where findC :: [Opt] -> Maybe String
findC [] = Maybe String
forall a. Maybe a
Nothing
          findC (DumpDefun x :: String
x : _) = String -> Maybe String
forall a. a -> Maybe a
Just String
x
          findC (_ : xs :: [Opt]
xs) = [Opt] -> Maybe String
findC [Opt]
xs

getDumpCases :: Idris (Maybe FilePath)
getDumpCases :: Idris (Maybe String)
getDumpCases = do IState
i <- Idris IState
getIState
                  Maybe String -> Idris (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Idris (Maybe String))
-> Maybe String -> Idris (Maybe String)
forall a b. (a -> b) -> a -> b
$ [Opt] -> Maybe String
findC (IOption -> [Opt]
opt_cmdline (IState -> IOption
idris_options IState
i))
    where findC :: [Opt] -> Maybe String
findC [] = Maybe String
forall a. Maybe a
Nothing
          findC (DumpCases x :: String
x : _) = String -> Maybe String
forall a. a -> Maybe a
Just String
x
          findC (_ : xs :: [Opt]
xs) = [Opt] -> Maybe String
findC [Opt]
xs

logLevel :: Idris Int
logLevel :: Idris Int
logLevel = do IState
i <- Idris IState
getIState
              Int -> Idris Int
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 b :: 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 (IState -> Idris ()) -> IState -> Idris ()
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
                  Bool -> Idris Bool
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 t :: 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 (IState -> Idris ()) -> IState -> Idris ()
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
                Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_errContext (IState -> IOption
idris_options IState
i))

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

addOptimise :: Optimisation -> Idris ()
addOptimise :: Optimisation -> Idris ()
addOptimise opt :: Optimisation
opt = do [Optimisation]
opts <- Idris [Optimisation]
getOptimise
                     [Optimisation] -> Idris ()
setOptimise ([Optimisation] -> [Optimisation]
forall a. Eq a => [a] -> [a]
nub (Optimisation
opt Optimisation -> [Optimisation] -> [Optimisation]
forall a. a -> [a] -> [a]
: [Optimisation]
opts))

removeOptimise :: Optimisation -> Idris ()
removeOptimise :: Optimisation -> Idris ()
removeOptimise opt :: Optimisation
opt = do [Optimisation]
opts <- Idris [Optimisation]
getOptimise
                        [Optimisation] -> Idris ()
setOptimise (([Optimisation] -> [Optimisation]
forall a. Eq a => [a] -> [a]
nub [Optimisation]
opts) [Optimisation] -> [Optimisation] -> [Optimisation]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Optimisation
opt])

-- | 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 n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [Optimisation] -> Idris ()
setOptimise []
setOptLevel 1          = [Optimisation] -> Idris ()
setOptimise []
setOptLevel 2          = [Optimisation] -> Idris ()
setOptimise [Optimisation
PETransform]
setOptLevel n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 3 = [Optimisation] -> Idris ()
setOptimise [Optimisation
PETransform]

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

setAutoSolve :: Bool -> Idris ()
setAutoSolve :: Bool -> Idris ()
setAutoSolve b :: 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 (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

setNoBanner :: Bool -> Idris ()
setNoBanner :: Bool -> Idris ()
setNoBanner n :: 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 (IState -> Idris ()) -> IState -> Idris ()
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
                 Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_nobanner IOption
opts)

setEvalTypes :: Bool -> Idris ()
setEvalTypes :: Bool -> Idris ()
setEvalTypes n :: 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 (IState -> Idris ()) -> IState -> Idris ()
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
                    Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_desugarnats IOption
opts)


setDesugarNats :: Bool -> Idris ()
setDesugarNats :: Bool -> Idris ()
setDesugarNats n :: 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 (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

setQuiet :: Bool -> Idris ()
setQuiet :: Bool -> Idris ()
setQuiet q :: 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 (IState -> Idris ()) -> IState -> Idris ()
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
              Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> Bool
opt_quiet IOption
opts)

setCodegen :: Codegen -> Idris ()
setCodegen :: Codegen -> Idris ()
setCodegen t :: 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 (IState -> Idris ()) -> IState -> Idris ()
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
             Codegen -> Idris Codegen
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 t :: 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 (IState -> Idris ()) -> IState -> Idris ()
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
              OutputType -> Idris OutputType
forall (m :: * -> *) a. Monad m => a -> m a
return (OutputType -> Idris OutputType) -> OutputType -> Idris OutputType
forall a b. (a -> b) -> a -> b
$ IOption -> OutputType
opt_outputTy (IOption -> OutputType) -> IOption -> OutputType
forall a b. (a -> b) -> a -> b
$ IState -> IOption
idris_options IState
i

setIdeMode :: Bool -> Handle -> Idris ()
setIdeMode :: Bool -> Handle -> Idris ()
setIdeMode True  h :: Handle
h = do IState
i <- Idris IState
getIState
                        IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_outputmode :: OutputMode
idris_outputmode = Integer -> Handle -> OutputMode
IdeMode 0 Handle
h
                                      , idris_colourRepl :: Bool
idris_colourRepl = Bool
False
                                      }
setIdeMode False _ = () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

setTargetTriple :: String -> Idris ()
setTargetTriple :: String -> Idris ()
setTargetTriple t :: String
t = do IState
i <- Idris IState
getIState
                       let opts :: IOption
opts = IState -> IOption
idris_options IState
i
                           opt' :: IOption
opt' = IOption
opts { opt_triple :: String
opt_triple = String
t }
                       IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

targetTriple :: Idris String
targetTriple :: Idris String
targetTriple = do IState
i <- Idris IState
getIState
                  String -> Idris String
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> String
opt_triple (IState -> IOption
idris_options IState
i))

setTargetCPU :: String -> Idris ()
setTargetCPU :: String -> Idris ()
setTargetCPU t :: String
t = do IState
i <- Idris IState
getIState
                    let opts :: IOption
opts = IState -> IOption
idris_options IState
i
                        opt' :: IOption
opt' = IOption
opts { opt_cpu :: String
opt_cpu = String
t }
                    IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

targetCPU :: Idris String
targetCPU :: Idris String
targetCPU = do IState
i <- Idris IState
getIState
               String -> Idris String
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> String
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   (IOption -> Bool) -> IOption -> Bool
forall a b. (a -> b) -> a -> b
$ IState -> IOption
idris_options IState
i
  if Bool
quiet
    then Int -> Idris Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Idris Int) -> Int -> Idris Int
forall a b. (a -> b) -> a -> b
$ 0
    else Int -> Idris Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Idris Int) -> Int -> Idris Int
forall a b. (a -> b) -> a -> b
$ (IOption -> Int
opt_verbose (IOption -> Int) -> IOption -> Int
forall a b. (a -> b) -> a -> b
$ IState -> IOption
idris_options IState
i)

setVerbose :: Int -> Idris ()
setVerbose :: Int -> Idris ()
setVerbose t :: 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 (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

iReport :: Int -> String -> Idris ()
iReport :: Int -> String -> Idris ()
iReport level :: Int
level msg :: String
msg = do
  Int
verbosity <- Idris Int
verbose
  IState
i <- Idris IState
getIState
  Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
verbosity) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
    case IState -> OutputMode
idris_outputmode IState
i of
      RawOutput h :: Handle
h -> IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> IO () -> Idris ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
h String
msg
      IdeMode n :: Integer
n h :: Handle
h -> IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> (String -> IO ()) -> String -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
h (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Integer -> String
forall a. SExpable a => String -> a -> Integer -> String
convSExp "write-string" String
msg Integer
n
  () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

setIBCSubDir :: FilePath -> Idris ()
setIBCSubDir :: String -> Idris ()
setIBCSubDir fp :: String
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 :: String
opt_ibcsubdir = String
fp }
                     IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

valIBCSubDir :: IState -> Idris FilePath
valIBCSubDir :: IState -> Idris String
valIBCSubDir i :: IState
i = String -> Idris String
forall (m :: * -> *) a. Monad m => a -> m a
return (IOption -> String
opt_ibcsubdir (IState -> IOption
idris_options IState
i))

addImportDir :: FilePath -> Idris ()
addImportDir :: String -> Idris ()
addImportDir fp :: String
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 :: [String]
opt_importdirs = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
fp String -> [String] -> [String]
forall a. a -> [a] -> [a]
: IOption -> [String]
opt_importdirs IOption
opts }
                     IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

setImportDirs :: [FilePath] -> Idris ()
setImportDirs :: [String] -> Idris ()
setImportDirs fps :: [String]
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 :: [String]
opt_importdirs = [String]
fps }
                       IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opt' }

allImportDirs :: Idris [FilePath]
allImportDirs :: Idris [String]
allImportDirs = do IState
i <- Idris IState
getIState
                   let optdirs :: [String]
optdirs = IOption -> [String]
opt_importdirs (IState -> IOption
idris_options IState
i)
                   [String] -> Idris [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ("." String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
forall a. [a] -> [a]
reverse [String]
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 :: String -> Idris [String]
rankedImportDirs fp :: String
fp = do [String]
ids <- Idris [String]
allImportDirs
                         let (prefixes :: [String]
prefixes, rest :: [String]
rest) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`String
fp) [String]
ids
                         [String] -> Idris [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Idris [String]) -> [String] -> Idris [String]
forall a b. (a -> b) -> a -> b
$ [String]
prefixes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
rest

addSourceDir :: FilePath -> Idris ()
addSourceDir :: String -> Idris ()
addSourceDir fp :: String
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 :: [String]
opt_sourcedirs = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
fp String -> [String] -> [String]
forall a. a -> [a] -> [a]
: IOption -> [String]
opt_sourcedirs IOption
opts  }
                     IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opts' }

setSourceDirs :: [FilePath] -> Idris ()
setSourceDirs :: [String] -> Idris ()
setSourceDirs fps :: [String]
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 :: [String]
opt_sourcedirs = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
fps  }
                       IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_options :: IOption
idris_options = IOption
opts' }

allSourceDirs :: Idris [FilePath]
allSourceDirs :: Idris [String]
allSourceDirs = do IState
i <- Idris IState
getIState
                   let optdirs :: [String]
optdirs = IOption -> [String]
opt_sourcedirs (IState -> IOption
idris_options IState
i)
                   [String] -> Idris [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ("." String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
forall a. [a] -> [a]
reverse [String]
optdirs)

colourise :: Idris Bool
colourise :: Idris Bool
colourise = do IState
i <- Idris IState
getIState
               Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Idris Bool) -> Bool -> Idris Bool
forall a b. (a -> b) -> a -> b
$ IState -> Bool
idris_colourRepl IState
i

setColourise :: Bool -> Idris ()
setColourise :: Bool -> Idris ()
setColourise b :: Bool
b = do IState
i <- Idris IState
getIState
                    IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_colourRepl :: Bool
idris_colourRepl = Bool
b }

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

logLvl :: Int -> String -> Idris ()
logLvl :: Int -> String -> Idris ()
logLvl = [LogCat] -> Int -> String -> Idris ()
logLvlCats []

logCoverage :: Int -> String -> Idris ()
logCoverage :: Int -> String -> Idris ()
logCoverage = [LogCat] -> Int -> String -> Idris ()
logLvlCats [LogCat
ICoverage]

logErasure :: Int -> String -> Idris ()
logErasure :: Int -> String -> Idris ()
logErasure = [LogCat] -> Int -> String -> Idris ()
logLvlCats [LogCat
IErasure]

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

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

-- | Log an action of the compiler.
logCodeGen :: Int -> String -> Idris ()
logCodeGen :: Int -> String -> Idris ()
logCodeGen = [LogCat] -> Int -> String -> Idris ()
logLvlCats [LogCat]
codegenCats

logIBC :: Int -> String -> Idris ()
logIBC :: Int -> String -> Idris ()
logIBC = [LogCat] -> Int -> String -> 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 -> String -> Idris ()
logLvlCats cs :: [LogCat]
cs l :: Int
l msg :: String
msg = do
    IState
i <- Idris IState
getIState
    let lvl :: Int
lvl  = IOption -> Int
opt_logLevel (IState -> IOption
idris_options IState
i)
    let cats :: [LogCat]
cats = IOption -> [LogCat]
opt_logcats (IState -> IOption
idris_options IState
i)
    Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
lvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
      Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LogCat] -> [LogCat] -> Bool
inCat [LogCat]
cs [LogCat]
cats Bool -> Bool -> Bool
|| [LogCat] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogCat]
cats) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
        case IState -> OutputMode
idris_outputmode IState
i of
          RawOutput h :: Handle
h -> do
            IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> IO () -> Idris ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
h String
msg
          IdeMode n :: Integer
n h :: Handle
h -> do
            let good :: SExp
good = [SExp] -> SExp
SexpList [Integer -> SExp
IntegerAtom (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
l), String -> SExp
forall a. SExpable a => a -> SExp
toSExp String
msg]
            IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> (String -> IO ()) -> String -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
h (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ String -> SExp -> Integer -> String
forall a. SExpable a => String -> a -> Integer -> String
convSExp "log" SExp
good Integer
n
  where
    inCat :: [LogCat] -> [LogCat] -> Bool
    inCat :: [LogCat] -> [LogCat] -> Bool
inCat cs :: [LogCat]
cs cats :: [LogCat]
cats = (LogCat -> Bool) -> [LogCat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (LogCat -> [LogCat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [LogCat]
cats) [LogCat]
cs

cmdOptType :: Opt -> Idris Bool
cmdOptType :: Opt -> Idris Bool
cmdOptType x :: Opt
x = do IState
i <- Idris IState
getIState
                  Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Idris Bool) -> Bool -> Idris Bool
forall a b. (a -> b) -> a -> b
$ Opt
x Opt -> [Opt] -> Bool
forall (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
                Nothing -> Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                _       -> Bool -> Idris Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

setTypeCase :: Bool -> Idris ()
setTypeCase :: Bool -> Idris ()
setTypeCase t :: 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 (IState -> Idris ()) -> IState -> Idris ()
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
  Int -> Idris Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Idris Int) -> Int -> Idris Int
forall a b. (a -> b) -> a -> b
$ InteractiveOpts -> Int
interactiveOpts_indentWith (IState -> InteractiveOpts
idris_interactiveOpts IState
i)

setIndentWith :: Int -> Idris ()
setIndentWith :: Int -> Idris ()
setIndentWith indentWith :: 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 (IState -> Idris ()) -> IState -> Idris ()
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
  Int -> Idris Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Idris Int) -> Int -> Idris Int
forall a b. (a -> b) -> a -> b
$ InteractiveOpts -> Int
interactiveOpts_indentClause (IState -> InteractiveOpts
idris_interactiveOpts IState
i)

setIndentClause :: Int -> Idris ()
setIndentClause :: Int -> Idris ()
setIndentClause indentClause :: 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 (IState -> Idris ()) -> IState -> Idris ()
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 dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns infs :: [Name]
infs tm :: PTerm
tm = Int -> PTerm -> PTerm
en 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 n :: Text
n) = Int -> Text -> Name
MN 0 Text
n
    mkShadow (MN i :: Int
i n :: Text
n) = Int -> Text -> Name
MN (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Text
n
    mkShadow (NS x :: Name
x s :: [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 0 (PLam fc :: FC
fc n :: Name
n nfc :: FC
nfc t :: PTerm
t s :: PTerm
s)
       | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ns)
               = let n' :: Name
n' = Name -> Name
mkShadow Name
n in
                     FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
n' FC
nfc (Int -> PTerm -> PTerm
en 0 PTerm
t) (Int -> PTerm -> PTerm
en 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 0 PTerm
t) (Int -> PTerm -> PTerm
en 0 PTerm
s)
    en 0 (PPi p :: Plicity
p n :: Name
n nfc :: FC
nfc t :: PTerm
t s :: PTerm
s)
       | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ns)
               = let n' :: Name
n' = Name -> Name
mkShadow Name
n in -- TODO THINK SHADOWING TacImp?
                     Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi (Int -> Plicity -> Plicity
enTacImp 0 Plicity
p) Name
n' FC
nfc (Int -> PTerm -> PTerm
en 0 PTerm
t) (Int -> PTerm -> PTerm
en 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 0 Plicity
p) Name
n FC
nfc (Int -> PTerm -> PTerm
en 0 PTerm
t) (Int -> PTerm -> PTerm
en 0 PTerm
s)
    en 0 (PLet fc :: FC
fc rc :: RigCount
rc n :: Name
n nfc :: FC
nfc ty :: PTerm
ty v :: PTerm
v s :: PTerm
s)
       | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ns)
               = let n' :: Name
n' = Name -> Name
mkShadow Name
n in
                     FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
n' FC
nfc (Int -> PTerm -> PTerm
en 0 PTerm
ty) (Int -> PTerm -> PTerm
en 0 PTerm
v) (Int -> PTerm -> PTerm
en 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 0 PTerm
ty) (Int -> PTerm -> PTerm
en 0 PTerm
v) (Int -> PTerm -> PTerm
en 0 PTerm
s)
    -- FIXME: Should only do this in a type signature!
    en 0 (PDPair f :: FC
f hls :: [FC]
hls p :: PunInfo
p (PRef f' :: FC
f' fcs :: [FC]
fcs n :: Name
n) t :: PTerm
t r :: PTerm
r)
       | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
ps [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ns) Bool -> Bool -> Bool
&& PTerm
t PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/= PTerm
Placeholder
           = let n' :: Name
n' = Name -> Name
mkShadow Name
n in
                 FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
f [FC]
hls PunInfo
p (FC -> [FC] -> Name -> PTerm
PRef FC
f' [FC]
fcs Name
n') (Int -> PTerm -> PTerm
en 0 PTerm
t) (Int -> PTerm -> PTerm
en 0 (Name -> Name -> PTerm -> PTerm
shadow Name
n Name
n' PTerm
r))
    en 0 (PRewrite f :: FC
f by :: Maybe Name
by l :: PTerm
l r :: PTerm
r g :: Maybe PTerm
g) = FC -> Maybe Name -> PTerm -> PTerm -> Maybe PTerm -> PTerm
PRewrite FC
f Maybe Name
by (Int -> PTerm -> PTerm
en 0 PTerm
l) (Int -> PTerm -> PTerm
en 0 PTerm
r) ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0) Maybe PTerm
g)
    en 0 (PTyped l :: PTerm
l r :: PTerm
r) = PTerm -> PTerm -> PTerm
PTyped (Int -> PTerm -> PTerm
en 0 PTerm
l) (Int -> PTerm -> PTerm
en 0 PTerm
r)
    en 0 (PPair f :: FC
f hls :: [FC]
hls p :: PunInfo
p l :: PTerm
l r :: PTerm
r) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
f [FC]
hls PunInfo
p (Int -> PTerm -> PTerm
en 0 PTerm
l) (Int -> PTerm -> PTerm
en 0 PTerm
r)
    en 0 (PDPair f :: FC
f hls :: [FC]
hls p :: PunInfo
p l :: PTerm
l t :: PTerm
t r :: PTerm
r) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
f [FC]
hls PunInfo
p (Int -> PTerm -> PTerm
en 0 PTerm
l) (Int -> PTerm -> PTerm
en 0 PTerm
t) (Int -> PTerm -> PTerm
en 0 PTerm
r)
    en 0 (PAlternative ns :: [(Name, Name)]
ns a :: PAltType
a as :: [PTerm]
as) = [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ns PAltType
a ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> PTerm -> PTerm
en 0) [PTerm]
as)
    en 0 (PHidden t :: PTerm
t) = PTerm -> PTerm
PHidden (Int -> PTerm -> PTerm
en 0 PTerm
t)
    en 0 (PUnifyLog t :: PTerm
t) = PTerm -> PTerm
PUnifyLog (Int -> PTerm -> PTerm
en 0 PTerm
t)
    en 0 (PDisamb ds :: [[Text]]
ds t :: PTerm
t) = [[Text]] -> PTerm -> PTerm
PDisamb [[Text]]
ds (Int -> PTerm -> PTerm
en 0 PTerm
t)
    en 0 (PNoImplicits t :: PTerm
t) = PTerm -> PTerm
PNoImplicits (Int -> PTerm -> PTerm
en 0 PTerm
t)
    en 0 (PDoBlock ds :: [PDo]
ds) = [PDo] -> PTerm
PDoBlock ((PDo -> PDo) -> [PDo] -> [PDo]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PDo -> PDo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PDo]
ds)
    en 0 (PProof ts :: [PTactic]
ts)   = [PTactic] -> PTerm
PProof ((PTactic -> PTactic) -> [PTactic] -> [PTactic]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PTactic -> PTactic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PTactic]
ts)
    en 0 (PTactics ts :: [PTactic]
ts) = [PTactic] -> PTerm
PTactics ((PTactic -> PTactic) -> [PTactic] -> [PTactic]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PTactic -> PTactic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PTactic]
ts)

    en 0 (PQuote (Var n :: Name
n))
        | Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = Raw -> PTerm
PQuote (Name -> Raw
Var (Name -> Name
dec Name
n))
    en 0 (PApp fc :: FC
fc (PInferRef fc' :: FC
fc' hl :: [FC]
hl n :: Name
n) as :: [PArg]
as)
        | Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
                           (((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall t. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PArg]
as))
    en 0 (PApp fc :: FC
fc (PRef fc' :: FC
fc' hl :: [FC]
hl n :: Name
n) as :: [PArg]
as)
        | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infs = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
                           (((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall t. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PArg]
as))
        | Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
                           (((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall t. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PArg]
as))
    en 0 (PAppBind fc :: FC
fc (PRef fc' :: FC
fc' hl :: [FC]
hl n :: Name
n) as :: [PArg]
as)
        | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infs = FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
                           (((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall t. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PArg]
as))
        | Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc' [FC]
hl (Name -> Name
dec Name
n))
                           (((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall t. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PArg]
as))
    en 0 (PRef fc :: FC
fc hl :: [FC]
hl n :: Name
n)
        | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infs = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc [FC]
hl (Name -> Name
dec Name
n))
                           (((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall t. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps)
        | Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl (Name -> Name
dec Name
n))
                           (((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall t. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps)
    en 0 (PInferRef fc :: FC
fc hl :: [FC]
hl n :: Name
n)
        | Name
n Name -> [Name] -> Bool
`nselem` [Name]
ns = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
fc [FC]
hl (Name -> Name
dec Name
n))
                           (((Name, PTerm) -> PArg) -> [(Name, PTerm)] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PArg
forall t. t -> PArg' t
pexp (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl)) (Name -> PArg) -> ((Name, PTerm) -> Name) -> (Name, PTerm) -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst) [(Name, PTerm)]
ps)
    en 0 (PApp fc :: FC
fc f :: PTerm
f as :: [PArg]
as) = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (Int -> PTerm -> PTerm
en 0 PTerm
f) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PArg]
as)
    en 0 (PAppBind fc :: FC
fc f :: PTerm
f as :: [PArg]
as) = FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
fc (Int -> PTerm -> PTerm
en 0 PTerm
f) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en 0)) [PArg]
as)
    en 0 (PCase fc :: FC
fc c :: PTerm
c os :: [(PTerm, PTerm)]
os) = FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc (Int -> PTerm -> PTerm
en 0 PTerm
c) (((PTerm, PTerm) -> (PTerm, PTerm))
-> [(PTerm, PTerm)] -> [(PTerm, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> (PTerm, PTerm) -> (PTerm, PTerm)
forall t b. (t -> b) -> (t, t) -> (b, b)
pmap (Int -> PTerm -> PTerm
en 0)) [(PTerm, PTerm)]
os)
    en 0 (PIfThenElse fc :: FC
fc c :: PTerm
c t :: PTerm
t f :: PTerm
f) = FC -> PTerm -> PTerm -> PTerm -> PTerm
PIfThenElse FC
fc (Int -> PTerm -> PTerm
en 0 PTerm
c) (Int -> PTerm -> PTerm
en 0 PTerm
t) (Int -> PTerm -> PTerm
en 0 PTerm
f)
    en 0 (PRunElab fc :: FC
fc tm :: PTerm
tm ns :: [String]
ns) = FC -> PTerm -> [String] -> PTerm
PRunElab FC
fc (Int -> PTerm -> PTerm
en 0 PTerm
tm) [String]
ns
    en 0 (PConstSugar fc :: FC
fc tm :: PTerm
tm) = FC -> PTerm -> PTerm
PConstSugar FC
fc (Int -> PTerm -> PTerm
en 0 PTerm
tm)

    en ql :: Int
ql (PQuasiquote tm :: PTerm
tm ty :: Maybe PTerm
ty) = PTerm -> Maybe PTerm -> PTerm
PQuasiquote (Int -> PTerm -> PTerm
en (Int
ql Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) PTerm
tm) ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PTerm -> PTerm
en Int
ql) Maybe PTerm
ty)
    en ql :: Int
ql (PUnquote tm :: PTerm
tm) = PTerm -> PTerm
PUnquote (Int -> PTerm -> PTerm
en (Int
ql Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) PTerm
tm)

    en ql :: Int
ql t :: PTerm
t = (PTerm -> PTerm) -> PTerm -> PTerm
forall on. Uniplate on => (on -> on) -> on -> on
descend (Int -> PTerm -> PTerm
en Int
ql) PTerm
t

    nselem :: Name -> [Name] -> Bool
nselem x :: Name
x [] = Bool
False
    nselem x :: Name
x (y :: Name
y : xs :: [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 x :: Name
x y :: Name
y = Name -> Name
nsroot Name
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Name
nsroot Name
y

    enTacImp :: Int -> Plicity -> Plicity
enTacImp ql :: Int
ql (TacImp aos :: [ArgOpt]
aos st :: Static
st scr :: PTerm
scr rig :: RigCount
rig) = [ArgOpt] -> Static -> PTerm -> RigCount -> Plicity
TacImp [ArgOpt]
aos Static
st (Int -> PTerm -> PTerm
en Int
ql PTerm
scr) RigCount
rig
    enTacImp ql :: Int
ql other :: 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 rhsonly :: Bool
rhsonly ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns (PTy doc :: Docstring (Either Err PTerm)
doc argdocs :: [(Name, Docstring (Either Err PTerm))]
argdocs syn :: SyntaxInfo
syn fc :: FC
fc o :: [FnOpt]
o n :: Name
n nfc :: FC
nfc ty :: PTerm
ty)
    = if Name
n Name -> [Name] -> Bool
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)) $
              Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> [FnOpt]
-> Name
-> FC
-> PTerm
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [FnOpt]
-> Name
-> FC
-> t
-> PDecl' t
PTy Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argdocs SyntaxInfo
syn FC
fc [FnOpt]
o (Name -> Name
dec Name
n) FC
nfc (Plicity -> [(Name, PTerm)] -> PTerm -> PTerm
piBindp Plicity
expl_param [(Name, PTerm)]
ps ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty))
         else --trace (show (n, expandParams dec ps ns ty)) $
              Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> [FnOpt]
-> Name
-> FC
-> PTerm
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [FnOpt]
-> Name
-> FC
-> t
-> PDecl' t
PTy Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argdocs SyntaxInfo
syn FC
fc [FnOpt]
o Name
n FC
nfc ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty)
expandParamsD rhsonly :: Bool
rhsonly ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns (PPostulate e :: Bool
e doc :: Docstring (Either Err PTerm)
doc syn :: SyntaxInfo
syn fc :: FC
fc nfc :: FC
nfc o :: [FnOpt]
o n :: Name
n ty :: PTerm
ty)
    = if Name
n Name -> [Name] -> Bool
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)) $
              Bool
-> Docstring (Either Err PTerm)
-> SyntaxInfo
-> FC
-> FC
-> [FnOpt]
-> Name
-> PTerm
-> PDecl
forall t.
Bool
-> Docstring (Either Err t)
-> SyntaxInfo
-> FC
-> FC
-> [FnOpt]
-> Name
-> t
-> PDecl' t
PPostulate Bool
e Docstring (Either Err PTerm)
doc SyntaxInfo
syn FC
fc FC
nfc [FnOpt]
o (Name -> Name
dec Name
n)
                         ([(Name, PTerm)] -> PTerm -> PTerm
piBind [(Name, PTerm)]
ps ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty))
         else --trace (show (n, expandParams dec ps ns ty)) $
              Bool
-> Docstring (Either Err PTerm)
-> SyntaxInfo
-> FC
-> FC
-> [FnOpt]
-> Name
-> PTerm
-> PDecl
forall t.
Bool
-> Docstring (Either Err t)
-> SyntaxInfo
-> FC
-> FC
-> [FnOpt]
-> Name
-> t
-> PDecl' t
PPostulate Bool
e Docstring (Either Err PTerm)
doc SyntaxInfo
syn FC
fc FC
nfc [FnOpt]
o Name
n ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty)
expandParamsD rhsonly :: Bool
rhsonly ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns (PClauses fc :: FC
fc opts :: [FnOpt]
opts n :: Name
n cs :: [PClause' PTerm]
cs)
    = let n' :: Name
n' = if Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then Name -> Name
dec Name
n else Name
n in
          FC -> [FnOpt] -> Name -> [PClause' PTerm] -> PDecl
forall t. FC -> [FnOpt] -> Name -> [PClause' t] -> PDecl' t
PClauses FC
fc [FnOpt]
opts Name
n' ((PClause' PTerm -> PClause' PTerm)
-> [PClause' PTerm] -> [PClause' PTerm]
forall a b. (a -> b) -> [a] -> [b]
map PClause' PTerm -> PClause' PTerm
expandParamsC [PClause' PTerm]
cs)
  where
    expandParamsC :: PClause' PTerm -> PClause' PTerm
expandParamsC (PClause fc :: FC
fc n :: Name
n lhs :: PTerm
lhs ws :: [PTerm]
ws rhs :: PTerm
rhs ds :: [PDecl]
ds)
        = let -- ps' = updateps True (namesIn ist rhs) (zip ps [0..])
              ps'' :: [(Name, PTerm)]
ps'' = Bool -> [Name] -> [((Name, PTerm), Int)] -> [(Name, PTerm)]
forall (t :: * -> *) b.
Foldable t =>
Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps Bool
False ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [] IState
ist PTerm
lhs) ([(Name, PTerm)] -> [Int] -> [((Name, PTerm), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Name, PTerm)]
ps [0..])
              lhs' :: PTerm
lhs' = if Bool
rhsonly then PTerm
lhs else ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns [] PTerm
lhs)
              n' :: Name
n' = if Name
n Name -> [Name] -> Bool
forall (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
              FC
-> Name -> PTerm -> [PTerm] -> PTerm -> [PDecl] -> PClause' PTerm
forall t. FC -> Name -> t -> [t] -> t -> [PDecl' t] -> PClause' t
PClause FC
fc Name
n' PTerm
lhs'
                            ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns' []) [PTerm]
ws)
                            ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns' [] PTerm
rhs)
                            ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
True IState
ist Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns') [PDecl]
ds)
    expandParamsC (PWith fc :: FC
fc n :: Name
n lhs :: PTerm
lhs ws :: [PTerm]
ws wval :: PTerm
wval pn :: Maybe (Name, FC)
pn ds :: [PDecl]
ds)
        = let -- ps' = updateps True (namesIn ist wval) (zip ps [0..])
              ps'' :: [(Name, PTerm)]
ps'' = Bool -> [Name] -> [((Name, PTerm), Int)] -> [(Name, PTerm)]
forall (t :: * -> *) b.
Foldable t =>
Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps Bool
False ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [] IState
ist PTerm
lhs) ([(Name, PTerm)] -> [Int] -> [((Name, PTerm), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Name, PTerm)]
ps [0..])
              lhs' :: PTerm
lhs' = if Bool
rhsonly then PTerm
lhs else ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns [] PTerm
lhs)
              n' :: Name
n' = if Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then Name -> Name
dec Name
n else Name
n
              ns' :: [Name]
ns' = PTerm -> [Name] -> [Name]
removeBound PTerm
lhs [Name]
ns in
              FC
-> Name
-> PTerm
-> [PTerm]
-> PTerm
-> Maybe (Name, FC)
-> [PDecl]
-> PClause' PTerm
forall t.
FC
-> Name
-> t
-> [t]
-> t
-> Maybe (Name, FC)
-> [PDecl' t]
-> PClause' t
PWith FC
fc Name
n' PTerm
lhs'
                          ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns' []) [PTerm]
ws)
                          ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns' [] PTerm
wval)
                          Maybe (Name, FC)
pn
                          ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
rhsonly IState
ist Name -> Name
dec [(Name, PTerm)]
ps'' [Name]
ns') [PDecl]
ds)
    updateps :: Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps yn :: Bool
yn nm :: t Name
nm [] = []
    updateps yn :: Bool
yn nm :: t Name
nm (((a :: Name
a, t :: b
t), i :: Int
i):as :: [((Name, b), Int)]
as)
        | (Name
a Name -> t Name -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Name
nm) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
yn = (Name
a, b
t) (Name, b) -> [(Name, b)] -> [(Name, b)]
forall a. a -> [a] -> [a]
: Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps Bool
yn t Name
nm [((Name, b), Int)]
as
        | Bool
otherwise = (Int -> String -> Name
sMN Int
i (Name -> String
forall a. Show a => a -> String
show Name
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ "_shadow"), b
t) (Name, b) -> [(Name, b)] -> [(Name, b)]
forall a. a -> [a] -> [a]
: Bool -> t Name -> [((Name, b), Int)] -> [(Name, b)]
updateps Bool
yn t Name
nm [((Name, b), Int)]
as

    removeBound :: PTerm -> [Name] -> [Name]
removeBound lhs :: PTerm
lhs ns :: [Name]
ns = [Name]
ns [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub (PTerm -> [Name]
bnames PTerm
lhs)

    bnames :: PTerm -> [Name]
bnames (PRef _ _ n :: Name
n) = [Name
n]
    bnames (PApp _ _ args :: [PArg]
args) = (PArg -> [Name]) -> [PArg] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PTerm -> [Name]
bnames (PTerm -> [Name]) -> (PArg -> PTerm) -> PArg -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PArg -> PTerm
forall t. PArg' t -> t
getTm) [PArg]
args
    bnames (PPair _ _ _ l :: PTerm
l r :: PTerm
r) = PTerm -> [Name]
bnames PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ PTerm -> [Name]
bnames PTerm
r
    bnames (PDPair _ _ _ l :: PTerm
l Placeholder r :: PTerm
r) = PTerm -> [Name]
bnames PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ PTerm -> [Name]
bnames PTerm
r
    bnames _ = []

-- | Expands parameters defined in parameter and where blocks inside of declarations
expandParamsD rhs :: Bool
rhs ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns (PData doc :: Docstring (Either Err PTerm)
doc argDocs :: [(Name, Docstring (Either Err PTerm))]
argDocs syn :: SyntaxInfo
syn fc :: FC
fc co :: DataOpts
co pd :: PData' PTerm
pd)
    = Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> DataOpts
-> PData' PTerm
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> DataOpts
-> PData' t
-> PDecl' t
PData Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argDocs SyntaxInfo
syn FC
fc DataOpts
co (PData' PTerm -> PData' PTerm
expandPData PData' PTerm
pd)
  where
    -- just do the type decl, leave constructors alone (parameters will be
    -- added implicitly)
    expandPData :: PData' PTerm -> PData' PTerm
expandPData (PDatadecl n :: Name
n nfc :: FC
nfc ty :: PTerm
ty cons :: [(Docstring (Either Err PTerm),
  [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
  [Name])]
cons)
       = if Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns
            then Name
-> FC
-> PTerm
-> [(Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
     [Name])]
-> PData' PTerm
forall t.
Name
-> FC
-> t
-> [(Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
-> PData' t
PDatadecl (Name -> Name
dec Name
n) FC
nfc ([(Name, PTerm)] -> PTerm -> PTerm
piBind [(Name, PTerm)]
ps ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty))
                           (((Docstring (Either Err PTerm),
  [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
  [Name])
 -> (Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
     [Name]))
-> [(Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
     [Name])]
-> [(Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
     [Name])]
forall a b. (a -> b) -> [a] -> [b]
map (Docstring (Either Err PTerm),
 [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
 [Name])
-> (Docstring (Either Err PTerm),
    [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
    [Name])
forall a b d f g.
(a, b, Name, d, PTerm, f, g) -> (a, b, Name, d, PTerm, f, g)
econ [(Docstring (Either Err PTerm),
  [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
  [Name])]
cons)
            else Name
-> FC
-> PTerm
-> [(Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
     [Name])]
-> PData' PTerm
forall t.
Name
-> FC
-> t
-> [(Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
-> PData' t
PDatadecl Name
n FC
nfc ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty) (((Docstring (Either Err PTerm),
  [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
  [Name])
 -> (Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
     [Name]))
-> [(Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
     [Name])]
-> [(Docstring (Either Err PTerm),
     [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
     [Name])]
forall a b. (a -> b) -> [a] -> [b]
map (Docstring (Either Err PTerm),
 [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
 [Name])
-> (Docstring (Either Err PTerm),
    [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
    [Name])
forall a b d f g.
(a, b, Name, d, PTerm, f, g) -> (a, b, Name, d, PTerm, f, g)
econ [(Docstring (Either Err PTerm),
  [(Name, Docstring (Either Err PTerm))], Name, FC, PTerm, FC,
  [Name])]
cons)
    econ :: (a, b, Name, d, PTerm, f, g) -> (a, b, Name, d, PTerm, f, g)
econ (doc :: a
doc, argDocs :: b
argDocs, n :: Name
n, nfc :: d
nfc, t :: PTerm
t, fc :: f
fc, fs :: 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 rhs :: Bool
rhs ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns d :: PDecl
d@(PRecord doc :: Docstring (Either Err PTerm)
doc rsyn :: SyntaxInfo
rsyn fc :: FC
fc opts :: DataOpts
opts name :: Name
name nfc :: FC
nfc prs :: [(Name, FC, Plicity, PTerm)]
prs pdocs :: [(Name, Docstring (Either Err PTerm))]
pdocs fls :: [(Maybe (Name, FC), Plicity, PTerm,
  Maybe (Docstring (Either Err PTerm)))]
fls cn :: Maybe (Name, FC)
cn cdoc :: Docstring (Either Err PTerm)
cdoc csyn :: SyntaxInfo
csyn)
  = PDecl
d
expandParamsD rhs :: Bool
rhs ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns (PParams f :: FC
f params :: [(Name, PTerm)]
params pds :: [PDecl]
pds)
   = FC -> [(Name, PTerm)] -> [PDecl] -> PDecl
forall t. FC -> [(Name, t)] -> [PDecl' t] -> PDecl' t
PParams FC
f ([(Name, PTerm)]
ps [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> (Name, PTerm))
-> [(Name, PTerm)] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> (Name, PTerm) -> (Name, PTerm)
forall t b a. (t -> b) -> (a, t) -> (a, b)
mapsnd ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [])) [(Name, PTerm)]
params)
               ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
True IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns) [PDecl]
pds)
--                (map (expandParamsD ist dec ps ns) pds)
expandParamsD rhs :: Bool
rhs ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns (PMutual f :: FC
f pds :: [PDecl]
pds)
   = FC -> [PDecl] -> PDecl
forall t. FC -> [PDecl' t] -> PDecl' t
PMutual FC
f ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns) [PDecl]
pds)
expandParamsD rhs :: Bool
rhs ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns (PInterface doc :: Docstring (Either Err PTerm)
doc info :: SyntaxInfo
info f :: FC
f cs :: [(Name, PTerm)]
cs n :: Name
n nfc :: FC
nfc params :: [(Name, FC, PTerm)]
params pDocs :: [(Name, Docstring (Either Err PTerm))]
pDocs fds :: [(Name, FC)]
fds decls :: [PDecl]
decls cn :: Maybe (Name, FC)
cn cd :: Docstring (Either Err PTerm)
cd)
   = Docstring (Either Err PTerm)
-> SyntaxInfo
-> FC
-> [(Name, PTerm)]
-> Name
-> FC
-> [(Name, FC, PTerm)]
-> [(Name, Docstring (Either Err PTerm))]
-> [(Name, FC)]
-> [PDecl]
-> Maybe (Name, FC)
-> Docstring (Either Err PTerm)
-> PDecl
forall t.
Docstring (Either Err t)
-> SyntaxInfo
-> FC
-> [(Name, t)]
-> Name
-> FC
-> [(Name, FC, t)]
-> [(Name, Docstring (Either Err t))]
-> [(Name, FC)]
-> [PDecl' t]
-> Maybe (Name, FC)
-> Docstring (Either Err t)
-> PDecl' t
PInterface Docstring (Either Err PTerm)
doc SyntaxInfo
info FC
f
           (((Name, PTerm) -> (Name, PTerm))
-> [(Name, PTerm)] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (n :: Name
n, t :: PTerm
t) -> (Name
n, (Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
t)) [(Name, PTerm)]
cs)
           Name
n FC
nfc
           (((Name, FC, PTerm) -> (Name, FC, PTerm))
-> [(Name, FC, PTerm)] -> [(Name, FC, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (\(n :: Name
n, fc :: FC
fc, t :: PTerm
t) -> (Name
n, FC
fc, (Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
t)) [(Name, FC, PTerm)]
params)
           [(Name, Docstring (Either Err PTerm))]
pDocs
           [(Name, FC)]
fds
           ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
rhs IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns) [PDecl]
decls)
           Maybe (Name, FC)
cn
           Docstring (Either Err PTerm)
cd
expandParamsD rhs :: Bool
rhs ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns (PImplementation doc :: Docstring (Either Err PTerm)
doc argDocs :: [(Name, Docstring (Either Err PTerm))]
argDocs info :: SyntaxInfo
info f :: FC
f cs :: [(Name, PTerm)]
cs pnames :: [Name]
pnames acc :: Accessibility
acc opts :: [FnOpt]
opts n :: Name
n nfc :: FC
nfc params :: [PTerm]
params pextra :: [(Name, PTerm)]
pextra ty :: PTerm
ty cn :: Maybe Name
cn decls :: [PDecl]
decls)
   = let cn' :: Maybe Name
cn' = case Maybe Name
cn of
                    Just n :: Name
n -> if Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns then Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Name
dec Name
n) else Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
                    Nothing -> Maybe Name
forall a. Maybe a
Nothing in
     Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> [(Name, PTerm)]
-> [Name]
-> Accessibility
-> [FnOpt]
-> Name
-> FC
-> [PTerm]
-> [(Name, PTerm)]
-> PTerm
-> Maybe Name
-> [PDecl]
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [(Name, t)]
-> [Name]
-> Accessibility
-> [FnOpt]
-> Name
-> FC
-> [t]
-> [(Name, t)]
-> t
-> Maybe Name
-> [PDecl' t]
-> PDecl' t
PImplementation Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argDocs SyntaxInfo
info FC
f
                     (((Name, PTerm) -> (Name, PTerm))
-> [(Name, PTerm)] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (n :: Name
n, t :: PTerm
t) -> (Name
n, (Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
t)) [(Name, PTerm)]
cs)
                     [Name]
pnames Accessibility
acc [FnOpt]
opts Name
n
                     FC
nfc
                     ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns []) [PTerm]
params)
                     (((Name, PTerm) -> (Name, PTerm))
-> [(Name, PTerm)] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (n :: Name
n, t :: PTerm
t) -> (Name
n, (Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
t)) [(Name, PTerm)]
pextra)
                     ((Name -> Name)
-> [(Name, PTerm)] -> [Name] -> [Name] -> PTerm -> PTerm
expandParams Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns [] PTerm
ty)
                     Maybe Name
cn'
                     ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> IState
-> (Name -> Name)
-> [(Name, PTerm)]
-> [Name]
-> PDecl
-> PDecl
expandParamsD Bool
True IState
ist Name -> Name
dec [(Name, PTerm)]
ps [Name]
ns) [PDecl]
decls)
expandParamsD rhs :: Bool
rhs ist :: IState
ist dec :: Name -> Name
dec ps :: [(Name, PTerm)]
ps ns :: [Name]
ns d :: PDecl
d = PDecl
d

mapsnd :: (t -> b) -> (a, t) -> (a, b)
mapsnd f :: t -> b
f (x :: a
x, t :: t
t) = (a
x, t -> b
f t
t)

expandImplementationScope :: p -> p -> [(Name, t)] -> p -> PDecl' t -> PDecl' t
expandImplementationScope ist :: p
ist dec :: p
dec ps :: [(Name, t)]
ps ns :: p
ns (PImplementation doc :: Docstring (Either Err t)
doc argDocs :: [(Name, Docstring (Either Err t))]
argDocs info :: SyntaxInfo
info f :: FC
f cs :: [(Name, t)]
cs pnames :: [Name]
pnames acc :: Accessibility
acc opts :: [FnOpt]
opts n :: Name
n nfc :: FC
nfc params :: [t]
params pextra :: [(Name, t)]
pextra ty :: t
ty cn :: Maybe Name
cn decls :: [PDecl' t]
decls)
    = Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [(Name, t)]
-> [Name]
-> Accessibility
-> [FnOpt]
-> Name
-> FC
-> [t]
-> [(Name, t)]
-> t
-> Maybe Name
-> [PDecl' t]
-> PDecl' t
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> [(Name, t)]
-> [Name]
-> Accessibility
-> [FnOpt]
-> Name
-> FC
-> [t]
-> [(Name, t)]
-> t
-> Maybe Name
-> [PDecl' t]
-> PDecl' t
PImplementation Docstring (Either Err t)
doc [(Name, Docstring (Either Err t))]
argDocs SyntaxInfo
info FC
f [(Name, t)]
cs [Name]
pnames Accessibility
acc [FnOpt]
opts Name
n FC
nfc [t]
params ([(Name, t)]
ps [(Name, t)] -> [(Name, t)] -> [(Name, t)]
forall a. [a] -> [a] -> [a]
++ [(Name, t)]
pextra)
                      t
ty Maybe Name
cn [PDecl' t]
decls
expandImplementationScope ist :: p
ist dec :: p
dec ps :: [(Name, t)]
ps ns :: p
ns d :: 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 i :: IState
i tm :: PTerm
tm = 1

addStatics :: Name -> Term -> PTerm -> Idris ()
addStatics :: Name -> Term -> PTerm -> Idris ()
addStatics n :: Name
n tm :: Term
tm ptm :: PTerm
ptm =
    do let (statics :: [(Name, Term)]
statics, dynamics :: [(Name, Term)]
dynamics) = Term -> PTerm -> ([(Name, Term)], [(Name, Term)])
initStatics Term
tm PTerm
ptm
       IState
ist <- Idris IState
getIState
       let paramnames :: [Name]
paramnames
              = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ case Name -> Ctxt FnInfo -> Maybe FnInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt FnInfo
idris_fninfo IState
ist) of
                           Just p :: FnInfo
p -> Int -> [Int] -> Term -> [Name]
forall (t :: * -> *) a a.
(Foldable t, Eq a, Num a) =>
a -> t a -> TT a -> [a]
getNamesFrom 0 (FnInfo -> [Int]
fn_params FnInfo
p) Term
tm [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
                                     ((Name, Term) -> [Name]) -> [(Name, Term)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IState -> Term -> [Name]
getParamNames IState
ist (Term -> [Name])
-> ((Name, Term) -> Term) -> (Name, Term) -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Term) -> Term
forall a b. (a, b) -> b
snd) [(Name, Term)]
statics
                           _ -> ((Name, Term) -> [Name]) -> [(Name, Term)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IState -> Term -> [Name]
getParamNames IState
ist (Term -> [Name])
-> ((Name, Term) -> Term) -> (Name, Term) -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Term) -> Term
forall a b. (a, b) -> b
snd) [(Name, Term)]
statics

       let stnames :: [Name]
stnames = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ((Name, Term) -> [Name]) -> [(Name, Term)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Term -> [Name]
forall b. Eq b => TT b -> [b]
freeArgNames (Term -> [Name])
-> ((Name, Term) -> Term) -> (Name, Term) -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Term) -> Term
forall a b. (a, b) -> b
snd) [(Name, Term)]
statics
       let dnames :: [Name]
dnames = ([Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ((Name, Term) -> [Name]) -> [(Name, Term)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Term -> [Name]
forall b. Eq b => TT b -> [b]
freeArgNames (Term -> [Name])
-> ((Name, Term) -> Term) -> (Name, Term) -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Term) -> Term
forall a b. (a, b) -> b
snd) [(Name, Term)]
dynamics)
                             [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
paramnames
       -- 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' = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ((Name, Term) -> Name) -> [(Name, Term)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Term) -> Name
forall a b. (a, b) -> a
fst [(Name, Term)]
statics [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
                              (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (\x :: Name
x -> Bool -> Bool
not (Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
x [Name]
dnames)) [Name]
stnames
       let stpos :: [Bool]
stpos = [Name] -> Term -> [Bool]
forall (t :: * -> *) a. (Foldable t, Eq a) => t a -> TT a -> [Bool]
staticList [Name]
statics' Term
tm
       IState
i <- Idris IState
getIState
       Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Name, Term)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, Term)]
statics) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
          Int -> String -> Idris ()
logLvl 3 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Statics for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
tm String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n"
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ PTerm -> String
showTmImpls PTerm
ptm String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n"
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Name, Term)] -> String
forall a. Show a => a -> String
show [(Name, Term)]
statics String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Name, Term)] -> String
forall a. Show a => a -> String
show [(Name, Term)]
dynamics
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Name] -> String
forall a. Show a => a -> String
show [Name]
paramnames
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Bool] -> String
forall a. Show a => a -> String
show [Bool]
stpos
       IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_statics :: Ctxt [Bool]
idris_statics = Name -> [Bool] -> Ctxt [Bool] -> Ctxt [Bool]
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 n :: Name
n (Pi _ _ ty :: Term
ty _) sc :: Term
sc) (PPi p :: Plicity
p n' :: Name
n' fc :: FC
fc t :: PTerm
t s :: PTerm
s)
            | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
n' = let (static :: [(Name, Term)]
static, dynamic :: [(Name, Term)]
dynamic) = Term -> PTerm -> ([(Name, Term)], [(Name, Term)])
initStatics Term
sc (Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
n' FC
fc PTerm
t PTerm
s) in
                            ([(Name, Term)]
static, (Name
n, Term
ty) (Name, Term) -> [(Name, Term)] -> [(Name, Term)]
forall a. a -> [a] -> [a]
: [(Name, Term)]
dynamic)
    initStatics (Bind n :: Name
n (Pi _ _ ty :: Term
ty _) sc :: Term
sc) (PPi p :: Plicity
p n' :: Name
n' fc :: FC
fc _ s :: PTerm
s)
            = let (static :: [(Name, Term)]
static, dynamic :: [(Name, Term)]
dynamic) = Term -> PTerm -> ([(Name, Term)], [(Name, Term)])
initStatics (Term -> Term -> Term
forall n. TT n -> TT n -> TT n
instantiate (NameType -> Name -> Term -> Term
forall n. NameType -> n -> TT n -> TT n
P NameType
Bound Name
n Term
ty) Term
sc) PTerm
s in
                  if Plicity -> Static
pstatic Plicity
p Static -> Static -> Bool
forall a. Eq a => a -> a -> Bool
== Static
Static then ((Name
n, Term
ty) (Name, Term) -> [(Name, Term)] -> [(Name, Term)]
forall a. a -> [a] -> [a]
: [(Name, Term)]
static, [(Name, Term)]
dynamic)
                    else if (Bool -> Bool
not (Plicity -> Bool
searchArg Plicity
p))
                            then ([(Name, Term)]
static, (Name
n, Term
ty) (Name, Term) -> [(Name, Term)] -> [(Name, Term)]
forall a. a -> [a] -> [a]
: [(Name, Term)]
dynamic)
                            else ([(Name, Term)]
static, [(Name, Term)]
dynamic)
    initStatics t :: Term
t pt :: PTerm
pt = ([], [])

    getParamNames :: IState -> Term -> [Name]
getParamNames ist :: IState
ist tm :: Term
tm | (P _ n :: Name
n _ , args :: [Term]
args) <- Term -> (Term, [Term])
forall n. TT n -> (TT n, [TT n])
unApply Term
tm
       = case Name -> Ctxt TypeInfo -> Maybe TypeInfo
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
n (IState -> Ctxt TypeInfo
idris_datatypes IState
ist) of
              Just ti :: TypeInfo
ti -> Int -> [Int] -> [Term] -> [Name]
forall (t :: * -> *) a a.
(Foldable t, Eq a, Num a) =>
a -> t a -> [TT a] -> [a]
getNamePos 0 (TypeInfo -> [Int]
param_pos TypeInfo
ti) [Term]
args
              Nothing -> []
      where getNamePos :: a -> t a -> [TT a] -> [a]
getNamePos i :: a
i ps :: t a
ps [] = []
            getNamePos i :: a
i ps :: t a
ps (P _ n :: a
n _ : as :: [TT a]
as)
                 | a
i a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
ps = a
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> t a -> [TT a] -> [a]
getNamePos (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ 1) t a
ps [TT a]
as
            getNamePos i :: a
i ps :: t a
ps (_ : as :: [TT a]
as) = a -> t a -> [TT a] -> [a]
getNamePos (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ 1) t a
ps [TT a]
as
    getParamNames ist :: IState
ist (Bind t :: Name
t (Pi _ _ (P _ n :: Name
n _) _) sc :: Term
sc)
       = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: IState -> Term -> [Name]
getParamNames IState
ist Term
sc
    getParamNames ist :: IState
ist _ = []

    getNamesFrom :: a -> t a -> TT a -> [a]
getNamesFrom i :: a
i ps :: t a
ps (Bind n :: a
n (Pi _ _ _ _) sc :: TT a
sc)
       | a
i a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
ps = a
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> t a -> TT a -> [a]
getNamesFrom (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ 1) t a
ps TT a
sc
       | Bool
otherwise = a -> t a -> TT a -> [a]
getNamesFrom (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ 1) t a
ps TT a
sc
    getNamesFrom i :: a
i ps :: t a
ps sc :: TT a
sc = []

    freeArgNames :: TT b -> [b]
freeArgNames (Bind n :: b
n (Pi _ _ ty :: TT b
ty _) sc :: TT b
sc)
          = [b] -> [b]
forall a. Eq a => [a] -> [a]
nub ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ TT b -> [b]
forall b. Eq b => TT b -> [b]
freeNames TT b
ty [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ TT b -> [b]
forall b. Eq b => TT b -> [b]
freeNames TT b
sc -- treat '->' as fn here
    freeArgNames tm :: TT b
tm = let (_, args :: [TT b]
args) = TT b -> (TT b, [TT b])
forall n. TT n -> (TT n, [TT n])
unApply TT b
tm in
                          (TT b -> [b]) -> [TT b] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TT b -> [b]
forall b. Eq b => TT b -> [b]
freeNames [TT b]
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 _ _ _) = Bool
True
    searchArg (TacImp _ _ _ _) = Bool
True
    searchArg _ = Bool
False

    staticList :: t a -> TT a -> [Bool]
staticList sts :: t a
sts (Bind n :: a
n (Pi _ _ _ _) sc :: TT a
sc) = (a
n a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
sts) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: t a -> TT a -> [Bool]
staticList t a
sts TT a
sc
    staticList _ _ = []

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

-- Add constraint bindings from using block

addUsingConstraints :: SyntaxInfo -> FC -> PTerm -> Idris PTerm
addUsingConstraints :: SyntaxInfo -> FC -> PTerm -> Idris PTerm
addUsingConstraints syn :: SyntaxInfo
syn fc :: FC
fc t :: PTerm
t
   = do IState
ist <- Idris IState
forall s (m :: * -> *). MonadState s m => m s
get
        let ns :: [Name]
ns = [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [] IState
ist PTerm
t
        let cs :: [Using]
cs = PTerm -> [Using]
getConstraints PTerm
t -- check declared constraints
        let addconsts :: [Using]
addconsts = [Using]
uconsts [Using] -> [Using] -> [Using]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Using]
cs
        PTerm -> Idris PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return ([Using] -> [Name] -> PTerm -> PTerm
forall (t :: * -> *).
Foldable t =>
[Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
addconsts [Name]
ns PTerm
t)
   where uconsts :: [Using]
uconsts = (Using -> Bool) -> [Using] -> [Using]
forall a. (a -> Bool) -> [a] -> [a]
filter Using -> Bool
uconst (SyntaxInfo -> [Using]
using SyntaxInfo
syn)
         uconst :: Using -> Bool
uconst (UConstraint _ _) = Bool
True
         uconst _ = Bool
False

         doAdd :: [Using] -> t Name -> PTerm -> PTerm
doAdd [] _ t :: PTerm
t = PTerm
t
         -- if all of args in ns, then add it
         doAdd (UConstraint c :: Name
c args :: [Name]
args : cs :: [Using]
cs) ns :: t Name
ns t :: PTerm
t
             | (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\n :: Name
n -> Name -> t Name -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n t Name
ns) [Name]
args
                   = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi ([ArgOpt] -> Static -> RigCount -> Plicity
Constraint [] Static
Dynamic RigCount
RigW) (Int -> String -> Name
sMN 0 "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 c :: Name
c args :: [Name]
args = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc [] Name
c)
                           ((Name -> PArg) -> [Name] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp 0 [] (Int -> String -> Name
sMN 0 "carg") (PTerm -> PArg) -> (Name -> PTerm) -> Name -> PArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FC -> [FC] -> Name -> PTerm
PRef FC
fc []) [Name]
args)

         getConstraints :: PTerm -> [Using]
getConstraints (PPi (Constraint _ _ _) _ _ c :: PTerm
c sc :: PTerm
sc)
             = PTerm -> [Using]
getcapp PTerm
c [Using] -> [Using] -> [Using]
forall a. [a] -> [a] -> [a]
++ PTerm -> [Using]
getConstraints PTerm
sc
         getConstraints (PPi _ _ _ c :: PTerm
c sc :: PTerm
sc) = PTerm -> [Using]
getConstraints PTerm
sc
         getConstraints _ = []

         getcapp :: PTerm -> [Using]
getcapp (PApp _ (PRef _ _ c :: Name
c) args :: [PArg]
args)
             = do [Name]
ns <- (PArg -> [Name]) -> [PArg] -> [[Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PArg -> [Name]
getName [PArg]
args
                  Using -> [Using]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Name] -> Using
UConstraint Name
c [Name]
ns)
         getcapp _ = []

         getName :: PArg -> [Name]
getName (PExp _ _ _ (PRef _ _ n :: Name
n)) = Name -> [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
         getName _ = []

-- | 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 syn :: SyntaxInfo
syn n :: Name
n fc :: FC
fc t :: PTerm
t
   = do IState
ist <- Idris IState
getIState
        Bool
autoimpl <- Idris Bool
getAutoImpls
        let ns_in :: [Name]
ns_in = [Name] -> IState -> PTerm -> [Name]
implicitNamesIn ((Using -> Name) -> [Using] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls) IState
ist PTerm
t
        let ns :: [Name]
ns = if Bool
autoimpl then [Name]
ns_in
                    else (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (\n :: Name
n -> Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Using -> Name) -> [Using] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls)) [Name]
ns_in

        let badnames :: [Name]
badnames = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (\n :: Name
n -> Bool -> Bool
not (Name -> Bool
implicitable Name
n) Bool -> Bool -> Bool
&&
                                     Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((Using -> Name) -> [Using] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls)) [Name]
ns
        Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
badnames) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
           Err -> Idris ()
forall a. Err -> Idris a
throwError (FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc (String -> Name -> Maybe Term -> Err -> Err
forall t. String -> Name -> Maybe t -> Err' t -> Err' t
Elaborating "type of " Name
n Maybe Term
forall a. Maybe a
Nothing
                         (Name -> Err
forall t. Name -> Err' t
NoSuchVariable ([Name] -> Name
forall a. [a] -> a
head [Name]
badnames))))
        let cs :: [Name]
cs = PTerm -> [Name]
getArgnames PTerm
t -- get already bound names
        let addimpls :: [Using]
addimpls = (Using -> Bool) -> [Using] -> [Using]
forall a. (a -> Bool) -> [a] -> [a]
filter (\n :: Using
n -> Using -> Name
iname Using
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
cs) [Using]
uimpls
        -- if all names in the arguments of addconsts appear in ns,
        -- add the constraint implicitly
        PTerm -> Idris PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name] -> PTerm -> PTerm
bindFree [Name]
ns ([Using] -> [Name] -> PTerm -> PTerm
forall (t :: * -> *).
Foldable t =>
[Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
addimpls [Name]
ns PTerm
t))
   where uimpls :: [Using]
uimpls = (Using -> Bool) -> [Using] -> [Using]
forall a. (a -> Bool) -> [a] -> [a]
filter Using -> Bool
uimpl (SyntaxInfo -> [Using]
using SyntaxInfo
syn)
         uimpl :: Using -> Bool
uimpl (UImplicit _ _) = Bool
True
         uimpl _ = Bool
False

         iname :: Using -> Name
iname (UImplicit n :: Name
n _) = Name
n
         iname (UConstraint _ _) = String -> Name
forall a. HasCallStack => String -> a
error "Can't happen addUsingImpls"

         doAdd :: [Using] -> t Name -> PTerm -> PTerm
doAdd [] _ t :: PTerm
t = PTerm
t
         -- if all of args in ns, then add it
         doAdd (UImplicit n :: Name
n ty :: PTerm
ty : cs :: [Using]
cs) ns :: t Name
ns t :: PTerm
t
             | Name -> t Name -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n t Name
ns
                   = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
impl_gen Name
n FC
NoFC PTerm
ty ([Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
cs t Name
ns PTerm
t)
             | Bool
otherwise = [Using] -> t Name -> PTerm -> PTerm
doAdd [Using]
cs t Name
ns PTerm
t

         -- bind the free names which weren't in the using block
         bindFree :: [Name] -> PTerm -> PTerm
bindFree [] tm :: PTerm
tm = PTerm
tm
         bindFree (n :: Name
n:ns :: [Name]
ns) tm :: PTerm
tm
             | Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n ((Using -> Name) -> [Using] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Using -> Name
iname [Using]
uimpls) = [Name] -> PTerm -> PTerm
bindFree [Name]
ns PTerm
tm
             | Bool
otherwise
                    = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi (Plicity
impl_gen { pargopts :: [ArgOpt]
pargopts = [ArgOpt
InaccessibleArg] }) Name
n FC
NoFC PTerm
Placeholder ([Name] -> PTerm -> PTerm
bindFree [Name]
ns PTerm
tm)

         getArgnames :: PTerm -> [Name]
getArgnames (PPi _ n :: Name
n _ c :: PTerm
c sc :: PTerm
sc)
             = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: PTerm -> [Name]
getArgnames PTerm
sc
         getArgnames _ = []

-- 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 i :: IState
i t :: Term
t tm :: 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 p :: Plicity
p n :: Name
n _ t :: PTerm
t sc :: PTerm
sc)
            = (Name
n, (Plicity
p, PTerm
t)) (Name, (Plicity, PTerm))
-> [(Name, (Plicity, PTerm))] -> [(Name, (Plicity, PTerm))]
forall a. a -> [a] -> [a]
: PTerm -> [(Name, (Plicity, PTerm))]
collectImps PTerm
sc
        collectImps _ = []

        scopedimpl :: Maybe ImplicitInfo -> Bool
scopedimpl (Just i :: ImplicitInfo
i) = Bool -> Bool
not (ImplicitInfo -> Bool
toplevel_imp ImplicitInfo
i)
        scopedimpl _ = Bool
False

        getImps :: Term -> [(Name, (Plicity, PTerm))] -> [(Bool, PArg)]
getImps (Bind n :: Name
n (Pi _ i :: Maybe ImplicitInfo
i _ _) sc :: Term
sc) imps :: [(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 n :: Name
n (Pi _ _ t :: Term
t _) sc :: Term
sc) imps :: [(Name, (Plicity, PTerm))]
imps
            | Just (p :: Plicity
p, t' :: PTerm
t') <- Name -> [(Name, (Plicity, PTerm))] -> Maybe (Plicity, PTerm)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, (Plicity, PTerm))]
imps = Name -> Plicity -> PTerm -> (Bool, PArg)
argInfo Name
n Plicity
p PTerm
t' (Bool, PArg) -> [(Bool, PArg)] -> [(Bool, PArg)]
forall a. a -> [a] -> [a]
: Term -> [(Name, (Plicity, PTerm))] -> [(Bool, PArg)]
getImps Term
sc [(Name, (Plicity, PTerm))]
imps
         where
            argInfo :: Name -> Plicity -> PTerm -> (Bool, PArg)
argInfo n :: Name
n (Imp opt :: [ArgOpt]
opt _ _ _ _ _) Placeholder
                   = (Bool
True, Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp 0 Bool
True [ArgOpt]
opt Name
n PTerm
Placeholder)
            argInfo n :: Name
n (Imp opt :: [ArgOpt]
opt _ _ _ _ _) t' :: PTerm
t'
                   = (ArgOpt
InaccessibleArg ArgOpt -> [ArgOpt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
                          Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp (IState -> PTerm -> Int
getPriority IState
i PTerm
t') Bool
True [ArgOpt]
opt Name
n PTerm
t')
            argInfo n :: Name
n (Exp opt :: [ArgOpt]
opt _ _ _) t' :: PTerm
t'
                   = (ArgOpt
InaccessibleArg ArgOpt -> [ArgOpt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
                          Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp (IState -> PTerm -> Int
getPriority IState
i PTerm
t') [ArgOpt]
opt Name
n PTerm
t')
            argInfo n :: Name
n (Constraint opt :: [ArgOpt]
opt _ _) t' :: PTerm
t'
                   = (ArgOpt
InaccessibleArg ArgOpt -> [ArgOpt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
                          Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint 10 [ArgOpt]
opt Name
n PTerm
t')
            argInfo n :: Name
n (TacImp opt :: [ArgOpt]
opt _ scr :: PTerm
scr _) t' :: PTerm
t'
                   = (ArgOpt
InaccessibleArg ArgOpt -> [ArgOpt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ArgOpt]
opt,
                          Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit 10 [ArgOpt]
opt Name
n PTerm
scr PTerm
t')
        getImps (Bind n :: Name
n (Pi _ _ t :: Term
t _) sc :: Term
sc) imps :: [(Name, (Plicity, PTerm))]
imps = Name -> Term -> (Bool, PArg)
forall p. Name -> p -> (Bool, PArg)
impBind Name
n Term
t (Bool, PArg) -> [(Bool, PArg)] -> [(Bool, PArg)]
forall a. a -> [a] -> [a]
: Term -> [(Name, (Plicity, PTerm))] -> [(Bool, PArg)]
getImps Term
sc [(Name, (Plicity, PTerm))]
imps
           where impBind :: Name -> p -> (Bool, PArg)
impBind n :: Name
n t :: p
t = (Bool
True, Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp 1 Bool
True [] Name
n PTerm
Placeholder)
        getImps sc :: Term
sc tm :: [(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 info :: ElabInfo
info syn :: SyntaxInfo
syn n :: Name
n ptm :: 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' info :: ElabInfo
info syn :: SyntaxInfo
syn ignore :: [Name]
ignore n :: Name
n ptm :: PTerm
ptm
    = do IState
i <- Idris IState
getIState
         Bool
auto <- Idris Bool
getAutoImpls
         let (tm' :: PTerm
tm', impdata :: [PArg]
impdata) = Bool -> SyntaxInfo -> [Name] -> IState -> PTerm -> (PTerm, [PArg])
implicitise Bool
auto SyntaxInfo
syn [Name]
ignore IState
i PTerm
ptm
         [Name] -> [PArg] -> Idris ()
defaultArgCheck (ElabInfo -> [Name]
eInfoNames ElabInfo
info [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ Ctxt [PArg] -> [Name]
forall k a. Map k a -> [k]
M.keys (IState -> Ctxt [PArg]
idris_implicits IState
i)) [PArg]
impdata
--          let (tm'', spos) = findStatics i tm'
         IState -> Idris ()
putIState (IState -> Idris ()) -> IState -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState
i { idris_implicits :: Ctxt [PArg]
idris_implicits = Name -> [PArg] -> Ctxt [PArg] -> Ctxt [PArg]
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 -> String -> Idris ()
logLvl 5 ("Implicit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PArg] -> String
forall a. Show a => a -> String
show [PArg]
impdata)
--          i <- get
--          putIState $ i { idris_statics = addDef n spos (idris_statics i) }
         PTerm -> Idris PTerm
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 knowns :: [Name]
knowns params :: [PArg]
params = ([Name] -> PArg -> Idris [Name]) -> [Name] -> [PArg] -> Idris ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ [Name] -> PArg -> Idris [Name]
notFoundInDefault [Name]
knowns [PArg]
params

    notFoundInDefault :: [Name] -> PArg -> Idris [Name]
    notFoundInDefault :: [Name] -> PArg -> Idris [Name]
notFoundInDefault kns :: [Name]
kns (PTacImplicit _ _ n :: Name
n script :: PTerm
script _)
      = 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
              Nothing     -> [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
kns)
              Just name :: Name
name   -> Err -> Idris [Name]
forall a. Err -> Idris a
throwError (Name -> Err
forall t. Name -> Err' t
NoSuchVariable Name
name)
    notFoundInDefault kns :: [Name]
kns p :: PArg
p = [Name] -> Idris [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return ((PArg -> Name
forall t. PArg' t -> Name
pname PArg
p)Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
kns)

    notFound :: [Name] -> [Name] -> Maybe Name
    notFound :: [Name] -> [Name] -> Maybe Name
notFound kns :: [Name]
kns [] = Maybe Name
forall a. Maybe a
Nothing
    notFound kns :: [Name]
kns (SN (WhereN _ _ _) : ns :: [Name]
ns) = [Name] -> [Name] -> Maybe Name
notFound [Name]
kns [Name]
ns --  Known already
    notFound kns :: [Name]
kns (n :: Name
n:ns :: [Name]
ns) = if Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n [Name]
kns then [Name] -> [Name] -> Maybe Name
notFound [Name]
kns [Name]
ns else Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n

-- | 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 auto :: Bool
auto syn :: SyntaxInfo
syn ignore :: [Name]
ignore ist :: IState
ist tm :: PTerm
tm = -- trace ("INCOMING " ++ showImp True tm) $
      let (declimps :: [PArg]
declimps, ns' :: [Name]
ns') = State ([PArg], [Name]) () -> ([PArg], [Name]) -> ([PArg], [Name])
forall s a. State s a -> s -> s
execState (Bool -> [Name] -> PTerm -> State ([PArg], [Name]) ()
forall (m :: * -> *).
MonadState ([PArg], [Name]) m =>
Bool -> [Name] -> PTerm -> m ()
imps Bool
True [] PTerm
tm) ([], [])
          ns :: [Name]
ns = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (\n :: Name
n -> Bool
auto Bool -> Bool -> Bool
&& Name -> Bool
implicitable Name
n Bool -> Bool -> Bool
|| Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
uvars)) ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$
                  [Name]
ns' [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ (((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
pvars [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ SyntaxInfo -> [Name]
no_imp SyntaxInfo
syn [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
ignore)
          nsOrder :: [Name]
nsOrder = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Bool
inUsing) [Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
inUsing [Name]
ns in
          if [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ns
            then (PTerm
tm, [PArg] -> [PArg]
forall a. [a] -> [a]
reverse [PArg]
declimps)
            else Bool -> SyntaxInfo -> [Name] -> IState -> PTerm -> (PTerm, [PArg])
implicitise Bool
auto SyntaxInfo
syn [Name]
ignore IState
ist ([(Name, PTerm)] -> [Name] -> PTerm -> PTerm
pibind [(Name, PTerm)]
uvars [Name]
nsOrder PTerm
tm)
  where
    uvars :: [(Name, PTerm)]
uvars = (Using -> (Name, PTerm)) -> [Using] -> [(Name, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map Using -> (Name, PTerm)
ipair ((Using -> Bool) -> [Using] -> [Using]
forall a. (a -> Bool) -> [a] -> [a]
filter Using -> Bool
uimplicit (SyntaxInfo -> [Using]
using SyntaxInfo
syn))
    pvars :: [(Name, PTerm)]
pvars = SyntaxInfo -> [(Name, PTerm)]
syn_params SyntaxInfo
syn

    inUsing :: Name -> Bool
inUsing n :: Name
n = Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, PTerm)]
uvars

    ipair :: Using -> (Name, PTerm)
ipair (UImplicit x :: Name
x y :: PTerm
y) = (Name
x, PTerm
y)
    uimplicit :: Using -> Bool
uimplicit (UImplicit _ _) = Bool
True
    uimplicit _ = Bool
False

    dropAll :: [a] -> t a -> [a]
dropAll (x :: a
x:xs :: [a]
xs) ys :: t a
ys | a
x a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
ys = [a] -> t a -> [a]
dropAll [a]
xs t a
ys
                      | Bool
otherwise   = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> t a -> [a]
dropAll [a]
xs t a
ys
    dropAll [] ys :: 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 uv :: [(Name, b)]
uv (PApp fc :: FC
fc f :: PTerm
f args :: [PArg]
args) = (PArg -> [Name]) -> [PArg] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, b)]
uv (PTerm -> [Name]) -> (PArg -> PTerm) -> PArg -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PArg -> PTerm
forall t. PArg' t -> t
getTm) [PArg]
args
    implNamesIn uv :: [(Name, b)]
uv t :: PTerm
t = [Name] -> IState -> PTerm -> [Name]
implicitNamesIn (((Name, b) -> Name) -> [(Name, b)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, b) -> Name
forall a b. (a, b) -> a
fst [(Name, b)]
uv) IState
ist PTerm
t

    imps :: Bool -> [Name] -> PTerm -> m ()
imps top :: Bool
top env :: [Name]
env ty :: PTerm
ty@(PApp _ f :: PTerm
f as :: [PArg]
as)
       = do (decls :: [PArg]
decls, ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
            let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall b. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty)
            ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
    imps top :: Bool
top env :: [Name]
env (PPi (Imp l :: [ArgOpt]
l _ _ _ _ _) n :: Name
n _ ty :: PTerm
ty sc :: PTerm
sc)
        = do let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall b. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty) [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
             (decls :: [PArg]
decls , ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
             ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp (IState -> PTerm -> Int
getPriority IState
ist PTerm
ty) Bool
True [ArgOpt]
l Name
n PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: [PArg]
decls,
                  [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
             Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
    imps top :: Bool
top env :: [Name]
env (PPi (Exp l :: [ArgOpt]
l _ _ _) n :: Name
n _ ty :: PTerm
ty sc :: PTerm
sc)
        = do let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall b. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ case PTerm
sc of
                            (PRef _ _ x :: Name
x) -> [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
sc [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
                            _ -> [])
             (decls :: [PArg]
decls, ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get -- ignore decls in HO types
             ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp (IState -> PTerm -> Int
getPriority IState
ist PTerm
ty) [ArgOpt]
l Name
n PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: [PArg]
decls,
                  [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
             Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
    imps top :: Bool
top env :: [Name]
env (PPi (Constraint l :: [ArgOpt]
l _ _) n :: Name
n _ ty :: PTerm
ty sc :: PTerm
sc)
        = do let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall b. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ case PTerm
sc of
                            (PRef _ _ x :: Name
x) -> [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
sc [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
                            _ -> [])
             (decls :: [PArg]
decls, ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get -- ignore decls in HO types
             ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint 10 [ArgOpt]
l Name
n PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: [PArg]
decls,
                  [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
             Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
    imps top :: Bool
top env :: [Name]
env (PPi (TacImp l :: [ArgOpt]
l _ scr :: PTerm
scr _) n :: Name
n _ ty :: PTerm
ty sc :: PTerm
sc)
        = do let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> PTerm -> [Name]
forall b. [(Name, b)] -> PTerm -> [Name]
implNamesIn [(Name, PTerm)]
uvars PTerm
ty [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ case PTerm
sc of
                            (PRef _ _ x :: Name
x) -> [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
sc [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` [Name
n]
                            _ -> [])
             (decls :: [PArg]
decls, ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get -- ignore decls in HO types
             ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit 10 [ArgOpt]
l Name
n PTerm
scr PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: [PArg]
decls,
                  [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
             Bool -> [Name] -> PTerm -> m ()
imps Bool
True (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
    imps top :: Bool
top env :: [Name]
env (PRewrite _ _ l :: PTerm
l r :: PTerm
r _)
        = do (decls :: [PArg]
decls, ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
             let isn :: [Name]
isn = [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r
             ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
    imps top :: Bool
top env :: [Name]
env (PTyped l :: PTerm
l r :: PTerm
r)
        = Bool -> [Name] -> PTerm -> m ()
imps Bool
top [Name]
env PTerm
l
    imps top :: Bool
top env :: [Name]
env (PPair _ _ _ l :: PTerm
l r :: PTerm
r)
        = do (decls :: [PArg]
decls, ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
             let isn :: [Name]
isn = [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r
             ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
    imps top :: Bool
top env :: [Name]
env (PDPair _ _ _ (PRef _ _ n :: Name
n) t :: PTerm
t r :: PTerm
r)
        = do (decls :: [PArg]
decls, ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
             let isn :: [Name]
isn = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
t [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r) [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name
n]
             ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
    imps top :: Bool
top env :: [Name]
env (PDPair _ _ _ l :: PTerm
l t :: PTerm
t r :: PTerm
r)
        = do (decls :: [PArg]
decls, ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
             let isn :: [Name]
isn = [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
l [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
t [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
                       [(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist PTerm
r
             ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
    imps top :: Bool
top env :: [Name]
env (PAlternative ms :: [(Name, Name)]
ms a :: PAltType
a as :: [PTerm]
as)
        = do (decls :: [PArg]
decls, ns :: [Name]
ns) <- m ([PArg], [Name])
forall s (m :: * -> *). MonadState s m => m s
get
             let isn :: [Name]
isn = (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [(Name, PTerm)]
uvars IState
ist) [PTerm]
as
             ([PArg], [Name]) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([PArg]
decls, [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
isn [Name] -> [Name] -> [Name]
forall (t :: * -> *) a. (Foldable t, Eq a) => [a] -> t a -> [a]
`dropAll` ([Name]
env [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, PTerm) -> Name) -> [(Name, PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm) -> Name
forall a b. (a, b) -> a
fst ([PArg] -> [(Name, PTerm)]
getImps [PArg]
decls)))))
    imps top :: Bool
top env :: [Name]
env (PLam fc :: FC
fc n :: Name
n _ ty :: PTerm
ty sc :: PTerm
sc)
        = do Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
ty
             Bool -> [Name] -> PTerm -> m ()
imps Bool
False (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
env) PTerm
sc
    imps top :: Bool
top env :: [Name]
env (PHidden tm :: PTerm
tm)    = Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
tm
    imps top :: Bool
top env :: [Name]
env (PUnifyLog tm :: PTerm
tm)  = Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
tm
    imps top :: Bool
top env :: [Name]
env (PNoImplicits tm :: PTerm
tm)  = Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
tm
    imps top :: Bool
top env :: [Name]
env (PRunElab fc :: FC
fc tm :: PTerm
tm ns :: [String]
ns) = Bool -> [Name] -> PTerm -> m ()
imps Bool
False [Name]
env PTerm
tm
    imps top :: Bool
top env :: [Name]
env (PConstSugar fc :: FC
fc tm :: PTerm
tm) = Bool -> [Name] -> PTerm -> m ()
imps Bool
top [Name]
env PTerm
tm -- ignore PConstSugar - it's for highlighting only!
    imps top :: Bool
top env :: [Name]
env _               = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    pibind :: [(Name, PTerm)] -> [Name] -> PTerm -> PTerm
pibind using :: [(Name, PTerm)]
using []     sc :: PTerm
sc = PTerm
sc
    pibind using :: [(Name, PTerm)]
using (n :: Name
n:ns :: [Name]
ns) sc :: PTerm
sc
      = case Name -> [(Name, PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, PTerm)]
using of
            Just ty :: 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)
            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 ist :: IState
ist ns :: [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 ist :: IState
ist ns :: [Name]
ns inf :: [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' inpat :: Bool
inpat env :: [Name]
env infns :: [Name]
infns imp_meths :: [Name]
imp_meths ist :: IState
ist ptm :: PTerm
ptm
   = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
False ([Name] -> [Maybe PTerm] -> [(Name, Maybe PTerm)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
env (Maybe PTerm -> [Maybe PTerm]
forall a. a -> [a]
repeat Maybe PTerm
forall a. Maybe a
Nothing)) [] ([Name] -> [(Name, Name)] -> PTerm -> PTerm
mkUniqueNames [Name]
env [] PTerm
ptm)
  where
    allowcap :: Bool
allowcap = Opt
AllowCapitalizedPatternVariables Opt -> [Opt] -> Bool
forall (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 _ _ n :: Name
n -> Name
n
                   PApp _ (PRef _ _ n :: Name
n) _ -> Name
n
                   _ -> String -> Name
sUN "" -- doesn't matter then

    ai :: Bool -> Bool -> [(Name, Maybe PTerm)] -> [[T.Text]] -> PTerm -> PTerm
    ai :: Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PRef fc :: FC
fc fcs :: [FC]
fcs f :: Name
f)
        | Name
f Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infns = FC -> [FC] -> Name -> PTerm
PInferRef FC
fc [FC]
fcs Name
f
        | Bool -> Bool
not (Name
f Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Name, Maybe PTerm) -> Name) -> [(Name, Maybe PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Maybe PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, Maybe PTerm)]
env) = Either Err PTerm -> PTerm
handleErr (Either Err PTerm -> PTerm) -> Either Err PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ Name
-> Bool
-> Bool
-> Bool
-> Bool
-> [Name]
-> IState
-> FC
-> Name
-> FC
-> [[Text]]
-> [PArg]
-> Either Err PTerm
aiFn Name
topname Bool
allowcap Bool
inpat Bool
inpat Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
fc [[Text]]
ds []
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PHidden (PRef fc :: FC
fc hl :: [FC]
hl f :: Name
f))
        | Bool -> Bool
not (Name
f Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Name, Maybe PTerm) -> Name) -> [(Name, Maybe PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Maybe PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, Maybe PTerm)]
env) = PTerm -> PTerm
PHidden (Either Err PTerm -> PTerm
handleErr (Either Err PTerm -> PTerm) -> Either Err PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ Name
-> Bool
-> Bool
-> Bool
-> Bool
-> [Name]
-> IState
-> FC
-> Name
-> FC
-> [[Text]]
-> [PArg]
-> Either Err PTerm
aiFn Name
topname Bool
allowcap Bool
inpat Bool
False Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
fc [[Text]]
ds [])
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PRewrite fc :: FC
fc by :: Maybe Name
by l :: PTerm
l r :: PTerm
r g :: Maybe PTerm
g)
       = let l' :: PTerm
l' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
l
             r' :: PTerm
r' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
r
             g' :: Maybe PTerm
g' = (PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall (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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PTyped l :: PTerm
l r :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PPair fc :: FC
fc hls :: [FC]
hls p :: PunInfo
p l :: PTerm
l r :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PDPair fc :: FC
fc hls :: [FC]
hls p :: PunInfo
p l :: PTerm
l t :: PTerm
t r :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PAlternative ms :: [(Name, Name)]
ms a :: PAltType
a as :: [PTerm]
as)
           = let as' :: [PTerm]
as' = (PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds) [PTerm]
as in
                 [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ms PAltType
a [PTerm]
as'
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env _ (PDisamb ds' :: [[Text]]
ds' as :: PTerm
as) = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds' PTerm
as
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PApp fc :: FC
fc (PInferRef ffc :: FC
ffc hl :: [FC]
hl f :: Name
f) as :: [PArg]
as)
        = let as' :: [PArg]
as' = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PApp fc :: FC
fc ftm :: PTerm
ftm@(PRef ffc :: FC
ffc hl :: [FC]
hl f :: Name
f) as :: [PArg]
as)
        | Name
f Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
infns = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PInferRef FC
ffc [FC]
hl Name
f) [PArg]
as)
        | Bool -> Bool
not (Name
f Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Name, Maybe PTerm) -> Name) -> [(Name, Maybe PTerm)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Maybe PTerm) -> Name
forall a b. (a, b) -> a
fst [(Name, Maybe PTerm)]
env)
              = let as' :: [PArg]
as' = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds)) [PArg]
as in
                    Either Err PTerm -> PTerm
handleErr (Either Err PTerm -> PTerm) -> Either Err PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ Name
-> Bool
-> Bool
-> Bool
-> Bool
-> [Name]
-> IState
-> FC
-> Name
-> FC
-> [[Text]]
-> [PArg]
-> Either Err PTerm
aiFn Name
topname Bool
allowcap Bool
inpat Bool
False Bool
qq [Name]
imp_meths IState
ist FC
fc Name
f FC
ffc [[Text]]
ds [PArg]
as'
        | Just (Just ty :: PTerm
ty) <- Name -> [(Name, Maybe PTerm)] -> Maybe (Maybe PTerm)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
f [(Name, Maybe PTerm)]
env =
             let as' :: [PArg]
as' = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PApp fc :: FC
fc f :: PTerm
f as :: [PArg]
as)
      = let f' :: PTerm
f' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
f
            as' :: [PArg]
as' = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (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 1 PTerm
f' [PArg]
as'
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PWithApp fc :: FC
fc f :: PTerm
f a :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PCase fc :: FC
fc c :: PTerm
c os :: [(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' (((PTerm, PTerm) -> (PTerm, PTerm))
-> [(PTerm, PTerm)] -> [(PTerm, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (PTerm, PTerm) -> (PTerm, PTerm)
aiCase [(PTerm, PTerm)]
os)
     where
       aiCase :: (PTerm, PTerm) -> (PTerm, PTerm)
aiCase (lhs :: PTerm
lhs, rhs :: PTerm
rhs)
            = (PTerm
lhs, Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq ([(Name, Maybe PTerm)]
env [(Name, Maybe PTerm)]
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. [a] -> [a] -> [a]
++ PTerm -> [(Name, Maybe PTerm)]
forall a. PTerm -> [(Name, Maybe a)]
patnames PTerm
lhs) [[Text]]
ds PTerm
rhs)

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


    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PIfThenElse fc :: FC
fc c :: PTerm
c t :: PTerm
t f :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PLam fc :: FC
fc n :: Name
n nfc :: FC
nfc ty :: PTerm
ty sc :: 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 -> String -> Name
sMN 0 "lamp") FC
NoFC PTerm
ty
                                     (FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
fc [] (Int -> String -> Name
sMN 0 "lamp") )
                                        [(FC -> [FC] -> Name -> PTerm
PRef FC
fc [] Name
n, PTerm
sc)]))
             else let ty' :: PTerm
ty' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
ty
                      sc' :: PTerm
sc' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq ((Name
n, PTerm -> Maybe PTerm
forall a. a -> Maybe a
Just PTerm
ty)(Name, Maybe PTerm)
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. a -> [a] -> [a]
:[(Name, Maybe PTerm)]
env) [[Text]]
ds PTerm
sc in
                      FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
n FC
nfc PTerm
ty' PTerm
sc'
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PLet fc :: FC
fc rc :: RigCount
rc n :: Name
n nfc :: FC
nfc ty :: PTerm
ty val :: PTerm
val sc :: PTerm
sc)
      = if Name -> Context -> Bool
canBeDConName Name
n (IState -> Context
tt_ctxt IState
ist)
           then Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds (FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc PTerm
val [(FC -> [FC] -> Name -> PTerm
PRef FC
fc [] Name
n, PTerm
sc)])
           else let ty' :: PTerm
ty' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
ty
                    val' :: PTerm
val' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
val
                    sc' :: PTerm
sc' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq ((Name
n, PTerm -> Maybe PTerm
forall a. a -> Maybe a
Just PTerm
ty)(Name, Maybe PTerm)
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. a -> [a] -> [a]
:[(Name, Maybe PTerm)]
env) [[Text]]
ds PTerm
sc in
                    FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
n FC
nfc PTerm
ty' PTerm
val' PTerm
sc'
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PPi p :: Plicity
p n :: Name
n nfc :: FC
nfc ty :: PTerm
ty sc :: PTerm
sc)
      = let ty' :: PTerm
ty' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
ty
            env' :: [(Name, Maybe PTerm)]
env' = if Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
imp_meths then [(Name, Maybe PTerm)]
env
                      else
                      ((Name
n, PTerm -> Maybe PTerm
forall a. a -> Maybe a
Just PTerm
ty) (Name, Maybe PTerm)
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. a -> [a] -> [a]
: [(Name, Maybe PTerm)]
env)
            sc' :: PTerm
sc' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env' [[Text]]
ds PTerm
sc in
            Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
n FC
nfc PTerm
ty' PTerm
sc'
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PGoal fc :: FC
fc r :: PTerm
r n :: Name
n sc :: PTerm
sc)
      = let r' :: PTerm
r' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
r
            sc' :: PTerm
sc' = Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
qq ((Name
n, Maybe PTerm
forall a. Maybe a
Nothing)(Name, Maybe PTerm)
-> [(Name, Maybe PTerm)] -> [(Name, Maybe PTerm)]
forall a. a -> [a] -> [a]
:[(Name, Maybe PTerm)]
env) [[Text]]
ds PTerm
sc in
            FC -> PTerm -> Name -> PTerm -> PTerm
PGoal FC
fc PTerm
r' Name
n PTerm
sc'
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PHidden tm :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PUnifyLog tm :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PNoImplicits tm :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PQuasiquote tm :: PTerm
tm g :: Maybe PTerm
g) = PTerm -> Maybe PTerm -> PTerm
PQuasiquote (Bool -> Bool -> [(Name, Maybe PTerm)] -> [[Text]] -> PTerm -> PTerm
ai Bool
inpat Bool
True [(Name, Maybe PTerm)]
env [[Text]]
ds PTerm
tm)
                                                  ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall (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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PUnquote tm :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PRunElab fc :: FC
fc tm :: PTerm
tm ns :: [String]
ns) = FC -> PTerm -> [String] -> 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) [String]
ns
    ai inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds (PConstSugar fc :: FC
fc tm :: 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 inpat :: Bool
inpat qq :: Bool
qq env :: [(Name, Maybe PTerm)]
env ds :: [[Text]]
ds tm :: PTerm
tm = PTerm
tm

    handleErr :: Either Err PTerm -> PTerm
handleErr (Left err :: Err
err) = Err -> PTerm
PElabError Err
err
    handleErr (Right x :: 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 topname :: Name
topname allowcap :: Bool
allowcap inpat :: Bool
inpat True qq :: Bool
qq imp_meths :: [Name]
imp_meths ist :: IState
ist fc :: FC
fc f :: Name
f ffc :: FC
ffc ds :: [[Text]]
ds []
  | Bool
inpat Bool -> Bool -> Bool
&& Name -> Bool
implicitable Name
f Bool -> Bool -> Bool
&& Name -> Bool
unqualified Name
f = PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
  | Bool
otherwise
     = case Name -> Context -> [Def]
lookupDef Name
f (IState -> Context
tt_ctxt IState
ist) of
        [] -> if Bool
allowcap
                then PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
                else case Name
f of
                       MN _ _ -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
                       UN xs :: Text
xs | Char -> Bool
isDigit (Text -> Char
T.head Text
xs) -- for partial evaluation vars
                                 -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
                       _ -> Err -> Either Err PTerm
forall a b. a -> Either a b
Left (Err -> Either Err PTerm) -> Err -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ String -> Err
forall t. String -> Err' t
Msg (String -> Err) -> String -> Err
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show Name
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is not a valid name for a pattern variable"
        alts :: [Def]
alts -> let ialts :: [(Name, [PArg])]
ialts = Name -> Ctxt [PArg] -> [(Name, [PArg])]
forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
f (IState -> Ctxt [PArg]
idris_implicits IState
ist) in
                    -- 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
|| ((Name, [PArg]) -> Bool) -> [(Name, [PArg])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Context -> (Name, [PArg]) -> Bool
forall (t :: * -> *) t.
Foldable t =>
Context -> (Name, t (PArg' t)) -> Bool
conCaf (IState -> Context
tt_ctxt IState
ist)) [(Name, [PArg])]
ialts)
--                            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 PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
ffc Name
f
    where imp :: PArg' t -> Bool
imp (PExp _ _ _ _) = Bool
False
          imp _ = Bool
True
--           allImp [] = False
          allImp :: t (PArg' t) -> Bool
allImp xs :: t (PArg' t)
xs = (PArg' t -> Bool) -> t (PArg' t) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PArg' t -> Bool
forall t. PArg' t -> Bool
imp t (PArg' t)
xs

          unqualified :: Name -> Bool
unqualified (NS _ _) = Bool
False
          unqualified _ = Bool
True

          conCaf :: Context -> (Name, t (PArg' t)) -> Bool
conCaf ctxt :: Context
ctxt (n :: Name
n, cia :: t (PArg' t)
cia) = (Name -> Context -> Bool
isDConName Name
n Context
ctxt Bool -> Bool -> Bool
|| (Bool
qq Bool -> Bool -> Bool
&& Name -> Context -> Bool
isTConName Name
n Context
ctxt)) Bool -> Bool -> Bool
&& t (PArg' t) -> Bool
forall (t :: * -> *) t. Foldable t => t (PArg' t) -> Bool
allImp t (PArg' t)
cia

          vname :: Name -> Bool
vname (UN n :: Text
n) = Bool
True -- non qualified
          vname _ = Bool
False

aiFn topname :: Name
topname allowcap :: Bool
allowcap inpat :: Bool
inpat expat :: Bool
expat qq :: Bool
qq imp_meths :: [Name]
imp_meths ist :: IState
ist fc :: FC
fc f :: Name
f ffc :: FC
ffc ds :: [[Text]]
ds as :: [PArg]
as
    | Name
f Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
primNames = PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] Name
f) [PArg]
as
aiFn topname :: Name
topname allowcap :: Bool
allowcap inpat :: Bool
inpat expat :: Bool
expat qq :: Bool
qq imp_meths :: [Name]
imp_meths ist :: IState
ist fc :: FC
fc f :: Name
f ffc :: FC
ffc ds :: [[Text]]
ds as :: [PArg]
as
          -- This is where namespaces get resolved by adding PAlternative
     = do let ns :: [(Name, [PArg])]
ns = Name -> Ctxt [PArg] -> [(Name, [PArg])]
forall a. Name -> Ctxt a -> [(Name, a)]
lookupCtxtName Name
f (IState -> Ctxt [PArg]
idris_implicits IState
ist)
          let nh :: [(Name, [PArg])]
nh = ((Name, [PArg]) -> Bool) -> [(Name, [PArg])] -> [(Name, [PArg])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(n :: Name
n, _) -> Name -> Bool
notHidden Name
n) [(Name, [PArg])]
ns
          let ns' :: [(Name, [PArg])]
ns' = case [[Text]] -> [(Name, [PArg])] -> [(Name, [PArg])]
forall b. [[Text]] -> [(Name, b)] -> [(Name, b)]
trimAlts [[Text]]
ds [(Name, [PArg])]
nh of
                         [] -> [(Name, [PArg])]
nh
                         x :: [(Name, [PArg])]
x -> [(Name, [PArg])]
x
          case [(Name, [PArg])]
ns' of
            [(f' :: Name
f',ns :: [PArg]
ns)] -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc ([PArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
ns) (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] (Name -> Name -> Name
isImpName Name
f Name
f'))
                                     ([PArg] -> [PArg] -> [PArg]
insertImpl [PArg]
ns [PArg]
as)
            [] -> case Name -> [Name] -> Maybe Name
metaVar Name
f (((Name, (Maybe Name, Int, [Name], Bool, Bool)) -> Name)
-> [(Name, (Maybe Name, Int, [Name], Bool, Bool))] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, (Maybe Name, Int, [Name], Bool, Bool)) -> Name
forall a b. (a, b) -> a
fst (IState -> [(Name, (Maybe Name, Int, [Name], Bool, Bool))]
idris_metavars IState
ist)) of
                    Just f' :: Name
f' -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] Name
f') [PArg]
as
                    Nothing -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc ([PArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
as) (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] Name
f) [PArg]
as
            alts :: [(Name, [PArg])]
alts -> PTerm -> Either Err PTerm
forall a b. b -> Either a b
Right (PTerm -> Either Err PTerm) -> PTerm -> Either Err PTerm
forall a b. (a -> b) -> a -> b
$
                         [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [] (Bool -> PAltType
ExactlyOne Bool
True) ([PTerm] -> PTerm) -> [PTerm] -> PTerm
forall a b. (a -> b) -> a -> b
$
                           ((Name, [PArg]) -> PTerm) -> [(Name, [PArg])] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (\(f' :: Name
f', ns :: [PArg]
ns) -> FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp FC
fc ([PArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
ns) (FC -> [FC] -> Name -> PTerm
PRef FC
ffc [FC
ffc] (Name -> Name -> Name
isImpName Name
f Name
f'))
                                                  ([PArg] -> [PArg] -> [PArg]
insertImpl [PArg]
ns [PArg]
as)) [(Name, [PArg])]
alts
  where
    -- 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 f :: Name
f f' :: Name
f' | Name
f Name -> [Name] -> Bool
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 f :: Name
f (mvn :: Name
mvn : ns :: [Name]
ns) | Name
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Name
nsroot Name
mvn = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
mvn
    metaVar f :: Name
f (_ : ns :: [Name]
ns) = Name -> [Name] -> Maybe Name
metaVar Name
f [Name]
ns
    metaVar f :: Name
f [] = Maybe Name
forall a. Maybe a
Nothing

    trimAlts :: [[Text]] -> [(Name, b)] -> [(Name, b)]
trimAlts [] alts :: [(Name, b)]
alts = [(Name, b)]
alts
    trimAlts ns :: [[Text]]
ns alts :: [(Name, b)]
alts
        = ((Name, b) -> Bool) -> [(Name, b)] -> [(Name, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(x :: Name
x, _) -> ([Text] -> Bool) -> [[Text]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\d :: [Text]
d -> [Text]
d [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name -> [Text]
nspace Name
x) [[Text]]
ns) [(Name, b)]
alts

    nspace :: Name -> [Text]
nspace (NS _ s :: [Text]
s) = [Text]
s
    nspace _ = []

    notHidden :: Name -> Bool
notHidden n :: Name
n = case Name -> Accessibility
getAccessibility Name
n of
                        Hidden -> Bool
False
                        Private -> Bool
False
                        _ -> Bool
True

    getAccessibility :: Name -> Accessibility
getAccessibility n :: Name
n
             = case Name -> Bool -> Context -> Maybe (Def, Accessibility)
lookupDefAccExact Name
n Bool
False (IState -> Context
tt_ctxt IState
ist) of
                    Just (n :: Def
n,t :: Accessibility
t) -> Accessibility
t
                    _ -> Accessibility
Public

    insertImpl :: [PArg] -- ^ expected argument types (from idris_implicits)
               -> [PArg] -- ^ given arguments
               -> [PArg]
    insertImpl :: [PArg] -> [PArg] -> [PArg]
insertImpl ps :: [PArg]
ps as :: [PArg]
as
        = let (as' :: [PArg]
as', badimpls :: [PArg]
badimpls) = (PArg -> Bool) -> [PArg] -> ([PArg], [PArg])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([PArg] -> PArg -> Bool
impIn [PArg]
ps) [PArg]
as in
              (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map PArg -> PArg
forall t. PArg' t -> PArg' t
addUnknownImp [PArg]
badimpls [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++
              Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc Map Name PTerm
forall k a. Map k a
M.empty [PArg]
ps ((PArg -> Bool) -> [PArg] -> [PArg]
forall a. (a -> Bool) -> [a] -> [a]
filter PArg -> Bool
forall t. PArg' t -> Bool
expArg [PArg]
as') ((PArg -> Bool) -> [PArg] -> [PArg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (PArg -> Bool) -> PArg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PArg -> Bool
forall t. PArg' t -> Bool
expArg) [PArg]
as')

    insImpAcc :: M.Map Name PTerm -- accumulated param names & arg terms
              -> [PArg]           -- parameters
              -> [PArg]           -- explicit arguments
              -> [PArg]           -- implicits given
              -> [PArg]
    insImpAcc :: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc pnas :: Map Name PTerm
pnas (PExp p :: Int
p l :: [ArgOpt]
l n :: Name
n ty :: PTerm
ty : ps :: [PArg]
ps) (PExp _ _ _ tm :: PTerm
tm : given :: [PArg]
given) imps :: [PArg]
imps =
      Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp Int
p [ArgOpt]
l Name
n PTerm
tm PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
tm Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
    insImpAcc pnas :: Map Name PTerm
pnas (PConstraint p :: Int
p l :: [ArgOpt]
l n :: Name
n ty :: PTerm
ty : ps :: [PArg]
ps) (PConstraint _ _ _ tm :: PTerm
tm : given :: [PArg]
given) imps :: [PArg]
imps =
      Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
p [ArgOpt]
l Name
n PTerm
tm PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
tm Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
    insImpAcc pnas :: Map Name PTerm
pnas (PConstraint p :: Int
p l :: [ArgOpt]
l n :: Name
n ty :: PTerm
ty : ps :: [PArg]
ps) given :: [PArg]
given imps :: [PArg]
imps =
      let rtc :: PTerm
rtc = FC -> PTerm
PResolveTC FC
fc in
        Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
p [ArgOpt]
l Name
n PTerm
rtc PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
rtc Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
    insImpAcc pnas :: Map Name PTerm
pnas (PImp p :: Int
p _ l :: [ArgOpt]
l n :: Name
n ty :: PTerm
ty : ps :: [PArg]
ps) given :: [PArg]
given imps :: [PArg]
imps =
        case Name -> [PArg] -> [PArg] -> Maybe (PTerm, [PArg])
forall a. Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n [PArg]
imps [] of
            Just (tm :: PTerm
tm, imps' :: [PArg]
imps') ->
              Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
p Bool
False [ArgOpt]
l Name
n PTerm
tm PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
: Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
tm Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps'
            Nothing ->
              Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
p Bool
True [ArgOpt]
l Name
n PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
:
                Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
Placeholder Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
    insImpAcc pnas :: Map Name PTerm
pnas (PTacImplicit p :: Int
p l :: [ArgOpt]
l n :: Name
n sc' :: PTerm
sc' ty :: PTerm
ty : ps :: [PArg]
ps) given :: [PArg]
given imps :: [PArg]
imps =
      let sc :: PTerm
sc = [Name] -> IState -> PTerm -> PTerm
addImpl [Name]
imp_meths IState
ist ([(Name, PTerm)] -> PTerm -> PTerm
substMatches (Map Name PTerm -> [(Name, PTerm)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name PTerm
pnas) PTerm
sc') in
        case Name -> [PArg] -> [PArg] -> Maybe (PTerm, [PArg])
forall a. Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n [PArg]
imps [] of
            Just (tm :: PTerm
tm, imps' :: [PArg]
imps') ->
              Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
tm PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
:
                Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
tm Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps'
            Nothing ->
              if Bool
inpat
                then Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
Placeholder PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
:
                  Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
Placeholder Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
                else Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
sc PArg -> [PArg] -> [PArg]
forall a. a -> [a] -> [a]
:
                  Map Name PTerm -> [PArg] -> [PArg] -> [PArg] -> [PArg]
insImpAcc (Name -> PTerm -> Map Name PTerm -> Map Name PTerm
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n PTerm
sc Map Name PTerm
pnas) [PArg]
ps [PArg]
given [PArg]
imps
    insImpAcc _ expected :: [PArg]
expected [] imps :: [PArg]
imps = (PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map PArg -> PArg
forall t. PArg' t -> PArg' t
addUnknownImp [PArg]
imps -- so that unused implicits give error
    insImpAcc _ _        given :: [PArg]
given imps :: [PArg]
imps = [PArg]
given [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ [PArg]
imps

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

    find :: Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find n :: Name
n []               acc :: [PArg' a]
acc = Maybe (a, [PArg' a])
forall a. Maybe a
Nothing
    find n :: Name
n (PImp _ _ _ n' :: Name
n' t :: a
t : gs :: [PArg' a]
gs) acc :: [PArg' a]
acc
         | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = (a, [PArg' a]) -> Maybe (a, [PArg' a])
forall a. a -> Maybe a
Just (a
t, [PArg' a] -> [PArg' a]
forall a. [a] -> [a]
reverse [PArg' a]
acc [PArg' a] -> [PArg' a] -> [PArg' a]
forall a. [a] -> [a] -> [a]
++ [PArg' a]
gs)
    find n :: Name
n (PTacImplicit _ _ n' :: Name
n' _ t :: a
t : gs :: [PArg' a]
gs) acc :: [PArg' a]
acc
         | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = (a, [PArg' a]) -> Maybe (a, [PArg' a])
forall a. a -> Maybe a
Just (a
t, [PArg' a] -> [PArg' a]
forall a. [a] -> [a]
reverse [PArg' a]
acc [PArg' a] -> [PArg' a] -> [PArg' a]
forall a. [a] -> [a] -> [a]
++ [PArg' a]
gs)
    find n :: Name
n (g :: PArg' a
g : gs :: [PArg' a]
gs) acc :: [PArg' a]
acc = Name -> [PArg' a] -> [PArg' a] -> Maybe (a, [PArg' a])
find Name
n [PArg' a]
gs (PArg' a
g PArg' a -> [PArg' a] -> [PArg' a]
forall a. a -> [a] -> [a]
: [PArg' a]
acc)

-- | 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 ps :: [PArg]
ps (PExp _ _ _ _) = Bool
True
impIn ps :: [PArg]
ps (PConstraint  _ _ _ _) = Bool
True
impIn ps :: [PArg]
ps arg :: PArg
arg = (PArg -> Bool) -> [PArg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\p :: PArg
p -> Bool -> Bool
not (PArg -> Bool
forall t. PArg' t -> Bool
expArg PArg
arg) Bool -> Bool -> Bool
&& PArg -> Name
forall t. PArg' t -> Name
pname PArg
arg Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== PArg -> Name
forall t. PArg' t -> Name
pname PArg
p) [PArg]
ps

expArg :: PArg' t -> Bool
expArg (PExp _ _ _ _) = Bool
True
expArg (PConstraint _ _ _ _) = Bool
True
expArg _ = Bool
False

-- replace non-linear occurrences with _

stripLinear :: IState -> PTerm -> PTerm
stripLinear :: IState -> PTerm -> PTerm
stripLinear i :: IState
i tm :: PTerm
tm = State [Name] PTerm -> [Name] -> PTerm
forall s a. State s a -> s -> a
evalState (PTerm -> State [Name] PTerm
sl PTerm
tm) [] where
    sl :: PTerm -> State [Name] PTerm
    sl :: PTerm -> State [Name] PTerm
sl (PRef fc :: FC
fc hl :: [FC]
hl f :: Name
f)
         | (_:_) <- Name -> Context -> [Term]
lookupTy Name
f (IState -> Context
tt_ctxt IState
i)
              = PTerm -> State [Name] PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State [Name] PTerm) -> PTerm -> State [Name] PTerm
forall a b. (a -> b) -> a -> b
$ FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
f
         | Bool
otherwise = do [Name]
ns <- StateT [Name] Identity [Name]
forall s (m :: * -> *). MonadState s m => m s
get
                          if (Name
f Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns)
                             then PTerm -> State [Name] PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State [Name] PTerm) -> PTerm -> State [Name] PTerm
forall a b. (a -> b) -> a -> b
$ PTerm -> PTerm
PHidden (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
f) -- Placeholder
                             else do [Name] -> StateT [Name] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name
f Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
ns)
                                     PTerm -> State [Name] PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
f)
    sl (PPatvar fc :: FC
fc f :: Name
f)
                     = do [Name]
ns <- StateT [Name] Identity [Name]
forall s (m :: * -> *). MonadState s m => m s
get
                          if (Name
f Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
ns)
                             then PTerm -> State [Name] PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State [Name] PTerm) -> PTerm -> State [Name] PTerm
forall a b. (a -> b) -> a -> b
$ PTerm -> PTerm
PHidden (FC -> Name -> PTerm
PPatvar FC
fc Name
f) -- Placeholder
                             else do [Name] -> StateT [Name] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name
f Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
ns)
                                     PTerm -> State [Name] PTerm
forall (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 ms :: [(Name, Name)]
ms b :: PAltType
b as :: [PTerm]
as) = do [Name]
ns <- StateT [Name] Identity [Name]
forall s (m :: * -> *). MonadState s m => m s
get
                                     [PTerm]
as' <- [Name] -> [PTerm] -> StateT [Name] Identity [PTerm]
slAlts [Name]
ns [PTerm]
as
                                     PTerm -> State [Name] PTerm
forall (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 ns :: [Name]
ns (a :: PTerm
a : as :: [PTerm]
as) = do [Name] -> StateT [Name] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Name]
ns
                                     PTerm
a' <- PTerm -> State [Name] PTerm
sl PTerm
a
                                     [PTerm]
as' <- [Name] -> [PTerm] -> StateT [Name] Identity [PTerm]
slAlts [Name]
ns [PTerm]
as
                                     [PTerm] -> StateT [Name] Identity [PTerm]
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm
a' PTerm -> [PTerm] -> [PTerm]
forall a. a -> [a] -> [a]
: [PTerm]
as')
             slAlts ns :: [Name]
ns [] = [PTerm] -> StateT [Name] Identity [PTerm]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    sl (PPair fc :: FC
fc hls :: [FC]
hls p :: PunInfo
p l :: PTerm
l r :: PTerm
r) = do PTerm
l' <- PTerm -> State [Name] PTerm
sl PTerm
l; PTerm
r' <- PTerm -> State [Name] PTerm
sl PTerm
r; PTerm -> State [Name] PTerm
forall (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 :: [FC]
hls p :: PunInfo
p l :: PTerm
l t :: PTerm
t r :: PTerm
r) = do PTerm
l' <- PTerm -> State [Name] PTerm
sl PTerm
l
                                    PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
                                    PTerm
r' <- PTerm -> State [Name] PTerm
sl PTerm
r
                                    PTerm -> State [Name] PTerm
forall (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
fc fn :: PTerm
fn args :: [PArg]
args) = do PTerm
fn' <- case PTerm
fn of
                                     -- Just the args, fn isn't matchable as a var
                                          PRef _ _ _ -> PTerm -> State [Name] PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
fn
                                          t :: PTerm
t -> PTerm -> State [Name] PTerm
sl PTerm
t
                              [PArg]
args' <- (PArg -> StateT [Name] Identity PArg)
-> [PArg] -> StateT [Name] Identity [PArg]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PArg -> StateT [Name] Identity PArg
slA [PArg]
args
                              PTerm -> State [Name] PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State [Name] PTerm) -> PTerm -> State [Name] PTerm
forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
fn' [PArg]
args'
       where slA :: PArg -> StateT [Name] Identity PArg
slA (PImp p :: Int
p m :: Bool
m l :: [ArgOpt]
l n :: Name
n t :: PTerm
t) = do PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
                                       PArg -> StateT [Name] Identity PArg
forall (m :: * -> *) a. Monad m => a -> m a
return (PArg -> StateT [Name] Identity PArg)
-> PArg -> StateT [Name] Identity PArg
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> Bool -> [ArgOpt] -> Name -> t -> PArg' t
PImp Int
p Bool
m [ArgOpt]
l Name
n PTerm
t'
             slA (PExp p :: Int
p l :: [ArgOpt]
l n :: Name
n t :: PTerm
t) = do  PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
                                      PArg -> StateT [Name] Identity PArg
forall (m :: * -> *) a. Monad m => a -> m a
return (PArg -> StateT [Name] Identity PArg)
-> PArg -> StateT [Name] Identity PArg
forall a b. (a -> b) -> a -> b
$ Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PExp Int
p [ArgOpt]
l Name
n PTerm
t'
             slA (PConstraint p :: Int
p l :: [ArgOpt]
l n :: Name
n t :: PTerm
t)
                                = do PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
                                     PArg -> StateT [Name] Identity PArg
forall (m :: * -> *) a. Monad m => a -> m a
return (PArg -> StateT [Name] Identity PArg)
-> PArg -> StateT [Name] Identity PArg
forall a b. (a -> b) -> a -> b
$ Int -> [ArgOpt] -> Name -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> PArg' t
PConstraint Int
p [ArgOpt]
l Name
n PTerm
t'
             slA (PTacImplicit p :: Int
p l :: [ArgOpt]
l n :: Name
n sc :: PTerm
sc t :: PTerm
t)
                                = do PTerm
t' <- PTerm -> State [Name] PTerm
sl PTerm
t
                                     PArg -> StateT [Name] Identity PArg
forall (m :: * -> *) a. Monad m => a -> m a
return (PArg -> StateT [Name] Identity PArg)
-> PArg -> StateT [Name] Identity PArg
forall a b. (a -> b) -> a -> b
$ Int -> [ArgOpt] -> Name -> PTerm -> PTerm -> PArg
forall t. Int -> [ArgOpt] -> Name -> t -> t -> PArg' t
PTacImplicit Int
p [ArgOpt]
l Name
n PTerm
sc PTerm
t'
    sl x :: PTerm
x = PTerm -> State [Name] PTerm
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 i :: IState
i (PApp fc :: FC
fc fn :: PTerm
fn args :: [PArg]
args) = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
fn ((PArg -> PArg) -> [PArg] -> [PArg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PTerm -> PTerm) -> PArg -> PArg
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 :: [FC]
hl f :: Name
f)
       | (Bind n :: Name
n (Pi _ _ t :: Term
t _) sc :: Term
sc :_) <- Name -> Context -> [Term]
lookupTy Name
f (IState -> Context
tt_ctxt IState
i)
          = PTerm
Placeholder
       | (TType _ : _) <- 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 _ : _) <- 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
fc f :: PTerm
f@(PRef _ _ fn :: Name
fn) args :: [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 ((PArg -> PArg) -> [PArg] -> [PArg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PTerm -> PTerm
su) [PArg]
args)
    su (PApp fc :: FC
fc f :: PTerm
f args :: [PArg]
args)
          = PTerm -> PTerm
PHidden (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f [PArg]
args)
    su (PAlternative ms :: [(Name, Name)]
ms b :: PAltType
b alts :: [PTerm]
alts)
       = let alts' :: [PTerm]
alts' = (PTerm -> Bool) -> [PTerm] -> [PTerm]
forall a. (a -> Bool) -> [a] -> [a]
filter (PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/= PTerm
Placeholder) ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map PTerm -> PTerm
su [PTerm]
alts) in
             if [PTerm] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PTerm]
alts' then PTerm
Placeholder
                           else PTerm -> PTerm
liftHidden (PTerm -> PTerm) -> PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ms PAltType
b [PTerm]
alts'
    su (PPair fc :: FC
fc hls :: [FC]
hls p :: PunInfo
p l :: PTerm
l r :: 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 :: [FC]
hls p :: PunInfo
p l :: PTerm
l t :: PTerm
t r :: 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
fc _ _ _ _) = PTerm -> PTerm
PHidden PTerm
t
    su t :: PTerm
t@(PPi _ _ _ _ _) = PTerm -> PTerm
PHidden PTerm
t
    su t :: PTerm
t@(PConstant _ c :: Const
c) | Const -> Bool
isTypeConst Const
c = PTerm -> PTerm
PHidden PTerm
t
    su t :: 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 ms :: [(Name, Name)]
ms b :: PAltType
b as :: [PTerm]
as)
        | [PTerm] -> Bool
allHidden [PTerm]
as = PTerm -> PTerm
PHidden ([(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ms PAltType
b ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map PTerm -> PTerm
unHide [PTerm]
as))
        | Bool
otherwise = PTerm
tm

    allHidden :: [PTerm] -> Bool
allHidden [] = Bool
True
    allHidden (PHidden _ : xs :: [PTerm]
xs) = [PTerm] -> Bool
allHidden [PTerm]
xs
    allHidden (x :: PTerm
x : xs :: [PTerm]
xs) = Bool
False

    unHide :: PTerm -> PTerm
unHide (PHidden t :: PTerm
t) = PTerm
t
    unHide t :: PTerm
t = PTerm
t

stripUnmatchable i :: IState
i tm :: PTerm
tm = PTerm
tm

mkPApp :: FC -> Int -> PTerm -> [PArg] -> PTerm
mkPApp fc :: FC
fc a :: Int
a f :: PTerm
f [] = PTerm
f
mkPApp fc :: FC
fc a :: Int
a f :: PTerm
f as :: [PArg]
as = let rest :: [PArg]
rest = Int -> [PArg] -> [PArg]
forall a. Int -> [a] -> [a]
drop Int
a [PArg]
as in
                       if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then FC -> PTerm -> [PArg] -> PTerm
appRest FC
fc PTerm
f [PArg]
rest
                          else FC -> PTerm -> [PArg] -> PTerm
appRest FC
fc (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f (Int -> [PArg] -> [PArg]
forall a. Int -> [a] -> [a]
take Int
a [PArg]
as)) [PArg]
rest
  where
    appRest :: FC -> PTerm -> [PArg] -> PTerm
appRest fc :: FC
fc f :: PTerm
f [] = PTerm
f
    appRest fc :: FC
fc f :: PTerm
f (a :: PArg
a : as :: [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 ist :: IState
ist tm :: PTerm
tm = let (ns :: [[Name]]
ns, ss :: [Name]
ss) = PTerm -> ([[Name]], [Name])
fs PTerm
tm
                     in State [Bool] PTerm -> [Bool] -> (PTerm, [Bool])
forall s a. State s a -> s -> (a, s)
runState ([[Name]] -> [Name] -> PTerm -> State [Bool] PTerm
forall (t :: * -> *) (m :: * -> *) t.
(Foldable t, MonadState [Bool] m) =>
t -> t Name -> PTerm -> m PTerm
pos [[Name]]
ns [Name]
ss PTerm
tm) []
  where fs :: PTerm -> ([[Name]], [Name])
fs (PPi p :: Plicity
p n :: Name
n fc :: FC
fc t :: PTerm
t sc :: PTerm
sc)
            | Static
Static <- Plicity -> Static
pstatic Plicity
p
                        = let (ns :: [[Name]]
ns, ss :: [Name]
ss) = PTerm -> ([[Name]], [Name])
fs PTerm
sc in
                              ([(Name, PTerm)] -> IState -> PTerm -> [Name]
namesIn [] IState
ist PTerm
t [Name] -> [[Name]] -> [[Name]]
forall a. a -> [a] -> [a]
: [[Name]]
ns, Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
ss)
            | Bool
otherwise = let (ns :: [[Name]]
ns, ss :: [Name]
ss) = PTerm -> ([[Name]], [Name])
fs PTerm
sc in
                              ([[Name]]
ns, [Name]
ss)
        fs _ = ([], [])

        pos :: t -> t Name -> PTerm -> m PTerm
pos ns :: t
ns ss :: t Name
ss (PPi p :: Plicity
p n :: Name
n fc :: FC
fc t :: PTerm
t sc :: PTerm
sc)
            | Name -> t Name -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Name
n t Name
ss = do PTerm
sc' <- t -> t Name -> PTerm -> m PTerm
pos t
ns t Name
ss PTerm
sc
                             [Bool]
spos <- m [Bool]
forall s (m :: * -> *). MonadState s m => m s
get
                             [Bool] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
spos)
                             PTerm -> m PTerm
forall (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 <- m [Bool]
forall s (m :: * -> *). MonadState s m => m s
get
                             [Bool] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
spos)
                             PTerm -> m PTerm
forall (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 ns :: t
ns ss :: t Name
ss t :: PTerm
t = PTerm -> m PTerm
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 ( a -> EitherErr a b -> EitherErr a a
(a -> b) -> EitherErr a a -> EitherErr a b
(forall a b. (a -> b) -> EitherErr a a -> EitherErr a b)
-> (forall a b. a -> EitherErr a b -> EitherErr a a)
-> Functor (EitherErr a)
forall a b. a -> EitherErr a b -> EitherErr a a
forall a b. (a -> b) -> EitherErr a a -> EitherErr a b
forall a a b. a -> EitherErr a b -> EitherErr a a
forall a a b. (a -> b) -> EitherErr a a -> EitherErr a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EitherErr a b -> EitherErr a a
$c<$ :: forall a a b. a -> EitherErr a b -> EitherErr a a
fmap :: (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 :: a -> EitherErr a a
pure  = a -> EitherErr a a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: EitherErr a (a -> b) -> EitherErr a a -> EitherErr a b
(<*>) = EitherErr a (a -> b) -> EitherErr a a -> EitherErr a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (EitherErr a) where
    return :: a -> EitherErr a a
return = a -> EitherErr a a
forall a a. a -> EitherErr a a
RightOK

    (LeftErr e :: a
e) >>= :: 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 v :: a
v   >>= k :: a -> EitherErr a b
k = a -> EitherErr a b
k a
v

toEither :: EitherErr a b -> Either a b
toEither :: EitherErr a b -> Either a b
toEither (LeftErr e :: a
e)  = a -> Either a b
forall a b. a -> Either a b
Left a
e
toEither (RightOK ho :: b
ho) = b -> Either a b
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' names :: Bool
names i :: IState
i x :: PTerm
x y :: PTerm
y = EitherErr (PTerm, PTerm) [(Name, PTerm)]
-> Either (PTerm, PTerm) [(Name, PTerm)]
forall a.
Eq a =>
EitherErr (PTerm, PTerm) [(a, PTerm)]
-> Either (PTerm, PTerm) [(a, PTerm)]
checkRpts (EitherErr (PTerm, PTerm) [(Name, PTerm)]
 -> Either (PTerm, PTerm) [(Name, PTerm)])
-> EitherErr (PTerm, PTerm) [(Name, PTerm)]
-> Either (PTerm, PTerm) [(Name, PTerm)]
forall a b. (a -> b) -> a -> b
$ PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PTerm -> PTerm
fullApp PTerm
x) (PTerm -> PTerm
fullApp PTerm
y) where
    matchArg :: PArg -> PArg -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
matchArg x :: PArg
x y :: PArg
y = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PTerm -> PTerm
fullApp (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x)) (PTerm -> PTerm
fullApp (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
y))

    fullApp :: PTerm -> PTerm
fullApp (PApp _ (PApp fc :: FC
fc f :: PTerm
f args :: [PArg]
args) xs :: [PArg]
xs) = PTerm -> PTerm
fullApp (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f ([PArg]
args [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ [PArg]
xs))
    fullApp x :: PTerm
x = PTerm
x

    match' :: PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' x :: PTerm
x y :: 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 _ (PRef _ _ (NS (UN fi :: Text
fi) [b :: Text
b])) [_,_,x :: PArg
x]) x' :: PTerm
x'
        | Text
fi Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
txt "fromInteger" Bool -> Bool -> Bool
&& Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
txt "builtins",
          PConstant _ (I _) <- PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x) PTerm
x'
    match x' :: PTerm
x' (PApp _ (PRef _ _ (NS (UN fi :: Text
fi) [b :: Text
b])) [_,_,x :: PArg
x])
        | Text
fi Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
txt "fromInteger" Bool -> Bool -> Bool
&& Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
txt "builtins",
          PConstant _ (I _) <- PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x) PTerm
x'
    match (PApp _ (PRef _ _ (UN l :: Text
l)) [_,x :: PArg
x]) x' :: PTerm
x' | Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
txt "lazy" = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x) PTerm
x'
    match x :: PTerm
x (PApp _ (PRef _ _ (UN l :: Text
l)) [_,x' :: PArg
x']) | Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
txt "lazy" = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
x')
    match (PApp _ f :: PTerm
f args :: [PArg]
args) (PApp _ f' :: PTerm
f' args' :: [PArg]
args')
        | [PArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [PArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PArg]
args'
            = do [(Name, PTerm)]
mf <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
f PTerm
f'
                 [[(Name, PTerm)]]
ms <- (PArg -> PArg -> EitherErr (PTerm, PTerm) [(Name, PTerm)])
-> [PArg] -> [PArg] -> EitherErr (PTerm, PTerm) [[(Name, PTerm)]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PArg -> PArg -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
matchArg [PArg]
args [PArg]
args'
                 [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mf [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [[(Name, PTerm)]] -> [(Name, PTerm)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, PTerm)]]
ms)
    match (PRef f :: FC
f hl :: [FC]
hl n :: Name
n) (PApp _ x :: 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 f :: FC
f n :: Name
n) xr :: PTerm
xr = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match (FC -> [FC] -> Name -> PTerm
PRef FC
f [FC
f] Name
n) PTerm
xr
    match xr :: PTerm
xr (PPatvar f :: FC
f n :: 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 _ x :: PTerm
x []) (PRef f :: FC
f hl :: [FC]
hl n :: 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 _ _ n :: Name
n) tm :: PTerm
tm@(PRef _ _ n' :: Name
n')
        | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
names Bool -> Bool -> Bool
&&
          (Bool -> Bool
not (Name -> Context -> Bool
isConName Name
n (IState -> Context
tt_ctxt IState
i) Bool -> Bool -> Bool
|| Name -> Context -> Bool
isFnName Name
n (IState -> Context
tt_ctxt IState
i))
                Bool -> Bool -> Bool
|| PTerm
tm PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
== PTerm
Placeholder)
            = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name
n, PTerm
tm)]
        -- if one namespace is missing, drop the other
        | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' Bool -> Bool -> Bool
|| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Name
dropNS Name
n' Bool -> Bool -> Bool
|| Name -> Name
dropNS Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
       where dropNS :: Name -> Name
dropNS (NS n :: Name
n _) = Name
n
             dropNS n :: Name
n = Name
n
    match (PRef _ _ n :: Name
n) tm :: PTerm
tm
        | Bool -> Bool
not Bool
names Bool -> Bool -> Bool
&& (Bool -> Bool
not (Name -> Context -> Bool
isConName Name
n (IState -> Context
tt_ctxt IState
i) Bool -> Bool -> Bool
||
                             Name -> Context -> Bool
isFnName Name
n (IState -> Context
tt_ctxt IState
i)) Bool -> Bool -> Bool
|| PTerm
tm PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
== PTerm
Placeholder)
            = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name
n, PTerm
tm)]
    match (PRewrite _ by :: Maybe Name
by l :: PTerm
l r :: PTerm
r _) (PRewrite _ by' :: Maybe Name
by' l' :: PTerm
l' r' :: PTerm
r' _) | Maybe Name
by Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Name
by'
                                    = do [(Name, PTerm)]
ml <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
l PTerm
l'
                                         [(Name, PTerm)]
mr <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
r PTerm
r'
                                         [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mr)
    match (PTyped l :: PTerm
l r :: PTerm
r) (PTyped l' :: PTerm
l' r' :: PTerm
r') = do [(Name, PTerm)]
ml <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
l PTerm
l'
                                           [(Name, PTerm)]
mr <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
r PTerm
r'
                                           [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mr)
    match (PTyped l :: PTerm
l r :: PTerm
r) x :: PTerm
x = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
l PTerm
x
    match x :: PTerm
x (PTyped l :: PTerm
l r :: PTerm
r) = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x PTerm
l
    match (PPair _ _ _ l :: PTerm
l r :: PTerm
r) (PPair _ _ _ l' :: PTerm
l' r' :: PTerm
r') = do [(Name, PTerm)]
ml <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
l PTerm
l'
                                                     [(Name, PTerm)]
mr <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
r PTerm
r'
                                                     [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mr)
    match (PDPair _ _ _ l :: PTerm
l t :: PTerm
t r :: PTerm
r) (PDPair _ _ _ l' :: PTerm
l' t' :: PTerm
t' r' :: PTerm
r') = do [(Name, PTerm)]
ml <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
l PTerm
l'
                                                            [(Name, PTerm)]
mt <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
t PTerm
t'
                                                            [(Name, PTerm)]
mr <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
r PTerm
r'
                                                            [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
ml [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mt [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mr)
    match (PAlternative _ a :: PAltType
a as :: [PTerm]
as) (PAlternative _ a' :: PAltType
a' as' :: [PTerm]
as')
        = do [[(Name, PTerm)]]
ms <- (PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)])
-> [PTerm] -> [PTerm] -> EitherErr (PTerm, PTerm) [[(Name, PTerm)]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' [PTerm]
as [PTerm]
as'
             [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Name, PTerm)]] -> [(Name, PTerm)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, PTerm)]]
ms)
    match a :: PTerm
a@(PAlternative _ _ as :: [PTerm]
as) b :: PTerm
b
        = do let ms :: [EitherErr (PTerm, PTerm) [(Name, PTerm)]]
ms = (PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)])
-> [PTerm] -> [PTerm] -> [EitherErr (PTerm, PTerm) [(Name, PTerm)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' [PTerm]
as (PTerm -> [PTerm]
forall a. a -> [a]
repeat PTerm
b)
             case ([Either (PTerm, PTerm) [(Name, PTerm)]] -> [[(Name, PTerm)]]
forall a b. [Either a b] -> [b]
rights ((EitherErr (PTerm, PTerm) [(Name, PTerm)]
 -> Either (PTerm, PTerm) [(Name, PTerm)])
-> [EitherErr (PTerm, PTerm) [(Name, PTerm)]]
-> [Either (PTerm, PTerm) [(Name, PTerm)]]
forall a b. (a -> b) -> [a] -> [b]
map EitherErr (PTerm, PTerm) [(Name, PTerm)]
-> Either (PTerm, PTerm) [(Name, PTerm)]
forall a b. EitherErr a b -> Either a b
toEither [EitherErr (PTerm, PTerm) [(Name, PTerm)]]
ms)) of
                (x :: [(Name, PTerm)]
x: _) -> [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
x
                _ -> (PTerm, PTerm) -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a b. a -> EitherErr a b
LeftErr (PTerm
a, PTerm
b)
    match (PCase _ _ _) _ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [] -- lifted out
    match (PMetavar _ _) _ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [] -- modified
    match (PInferRef _ _ _) _ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [] -- modified
    match (PQuote _) _ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PProof _) _ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PTactics _) _ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PResolveTC _) (PResolveTC _) = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PTrue _ _) (PTrue _ _) = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PPi _ _ _ t :: PTerm
t s :: PTerm
s) (PPi _ _ _ t' :: PTerm
t' s' :: PTerm
s') = do [(Name, PTerm)]
mt <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
t PTerm
t'
                                                 [(Name, PTerm)]
ms <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
s PTerm
s'
                                                 [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mt [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
ms)
    match (PLam _ _ _ t :: PTerm
t s :: PTerm
s) (PLam _ _ _ t' :: PTerm
t' s' :: PTerm
s') = do [(Name, PTerm)]
mt <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
t PTerm
t'
                                                   [(Name, PTerm)]
ms <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
s PTerm
s'
                                                   [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mt [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
ms)
    match (PLet _ _ _ _ t :: PTerm
t ty :: PTerm
ty s :: PTerm
s) (PLet _ _ _ _ t' :: PTerm
t' ty' :: PTerm
ty' s' :: PTerm
s')
         = do [(Name, PTerm)]
mt <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
t PTerm
t'
              [(Name, PTerm)]
mty <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
ty PTerm
ty'
              [(Name, PTerm)]
ms <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
s PTerm
s'
              [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
mt [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
mty [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
ms)
    match (PHidden x :: PTerm
x) (PHidden y :: PTerm
y)
          | RightOK xs :: [(Name, PTerm)]
xs <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x PTerm
y = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
xs -- to collect variables
          | Bool
otherwise = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [] -- Otherwise hidden things are unmatchable
    match (PHidden x :: PTerm
x) y :: PTerm
y
          | RightOK xs :: [(Name, PTerm)]
xs <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x PTerm
y = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
xs
          | Bool
otherwise = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match x :: PTerm
x (PHidden y :: PTerm
y)
          | RightOK xs :: [(Name, PTerm)]
xs <- PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match PTerm
x PTerm
y = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name, PTerm)]
xs
          | Bool
otherwise = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PUnifyLog x :: PTerm
x) y :: PTerm
y = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
x PTerm
y
    match x :: PTerm
x (PUnifyLog y :: PTerm
y) = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
x PTerm
y
    match (PNoImplicits x :: PTerm
x) y :: PTerm
y = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
x PTerm
y
    match x :: PTerm
x (PNoImplicits y :: PTerm
y) = PTerm -> PTerm -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
match' PTerm
x PTerm
y
    match Placeholder _ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match _ Placeholder = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match (PResolveTC _) _ = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    match a :: PTerm
a b :: PTerm
b | PTerm
a PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
== PTerm
b = [(Name, PTerm)] -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
              | Bool
otherwise = (PTerm, PTerm) -> EitherErr (PTerm, PTerm) [(Name, PTerm)]
forall a b. a -> EitherErr a b
LeftErr (PTerm
a, PTerm
b)

    checkRpts :: EitherErr (PTerm, PTerm) [(a, PTerm)]
-> Either (PTerm, PTerm) [(a, PTerm)]
checkRpts (RightOK ms :: [(a, PTerm)]
ms) = [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
forall a.
Eq a =>
[(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
check [(a, PTerm)]
ms where
        check :: [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
check ((n :: a
n,t :: PTerm
t):xs :: [(a, PTerm)]
xs)
            | Just t' :: PTerm
t' <- a -> [(a, PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
n [(a, PTerm)]
xs = if PTerm
tPTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/=PTerm
t' Bool -> Bool -> Bool
&& PTerm
tPTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/=PTerm
Placeholder Bool -> Bool -> Bool
&& PTerm
t'PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/=PTerm
Placeholder
                                                then (PTerm, PTerm) -> Either (PTerm, PTerm) [(a, PTerm)]
forall a b. a -> Either a b
Left (PTerm
t, PTerm
t')
                                                else [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
check [(a, PTerm)]
xs
        check (_:xs :: [(a, PTerm)]
xs) = [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
check [(a, PTerm)]
xs
        check [] = [(a, PTerm)] -> Either (PTerm, PTerm) [(a, PTerm)]
forall a b. b -> Either a b
Right [(a, PTerm)]
ms
    checkRpts (LeftErr x :: (PTerm, PTerm)
x) = (PTerm, PTerm) -> Either (PTerm, PTerm) [(a, PTerm)]
forall a b. a -> Either a b
Left (PTerm, PTerm)
x

substMatches :: [(Name, PTerm)] -> PTerm -> PTerm
substMatches :: [(Name, PTerm)] -> PTerm -> PTerm
substMatches ms :: [(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 n :: Name
n = Name -> [Name] -> PTerm -> PTerm -> PTerm
substMatchShadow Name
n []

substMatchShadow :: Name -> [Name] -> PTerm -> PTerm -> PTerm
substMatchShadow :: Name -> [Name] -> PTerm -> PTerm -> PTerm
substMatchShadow n :: Name
n shs :: [Name]
shs tm :: PTerm
tm t :: 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 nmap :: [(Name, PTerm)]
nmap shs :: [Name]
shs t :: PTerm
t = [Name] -> PTerm -> PTerm
sm [Name]
shs PTerm
t where
    sm :: [Name] -> PTerm -> PTerm
sm xs :: [Name]
xs (PRef _ _ n :: Name
n) | Just tm :: PTerm
tm <- Name -> [(Name, PTerm)] -> Maybe PTerm
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, PTerm)]
nmap = PTerm
tm
    sm xs :: [Name]
xs (PLam fc :: FC
fc x :: Name
x xfc :: FC
xfc t :: PTerm
t sc :: 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 xs :: [Name]
xs (PPi p :: Plicity
p x :: Name
x fc :: FC
fc t :: PTerm
t sc :: PTerm
sc)
         | Name
x Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
xs
             = let x' :: Name
x' = Name -> Name
nextName Name
x in
                   Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
x' FC
fc ([Name] -> PTerm -> PTerm
sm (Name
x'Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
xs) (Name -> PTerm -> PTerm -> PTerm
substMatch Name
x (FC -> [FC] -> Name -> PTerm
PRef FC
emptyFC [] Name
x') PTerm
t))
                               ([Name] -> PTerm -> PTerm
sm (Name
x'Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
xs) (Name -> PTerm -> PTerm -> PTerm
substMatch Name
x (FC -> [FC] -> Name -> PTerm
PRef FC
emptyFC [] Name
x') PTerm
sc))
         | Bool
otherwise = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
x FC
fc ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
t) ([Name] -> PTerm -> PTerm
sm (Name
x Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
xs) PTerm
sc)
    sm xs :: [Name]
xs (PLet fc :: FC
fc rc :: RigCount
rc x :: Name
x xfc :: FC
xfc val :: PTerm
val t :: PTerm
t sc :: 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 xs :: [Name]
xs (PApp f :: FC
f x :: PTerm
x as :: [PArg]
as) = PTerm -> PTerm
fullApp (PTerm -> PTerm) -> PTerm -> PTerm
forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [PArg] -> PTerm
PApp FC
f ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Name] -> PTerm -> PTerm
sm [Name]
xs)) [PArg]
as)
    sm xs :: [Name]
xs (PCase f :: FC
f x :: PTerm
x as :: [(PTerm, PTerm)]
as) = FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
f ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) (((PTerm, PTerm) -> (PTerm, PTerm))
-> [(PTerm, PTerm)] -> [(PTerm, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> (PTerm, PTerm) -> (PTerm, PTerm)
forall t b. (t -> b) -> (t, t) -> (b, b)
pmap ([Name] -> PTerm -> PTerm
sm [Name]
xs)) [(PTerm, PTerm)]
as)
    sm xs :: [Name]
xs (PIfThenElse fc :: FC
fc c :: PTerm
c t :: PTerm
t f :: 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 xs :: [Name]
xs (PRewrite f :: FC
f by :: Maybe Name
by x :: PTerm
x y :: PTerm
y tm :: Maybe PTerm
tm) = FC -> Maybe Name -> PTerm -> PTerm -> Maybe PTerm -> PTerm
PRewrite FC
f Maybe Name
by ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
y)
                                                 ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Name] -> PTerm -> PTerm
sm [Name]
xs) Maybe PTerm
tm)
    sm xs :: [Name]
xs (PTyped x :: PTerm
x y :: PTerm
y) = PTerm -> PTerm -> PTerm
PTyped ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x) ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
y)
    sm xs :: [Name]
xs (PPair f :: FC
f hls :: [FC]
hls p :: PunInfo
p x :: PTerm
x y :: 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 xs :: [Name]
xs (PDPair f :: FC
f hls :: [FC]
hls p :: PunInfo
p x :: PTerm
x t :: PTerm
t y :: 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 xs :: [Name]
xs (PAlternative ms :: [(Name, Name)]
ms a :: PAltType
a as :: [PTerm]
as) = [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative [(Name, Name)]
ms PAltType
a ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map ([Name] -> PTerm -> PTerm
sm [Name]
xs) [PTerm]
as)
    sm xs :: [Name]
xs (PHidden x :: PTerm
x) = PTerm -> PTerm
PHidden ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x)
    sm xs :: [Name]
xs (PUnifyLog x :: PTerm
x) = PTerm -> PTerm
PUnifyLog ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x)
    sm xs :: [Name]
xs (PNoImplicits x :: PTerm
x) = PTerm -> PTerm
PNoImplicits ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
x)
    sm xs :: [Name]
xs (PRunElab fc :: FC
fc script :: PTerm
script ns :: [String]
ns) = FC -> PTerm -> [String] -> PTerm
PRunElab FC
fc ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
script) [String]
ns
    sm xs :: [Name]
xs (PConstSugar fc :: FC
fc tm :: PTerm
tm) = FC -> PTerm -> PTerm
PConstSugar FC
fc ([Name] -> PTerm -> PTerm
sm [Name]
xs PTerm
tm)
    sm xs :: [Name]
xs x :: PTerm
x = PTerm
x

    fullApp :: PTerm -> PTerm
fullApp (PApp _ (PApp fc :: FC
fc f :: PTerm
f args :: [PArg]
args) xs :: [PArg]
xs) = PTerm -> PTerm
fullApp (FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
f ([PArg]
args [PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++ [PArg]
xs))
    fullApp x :: PTerm
x = PTerm
x

shadow :: Name -> Name -> PTerm -> PTerm
shadow :: Name -> Name -> PTerm -> PTerm
shadow n :: Name
n n' :: Name
n' t :: PTerm
t = Integer -> PTerm -> PTerm
forall a. (Eq a, Num a) => a -> PTerm -> PTerm
sm 0 PTerm
t where
    sm :: a -> PTerm -> PTerm
sm 0 (PRef fc :: FC
fc hl :: [FC]
hl x :: Name
x) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
x = FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hl Name
n'
    sm 0 (PLam fc :: FC
fc x :: Name
x xfc :: FC
xfc t :: PTerm
t sc :: PTerm
sc) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
x = FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
x FC
xfc (a -> PTerm -> PTerm
sm 0 PTerm
t) (a -> PTerm -> PTerm
sm 0 PTerm
sc)
                            | Bool
otherwise = FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
x FC
xfc (a -> PTerm -> PTerm
sm 0 PTerm
t) PTerm
sc
    sm 0 (PPi p :: Plicity
p x :: Name
x fc :: FC
fc t :: PTerm
t sc :: PTerm
sc) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
x = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
x FC
fc (a -> PTerm -> PTerm
sm 0 PTerm
t) (a -> PTerm -> PTerm
sm 0 PTerm
sc)
                         | Bool
otherwise = Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
x FC
fc (a -> PTerm -> PTerm
sm 0 PTerm
t) PTerm
sc
    sm 0 (PLet fc :: FC
fc rc :: RigCount
rc x :: Name
x xfc :: FC
xfc t :: PTerm
t v :: PTerm
v sc :: PTerm
sc) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
x = FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
x FC
xfc (a -> PTerm -> PTerm
sm 0 PTerm
t) (a -> PTerm -> PTerm
sm 0 PTerm
v) (a -> PTerm -> PTerm
sm 0 PTerm
sc)
                              | Bool
otherwise = FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
x FC
xfc (a -> PTerm -> PTerm
sm 0 PTerm
t) (a -> PTerm -> PTerm
sm 0 PTerm
v) PTerm
sc
    sm 0 (PApp f :: FC
f x :: PTerm
x as :: [PArg]
as) = FC -> PTerm -> [PArg] -> PTerm
PApp FC
f (a -> PTerm -> PTerm
sm 0 PTerm
x) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> PTerm -> PTerm
sm 0)) [PArg]
as)
    sm 0 (PAppBind f :: FC
f x :: PTerm
x as :: [PArg]
as) = FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
f (a -> PTerm -> PTerm
sm 0 PTerm
x) ((PArg -> PArg) -> [PArg] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PArg -> PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> PTerm -> PTerm
sm 0)) [PArg]
as)
    sm 0 (PCase f :: FC
f x :: PTerm
x as :: [(PTerm, PTerm)]
as) = FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
f (a -> PTerm -> PTerm
sm 0 PTerm
x) (((PTerm, PTerm) -> (PTerm, PTerm))
-> [(PTerm, PTerm)] -> [(PTerm, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> (PTerm, PTerm) -> (PTerm, PTerm)
forall t b. (t -> b) -> (t, t) -> (b, b)
pmap (a -> PTerm -> PTerm
sm 0)) [(PTerm, PTerm)]
as)
    sm 0 (PIfThenElse fc :: FC
fc c :: PTerm
c t :: PTerm
t f :: PTerm
f) = FC -> PTerm -> PTerm -> PTerm -> PTerm
PIfThenElse FC
fc (a -> PTerm -> PTerm
sm 0 PTerm
c) (a -> PTerm -> PTerm
sm 0 PTerm
t) (a -> PTerm -> PTerm
sm 0 PTerm
f)
    sm 0 (PRewrite f :: FC
f by :: Maybe Name
by x :: PTerm
x y :: PTerm
y tm :: Maybe PTerm
tm) = FC -> Maybe Name -> PTerm -> PTerm -> Maybe PTerm -> PTerm
PRewrite FC
f Maybe Name
by (a -> PTerm -> PTerm
sm 0 PTerm
x) (a -> PTerm -> PTerm
sm 0 PTerm
y) ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> PTerm -> PTerm
sm 0) Maybe PTerm
tm)
    sm 0 (PTyped x :: PTerm
x y :: PTerm
y) = PTerm -> PTerm -> PTerm
PTyped (a -> PTerm -> PTerm
sm 0 PTerm
x) (a -> PTerm -> PTerm
sm 0 PTerm
y)
    sm 0 (PPair f :: FC
f hls :: [FC]
hls p :: PunInfo
p x :: PTerm
x y :: PTerm
y) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
f [FC]
hls PunInfo
p (a -> PTerm -> PTerm
sm 0 PTerm
x) (a -> PTerm -> PTerm
sm 0 PTerm
y)
    sm 0 (PDPair f :: FC
f hls :: [FC]
hls p :: PunInfo
p x :: PTerm
x t :: PTerm
t y :: PTerm
y) = FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
f [FC]
hls PunInfo
p (a -> PTerm -> PTerm
sm 0 PTerm
x) (a -> PTerm -> PTerm
sm 0 PTerm
t) (a -> PTerm -> PTerm
sm 0 PTerm
y)
    sm 0 (PAlternative ms :: [(Name, Name)]
ms a :: PAltType
a as :: [PTerm]
as)
          = [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative (((Name, Name) -> (Name, Name)) -> [(Name, Name)] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Name) -> (Name, Name)
shadowAlt [(Name, Name)]
ms) PAltType
a ((PTerm -> PTerm) -> [PTerm] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (a -> PTerm -> PTerm
sm 0) [PTerm]
as)
    sm 0 (PTactics ts :: [PTactic]
ts) = [PTactic] -> PTerm
PTactics ((PTactic -> PTactic) -> [PTactic] -> [PTactic]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PTactic -> PTactic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> PTerm -> PTerm
sm 0)) [PTactic]
ts)
    sm 0 (PProof ts :: [PTactic]
ts) = [PTactic] -> PTerm
PProof ((PTactic -> PTactic) -> [PTactic] -> [PTactic]
forall a b. (a -> b) -> [a] -> [b]
map ((PTerm -> PTerm) -> PTactic -> PTactic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> PTerm -> PTerm
sm 0)) [PTactic]
ts)
    sm 0 (PHidden x :: PTerm
x) = PTerm -> PTerm
PHidden (a -> PTerm -> PTerm
sm 0 PTerm
x)
    sm 0 (PUnifyLog x :: PTerm
x) = PTerm -> PTerm
PUnifyLog (a -> PTerm -> PTerm
sm 0 PTerm
x)
    sm 0 (PNoImplicits x :: PTerm
x) = PTerm -> PTerm
PNoImplicits (a -> PTerm -> PTerm
sm 0 PTerm
x)
    sm 0 (PCoerced t :: PTerm
t) = PTerm -> PTerm
PCoerced (a -> PTerm -> PTerm
sm 0 PTerm
t)
    sm ql :: a
ql (PQuasiquote tm :: PTerm
tm ty :: Maybe PTerm
ty) = PTerm -> Maybe PTerm -> PTerm
PQuasiquote (a -> PTerm -> PTerm
sm (a
ql a -> a -> a
forall a. Num a => a -> a -> a
+ 1) PTerm
tm) ((PTerm -> PTerm) -> Maybe PTerm -> Maybe PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> PTerm -> PTerm
sm a
ql) Maybe PTerm
ty)
    sm ql :: a
ql (PUnquote tm :: PTerm
tm) = PTerm -> PTerm
PUnquote (a -> PTerm -> PTerm
sm (a
ql a -> a -> a
forall a. Num a => a -> a -> a
- 1) PTerm
tm)
    sm ql :: a
ql x :: PTerm
x = (PTerm -> PTerm) -> PTerm -> PTerm
forall on. Uniplate on => (on -> on) -> on -> on
descend (a -> PTerm -> PTerm
sm a
ql) PTerm
x

    shadowAlt :: (Name, Name) -> (Name, Name)
shadowAlt p :: (Name, Name)
p@(x :: Name
x, oldn :: Name
oldn) = (Name -> Name
update Name
x, Name -> Name
update Name
oldn)
    update :: Name -> Name
update oldn :: Name
oldn | Name
n Name -> Name -> Bool
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 env :: [Name]
env shadows :: [(Name, Name)]
shadows tm :: PTerm
tm
      = State (Set Name) PTerm -> Set Name -> PTerm
forall s a. State s a -> s -> a
evalState (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
initMap PTerm
tm) ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList [Name]
env) where

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

  inScope :: S.Set Name
  inScope :: Set Name
inScope = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$ PTerm -> [Name]
boundNamesIn PTerm
tm

  mkUniqA :: Int -> Map Name Name -> PArg -> StateT (Set Name) Identity PArg
mkUniqA ql :: Int
ql nmap :: Map Name Name
nmap arg :: PArg
arg = do PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
ql Map Name Name
nmap (PArg -> PTerm
forall t. PArg' t -> t
getTm PArg
arg)
                           PArg -> StateT (Set Name) Identity PArg
forall (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 n :: Text
n) l :: Int
l = Text -> Name
UN (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ String -> Text
txt (Text -> String
str Text
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l)
  initN (MN i :: Int
i s :: Text
s) l :: Int
l = Int -> Text -> Name
MN (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) Text
s
  initN n :: Name
n _ = 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 _ nmap :: p
nmap tac :: a
tac = a -> m a
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 0 nmap :: Map Name Name
nmap (PLam fc :: FC
fc n :: Name
n nfc :: FC
nfc ty :: PTerm
ty sc :: PTerm
sc)
         = do Set Name
env <- StateT (Set Name) Identity (Set Name)
forall s (m :: * -> *). MonadState s m => m s
get
              (n' :: Name
n', sc' :: PTerm
sc') <-
                    if Name
n Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
env
                       then do let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet (Name -> Int -> Name
initN Name
n (Set Name -> Int
forall a. Set a -> Int
S.size Set Name
env))
                                                      (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
                               (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc) -- shadow n n' sc)
                       else (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
              Set Name -> StateT (Set Name) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
              let nmap' :: Map Name Name
nmap' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n' Map Name Name
nmap
              PTerm
ty' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
ty
              PTerm
sc'' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap' PTerm
sc'
              PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
n' FC
nfc PTerm
ty' PTerm
sc''
  mkUniq 0 nmap :: Map Name Name
nmap (PPi p :: Plicity
p n :: Name
n fc :: FC
fc ty :: PTerm
ty sc :: PTerm
sc)
         = do Set Name
env <- StateT (Set Name) Identity (Set Name)
forall s (m :: * -> *). MonadState s m => m s
get
              (n' :: Name
n', sc' :: PTerm
sc') <-
                    if Name
n Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
env
                       then do let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet (Name -> Int -> Name
initN Name
n (Set Name -> Int
forall a. Set a -> Int
S.size Set Name
env))
                                                      (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
                               (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc) -- shadow n n' sc)
                       else (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
              Set Name -> StateT (Set Name) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
              let nmap' :: Map Name Name
nmap' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n' Map Name Name
nmap
              PTerm
ty' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
ty
              PTerm
sc'' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap' PTerm
sc'
              PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
p Name
n' FC
fc PTerm
ty' PTerm
sc''
  mkUniq 0 nmap :: Map Name Name
nmap (PLet fc :: FC
fc rc :: RigCount
rc n :: Name
n nfc :: FC
nfc ty :: PTerm
ty val :: PTerm
val sc :: PTerm
sc)
         = do Set Name
env <- StateT (Set Name) Identity (Set Name)
forall s (m :: * -> *). MonadState s m => m s
get
              (n' :: Name
n', sc' :: PTerm
sc') <-
                    if Name
n Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
env
                       then do let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet (Name -> Int -> Name
initN Name
n (Set Name -> Int
forall a. Set a -> Int
S.size Set Name
env))
                                                      (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
                               (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc) -- shadow n n' sc)
                       else (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
              Set Name -> StateT (Set Name) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
              let nmap' :: Map Name Name
nmap' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n' Map Name Name
nmap
              PTerm
ty' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
ty; PTerm
val' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
val
              PTerm
sc'' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap' PTerm
sc'
              PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rc Name
n' FC
nfc PTerm
ty' PTerm
val' PTerm
sc''
  mkUniq 0 nmap :: Map Name Name
nmap (PApp fc :: FC
fc t :: PTerm
t args :: [PArg]
args)
         = do PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t
              [PArg]
args' <- (PArg -> StateT (Set Name) Identity PArg)
-> [PArg] -> StateT (Set Name) Identity [PArg]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Map Name Name -> PArg -> StateT (Set Name) Identity PArg
mkUniqA 0 Map Name Name
nmap) [PArg]
args
              PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc PTerm
t' [PArg]
args'
  mkUniq 0 nmap :: Map Name Name
nmap (PAppBind fc :: FC
fc t :: PTerm
t args :: [PArg]
args)
         = do PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t
              [PArg]
args' <- (PArg -> StateT (Set Name) Identity PArg)
-> [PArg] -> StateT (Set Name) Identity [PArg]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Map Name Name -> PArg -> StateT (Set Name) Identity PArg
mkUniqA 0 Map Name Name
nmap) [PArg]
args
              PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> PTerm -> [PArg] -> PTerm
PAppBind FC
fc PTerm
t' [PArg]
args'
  mkUniq 0 nmap :: Map Name Name
nmap (PCase fc :: FC
fc t :: PTerm
t alts :: [(PTerm, PTerm)]
alts)
         = do PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t
              [(PTerm, PTerm)]
alts' <- ((PTerm, PTerm) -> StateT (Set Name) Identity (PTerm, PTerm))
-> [(PTerm, PTerm)] -> StateT (Set Name) Identity [(PTerm, PTerm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(x :: PTerm
x,y :: PTerm
y)-> do PTerm
x' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
x; PTerm
y' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
y
                                         (PTerm, PTerm) -> StateT (Set Name) Identity (PTerm, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm
x', PTerm
y')) [(PTerm, PTerm)]
alts
              PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc PTerm
t' [(PTerm, PTerm)]
alts'
  mkUniq 0 nmap :: Map Name Name
nmap (PIfThenElse fc :: FC
fc c :: PTerm
c t :: PTerm
t f :: PTerm
f)
         = (PTerm -> PTerm -> PTerm -> PTerm)
-> State (Set Name) PTerm
-> State (Set Name) PTerm
-> State (Set Name) PTerm
-> State (Set Name) PTerm
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (FC -> PTerm -> PTerm -> PTerm -> PTerm
PIfThenElse FC
fc) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
c) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
f)
  mkUniq 0 nmap :: Map Name Name
nmap (PPair fc :: FC
fc hls :: [FC]
hls p :: PunInfo
p l :: PTerm
l r :: PTerm
r)
         = do PTerm
l' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
l; PTerm
r' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
r
              PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm
PPair FC
fc [FC]
hls PunInfo
p PTerm
l' PTerm
r'
  mkUniq 0 nmap :: Map Name Name
nmap (PDPair fc :: FC
fc hls :: [FC]
hls p :: PunInfo
p (PRef fc' :: FC
fc' hls' :: [FC]
hls' n :: Name
n) t :: PTerm
t sc :: PTerm
sc)
      | PTerm
t PTerm -> PTerm -> Bool
forall a. Eq a => a -> a -> Bool
/= PTerm
Placeholder
         = do Set Name
env <- StateT (Set Name) Identity (Set Name)
forall s (m :: * -> *). MonadState s m => m s
get
              (n' :: Name
n', sc' :: PTerm
sc') <- if Name
n Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
env
                              then do let n' :: Name
n' = Name -> Set Name -> Name
uniqueNameSet Name
n (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
env Set Name
inScope)
                                      (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n', PTerm
sc) -- shadow n n' sc)
                              else (Name, PTerm) -> StateT (Set Name) Identity (Name, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, PTerm
sc)
              Set Name -> StateT (Set Name) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
S.insert Name
n' Set Name
env)
              let nmap' :: Map Name Name
nmap' = Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
n Name
n' Map Name Name
nmap
              PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t
              PTerm
sc'' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap' PTerm
sc'
              PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
fc [FC]
hls PunInfo
p (FC -> [FC] -> Name -> PTerm
PRef FC
fc' [FC]
hls' Name
n') PTerm
t' PTerm
sc''
  mkUniq 0 nmap :: Map Name Name
nmap (PDPair fc :: FC
fc hls :: [FC]
hls p :: PunInfo
p l :: PTerm
l t :: PTerm
t r :: PTerm
r)
         = do PTerm
l' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
l; PTerm
t' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t; PTerm
r' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
r
              PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! FC -> [FC] -> PunInfo -> PTerm -> PTerm -> PTerm -> PTerm
PDPair FC
fc [FC]
hls PunInfo
p PTerm
l' PTerm
t' PTerm
r'
  mkUniq 0 nmap :: Map Name Name
nmap (PAlternative ns :: [(Name, Name)]
ns b :: PAltType
b as :: [PTerm]
as)
         -- store the nmap and defer the rest until we've pruned the set
         -- during elaboration
         = PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> PAltType -> [PTerm] -> PTerm
PAlternative ([(Name, Name)]
ns [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Map Name Name -> [(Name, Name)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name Name
nmap) PAltType
b [PTerm]
as
  mkUniq 0 nmap :: Map Name Name
nmap (PHidden t :: PTerm
t) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PTerm -> PTerm
PHidden (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t)
  mkUniq 0 nmap :: Map Name Name
nmap (PUnifyLog t :: PTerm
t) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PTerm -> PTerm
PUnifyLog (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t)
  mkUniq 0 nmap :: Map Name Name
nmap (PDisamb n :: [[Text]]
n t :: PTerm
t) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([[Text]] -> PTerm -> PTerm
PDisamb [[Text]]
n) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t)
  mkUniq 0 nmap :: Map Name Name
nmap (PNoImplicits t :: PTerm
t) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PTerm -> PTerm
PNoImplicits (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
t)
  mkUniq 0 nmap :: Map Name Name
nmap (PProof ts :: [PTactic]
ts) = ([PTactic] -> PTerm)
-> StateT (Set Name) Identity [PTactic] -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [PTactic] -> PTerm
PProof ((PTactic -> StateT (Set Name) Identity PTactic)
-> [PTactic] -> StateT (Set Name) Identity [PTactic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Integer
-> Map Name Name -> PTactic -> StateT (Set Name) Identity PTactic
forall (m :: * -> *) p p a. Monad m => p -> p -> a -> m a
mkUniqT 0 Map Name Name
nmap) [PTactic]
ts)
  mkUniq 0 nmap :: Map Name Name
nmap (PTactics ts :: [PTactic]
ts) = ([PTactic] -> PTerm)
-> StateT (Set Name) Identity [PTactic] -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [PTactic] -> PTerm
PTactics ((PTactic -> StateT (Set Name) Identity PTactic)
-> [PTactic] -> StateT (Set Name) Identity [PTactic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Integer
-> Map Name Name -> PTactic -> StateT (Set Name) Identity PTactic
forall (m :: * -> *) p p a. Monad m => p -> p -> a -> m a
mkUniqT 0 Map Name Name
nmap) [PTactic]
ts)
  mkUniq 0 nmap :: Map Name Name
nmap (PRunElab fc :: FC
fc ts :: PTerm
ts ns :: [String]
ns) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\tm :: PTerm
tm -> FC -> PTerm -> [String] -> PTerm
PRunElab FC
fc PTerm
tm [String]
ns) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
ts)
  mkUniq 0 nmap :: Map Name Name
nmap (PConstSugar fc :: FC
fc tm :: PTerm
tm) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (FC -> PTerm -> PTerm
PConstSugar FC
fc) (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
tm)
  mkUniq 0 nmap :: Map Name Name
nmap (PCoerced tm :: PTerm
tm) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PTerm -> PTerm
PCoerced (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq 0 Map Name Name
nmap PTerm
tm)
  mkUniq 0 nmap :: Map Name Name
nmap t :: PTerm
t = PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> PTerm -> PTerm
shadowAll (Map Name Name -> [(Name, Name)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name Name
nmap) PTerm
t
    where
      shadowAll :: [(Name, Name)] -> PTerm -> PTerm
shadowAll [] t :: PTerm
t = PTerm
t
      shadowAll ((n :: Name
n, n' :: Name
n') : ns :: [(Name, Name)]
ns) t :: PTerm
t = Name -> Name -> PTerm -> PTerm
shadow Name
n Name
n' ([(Name, Name)] -> PTerm -> PTerm
shadowAll [(Name, Name)]
ns PTerm
t)

  mkUniq ql :: Int
ql nmap :: Map Name Name
nmap (PQuasiquote tm :: PTerm
tm ty :: Maybe PTerm
ty) =
    do PTerm
tm' <- Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq (Int
ql Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Map Name Name
nmap PTerm
tm
       Maybe PTerm
ty' <- case Maybe PTerm
ty of
                Nothing -> Maybe PTerm -> StateT (Set Name) Identity (Maybe PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PTerm
forall a. Maybe a
Nothing
                Just t :: PTerm
t -> (PTerm -> Maybe PTerm)
-> State (Set Name) PTerm
-> StateT (Set Name) Identity (Maybe PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PTerm -> Maybe PTerm
forall a. a -> Maybe a
Just (State (Set Name) PTerm
 -> StateT (Set Name) Identity (Maybe PTerm))
-> State (Set Name) PTerm
-> StateT (Set Name) Identity (Maybe PTerm)
forall a b. (a -> b) -> a -> b
$ Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq Int
ql Map Name Name
nmap PTerm
t
       PTerm -> State (Set Name) PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall a b. (a -> b) -> a -> b
$! PTerm -> Maybe PTerm -> PTerm
PQuasiquote PTerm
tm' Maybe PTerm
ty'
  mkUniq ql :: Int
ql nmap :: Map Name Name
nmap (PUnquote tm :: PTerm
tm) = (PTerm -> PTerm)
-> State (Set Name) PTerm -> State (Set Name) PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PTerm -> PTerm
PUnquote (Int -> Map Name Name -> PTerm -> State (Set Name) PTerm
mkUniq (Int
ql Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Map Name Name
nmap PTerm
tm)

  mkUniq ql :: Int
ql nmap :: Map Name Name
nmap tm :: PTerm
tm = (PTerm -> State (Set Name) PTerm)
-> PTerm -> State (Set Name) PTerm
forall on (m :: * -> *).
(Uniplate on, Monad 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