{-# LANGUAGE ConstraintKinds, FlexibleContexts, GeneralizedNewtypeDeriving,
PatternGuards #-}
{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -fwarn-unused-imports #-}
module Idris.Parser(IdrisParser(..), ImportInfo(..), moduleName, addReplSyntax, clearParserWarnings,
decl, fixColour, loadFromIFile, loadModule, name, opChars, parseElabShellStep, parseConst, parseExpr, parseImports, parseTactic,
runparser, ParseError, parseErrorDoc) where
import Idris.AbsSyntax hiding (namespace, params)
import Idris.Core.Evaluate
import Idris.Core.TT
import Idris.Delaborate
import Idris.Docstrings hiding (Unchecked)
import Idris.DSL
import Idris.Elab.Value
import Idris.ElabDecls
import Idris.Error
import Idris.IBC
import Idris.Imports
import Idris.Options
import Idris.Output
import Idris.Parser.Data
import Idris.Parser.Expr
import Idris.Parser.Helpers
import Idris.Parser.Ops
import Idris.Termination
import Idris.Unlit
import Util.System (readSource)
import Prelude hiding (pi)
import Control.Applicative hiding (Const)
import Control.Monad
import Control.Monad.State.Strict
import Data.Char
import Data.Foldable (asum)
import Data.Function
import Data.Generics.Uniplate.Data (descendM)
import Data.List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.List.Split as Spl
import qualified Data.Map as M
import Data.Maybe
import Data.Ord
import qualified Data.Set as S
import qualified Data.Text as T
import qualified System.Directory as Dir (doesFileExist, getModificationTime,
makeAbsolute)
import System.FilePath
import Text.Megaparsec ((<?>))
import qualified Text.Megaparsec as P
import qualified Text.PrettyPrint.ANSI.Leijen as PP
moduleName :: Parsing m => m Name
moduleName :: m Name
moduleName = [Text] -> [Text] -> Name
mkName [] ([Text] -> Name) -> ([String] -> [Text]) -> [String] -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> Name) -> m [String] -> m Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [String]
forall (m :: * -> *). Parsing m => m [String]
moduleNamePieces where
mkName :: [T.Text] -> [T.Text] -> Name
mkName :: [Text] -> [Text] -> Name
mkName ts :: [Text]
ts [x :: Text
x] = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ts then Text -> Name
UN Text
x else Name -> [Text] -> Name
NS (Text -> Name
UN Text
x) [Text]
ts
mkName ts :: [Text]
ts (x :: Text
x:xs :: [Text]
xs) = [Text] -> [Text] -> Name
mkName (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts) [Text]
xs
moduleNamePieces :: Parsing m => m [String]
moduleNamePieces :: m [String]
moduleNamePieces = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
Spl.splitOn "." (String -> [String]) -> m String -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). Parsing m => m String
identifier
moduleHeader :: IdrisParser (Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
= IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
-> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do Maybe (Docstring (), [(Name, Docstring ())])
docs <- StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (), [(Name, Docstring ())])
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Docstring (), [(Name, Docstring ())]))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (), [(Name, Docstring ())])
docComment
Maybe (Docstring (), [(Name, Docstring ())])
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (t :: * -> *) (m :: * -> *) a a.
(Foldable t, MonadFail m) =>
Maybe (a, t a) -> m ()
noArgs Maybe (Docstring (), [(Name, Docstring ())])
docs
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "module"
(modName :: [String]
modName, ifc :: FC
ifc) <- StateT IState (WriterT FC (Parsec Void String)) [String]
-> StateT IState (WriterT FC (Parsec Void String)) ([String], FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) [String]
forall (m :: * -> *). Parsing m => m [String]
moduleNamePieces
Char
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option ';' (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ';')
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
-> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
forall (m :: * -> *) a. Monad m => a -> m a
return (((Docstring (), [(Name, Docstring ())]) -> Docstring ())
-> Maybe (Docstring (), [(Name, Docstring ())])
-> Maybe (Docstring ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Docstring (), [(Name, Docstring ())]) -> Docstring ()
forall a b. (a, b) -> a
fst Maybe (Docstring (), [(Name, Docstring ())])
docs,
[String]
modName,
[(FC
ifc, [Text] -> Maybe String -> OutputAnnotation
AnnNamespace ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
modName) Maybe String
forall a. Maybe a
Nothing)]))
IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
-> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
-> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
-> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%'; String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "unqualified"
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
-> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Docstring ())
forall a. Maybe a
Nothing, [], []))
IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
-> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
-> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
-> IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Docstring ())
forall a. Maybe a
Nothing, ["Main"], [])
where noArgs :: Maybe (a, t a) -> m ()
noArgs (Just (_, args :: t a
args)) | Bool -> Bool
not (t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
args) = String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Modules do not take arguments"
noArgs _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data ImportInfo = ImportInfo { ImportInfo -> Bool
import_reexport :: Bool
, ImportInfo -> String
import_path :: FilePath
, ImportInfo -> Maybe (String, FC)
import_rename :: Maybe (String, FC)
, ImportInfo -> [Text]
import_namespace :: [T.Text]
, ImportInfo -> FC
import_location :: FC
, ImportInfo -> FC
import_modname_location :: FC
}
import_ :: IdrisParser ImportInfo
import_ :: IdrisParser ImportInfo
import_ = do FC
fc <- StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a. MonadWriter FC m => m a -> m FC
extent (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall a b. (a -> b) -> a -> b
$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "import"
Bool
reexport <- Bool
-> StateT IState (WriterT FC (Parsec Void String)) Bool
-> StateT IState (WriterT FC (Parsec Void String)) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Bool
False (Bool
True Bool
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "public")
(ns :: [String]
ns, idfc :: FC
idfc) <- StateT IState (WriterT FC (Parsec Void String)) [String]
-> StateT IState (WriterT FC (Parsec Void String)) ([String], FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) [String]
forall (m :: * -> *). Parsing m => m [String]
moduleNamePieces
Maybe (String, FC)
newName <- StateT IState (WriterT FC (Parsec Void String)) (String, FC)
-> StateT
IState (WriterT FC (Parsec Void String)) (Maybe (String, FC))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "as"
StateT IState (WriterT FC (Parsec Void String)) String
-> StateT IState (WriterT FC (Parsec Void String)) (String, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
identifier)
Char
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option ';' (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ';')
ImportInfo -> IdrisParser ImportInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (ImportInfo -> IdrisParser ImportInfo)
-> ImportInfo -> IdrisParser ImportInfo
forall a b. (a -> b) -> a -> b
$ Bool
-> String -> Maybe (String, FC) -> [Text] -> FC -> FC -> ImportInfo
ImportInfo Bool
reexport ([String] -> String
toPath [String]
ns)
(((String, FC) -> (String, FC))
-> Maybe (String, FC) -> Maybe (String, FC)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(n :: String
n, fc :: FC
fc) -> ([String] -> String
toPath (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
Spl.splitOn "." String
n), FC
fc)) Maybe (String, FC)
newName)
((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
ns) FC
fc FC
idfc
IdrisParser ImportInfo -> String -> IdrisParser ImportInfo
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "import statement"
where toPath :: [String] -> String
toPath = (String -> String -> String) -> [String] -> String
forall a. (a -> a -> a) -> [a] -> a
foldl1' String -> String -> String
(</>)
prog :: SyntaxInfo -> IdrisParser [PDecl]
prog :: SyntaxInfo -> IdrisParser [PDecl]
prog syn :: SyntaxInfo
syn = do (decls :: [PDecl]
decls, fc :: FC
fc) <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) ([PDecl], FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) ([PDecl], FC))
-> IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) ([PDecl], FC)
forall a b. (a -> b) -> a -> b
$ do
StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => m ()
whiteSpace
[PDecl]
decls <- [[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PDecl]] -> [PDecl])
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
-> IdrisParser [PDecl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (SyntaxInfo -> IdrisParser [PDecl]
decl SyntaxInfo
syn)
case SyntaxInfo -> Maybe Int
maxline SyntaxInfo
syn of
Nothing -> do StateT IState (WriterT FC (Parsec Void String)) ()
notOpenBraces; StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
_ -> () -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [PDecl]
decls
IState
ist <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
IState -> StateT IState (WriterT FC (Parsec Void String)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put IState
ist { idris_parsedSpan :: Maybe FC
idris_parsedSpan = FC -> Maybe FC
forall a. a -> Maybe a
Just (String -> (Int, Int) -> (Int, Int) -> FC
FC (FC -> String
fc_fname FC
fc) (0,0) (FC -> (Int, Int)
fc_end FC
fc)),
ibc_write :: [IBCWrite]
ibc_write = FC -> IBCWrite
IBCParsedRegion FC
fc IBCWrite -> [IBCWrite] -> [IBCWrite]
forall a. a -> [a] -> [a]
: IState -> [IBCWrite]
ibc_write IState
ist }
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [PDecl]
decls
decl :: SyntaxInfo -> IdrisParser [PDecl]
decl :: SyntaxInfo -> IdrisParser [PDecl]
decl syn :: SyntaxInfo
syn = IdrisParser [PDecl] -> IdrisParser [PDecl]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (SyntaxInfo -> IdrisParser [PDecl]
externalDecl SyntaxInfo
syn)
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
internalDecl SyntaxInfo
syn
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "declaration"
internalDecl :: SyntaxInfo -> IdrisParser [PDecl]
internalDecl :: SyntaxInfo -> IdrisParser [PDecl]
internalDecl syn :: SyntaxInfo
syn
= do FC
fc <- StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *). Parsing m => m FC
getFC
let continue :: Bool
continue = case SyntaxInfo -> Maybe Int
maxline SyntaxInfo
syn of
Nothing -> Bool
True
Just l :: Int
l -> if (Int, Int) -> Int
forall a b. (a, b) -> a
fst (FC -> (Int, Int)
fc_end FC
fc) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l
then SyntaxInfo -> Int
mut_nesting SyntaxInfo
syn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
else Bool
True
if Bool
continue then
do StateT IState (WriterT FC (Parsec Void String)) ()
notEndBlock
Bool -> IdrisParser [PDecl]
declBody Bool
continue
else IdrisParser [PDecl] -> IdrisParser [PDecl]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do StateT IState (WriterT FC (Parsec Void String)) ()
notEndBlock
Bool -> IdrisParser [PDecl]
declBody Bool
continue)
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> IdrisParser [PDecl]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "End of readable input"
where declBody :: Bool -> IdrisParser [PDecl]
declBody :: Bool -> IdrisParser [PDecl]
declBody b :: Bool
b =
IdrisParser [PDecl] -> IdrisParser [PDecl]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (SyntaxInfo -> IdrisParser [PDecl]
implementation SyntaxInfo
syn)
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (SyntaxInfo -> IdrisParser [PDecl]
openInterface SyntaxInfo
syn)
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> IdrisParser [PDecl]
declBody' Bool
b
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
using_ SyntaxInfo
syn
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
params SyntaxInfo
syn
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
mutual SyntaxInfo
syn
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
namespace SyntaxInfo
syn
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
interface_ SyntaxInfo
syn
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do PDecl
d <- SyntaxInfo -> IdrisParser PDecl
dsl SyntaxInfo
syn; [PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [PDecl
d]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
directive SyntaxInfo
syn
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
provider SyntaxInfo
syn
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
transform SyntaxInfo
syn
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do IdrisParser ImportInfo
import_; String -> IdrisParser [PDecl]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "imports must be at top of file"
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "declaration"
declBody' :: Bool -> IdrisParser [PDecl]
declBody' :: Bool -> IdrisParser [PDecl]
declBody' cont :: Bool
cont = do PDecl
d <- SyntaxInfo -> IdrisParser PDecl
decl' SyntaxInfo
syn
IState
i <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
let d' :: PDecl
d' = (PTerm -> PTerm) -> PDecl -> PDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SyntaxInfo -> PTerm -> PTerm
debindApp SyntaxInfo
syn (PTerm -> PTerm) -> (PTerm -> PTerm) -> PTerm -> PTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SyntaxInfo -> IState -> PTerm -> PTerm
desugar SyntaxInfo
syn IState
i)) PDecl
d
if Bool -> PDecl -> Bool
forall t. Bool -> PDecl' t -> Bool
continue Bool
cont PDecl
d'
then [PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [PDecl
d']
else String -> IdrisParser [PDecl]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "End of readable input"
continue :: Bool -> PDecl' t -> Bool
continue False (PClauses _ _ _ _) = Bool
True
continue c :: Bool
c _ = Bool
c
decl' :: SyntaxInfo -> IdrisParser PDecl
decl' :: SyntaxInfo -> IdrisParser PDecl
decl' syn :: SyntaxInfo
syn = IdrisParser PDecl
fixity
IdrisParser PDecl -> IdrisParser PDecl -> IdrisParser PDecl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser PDecl
syntaxDecl SyntaxInfo
syn
IdrisParser PDecl -> IdrisParser PDecl -> IdrisParser PDecl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser PDecl
fnDecl' SyntaxInfo
syn
IdrisParser PDecl -> IdrisParser PDecl -> IdrisParser PDecl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser PDecl
data_ SyntaxInfo
syn
IdrisParser PDecl -> IdrisParser PDecl -> IdrisParser PDecl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser PDecl
record SyntaxInfo
syn
IdrisParser PDecl -> IdrisParser PDecl -> IdrisParser PDecl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser PDecl
runElabDecl SyntaxInfo
syn
IdrisParser PDecl -> String -> IdrisParser PDecl
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "declaration"
externalDecl :: SyntaxInfo -> IdrisParser [PDecl]
externalDecl :: SyntaxInfo -> IdrisParser [PDecl]
externalDecl syn :: SyntaxInfo
syn = do IState
i <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
StateT IState (WriterT FC (Parsec Void String)) ()
notEndBlock
(decls :: [PDecl]
decls, fc :: FC
fc@(FC fn :: String
fn _ _)) <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) ([PDecl], FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) ([PDecl], FC))
-> IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) ([PDecl], FC)
forall a b. (a -> b) -> a -> b
$ SyntaxInfo -> [Syntax] -> IdrisParser [PDecl]
declExtensions SyntaxInfo
syn (SyntaxRules -> [Syntax]
syntaxRulesList (SyntaxRules -> [Syntax]) -> SyntaxRules -> [Syntax]
forall a b. (a -> b) -> a -> b
$ IState -> SyntaxRules
syntax_rules IState
i)
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PDecl] -> IdrisParser [PDecl]) -> [PDecl] -> IdrisParser [PDecl]
forall a b. (a -> b) -> a -> b
$ (PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ((FC -> FC) -> (FC -> FC) -> PDecl -> PDecl
mapPDeclFC (FC -> FC -> FC
fixFC FC
fc) (String -> FC -> FC -> FC
fixFCH String
fn FC
fc)) [PDecl]
decls
where
fixFC :: FC -> FC -> FC
fixFC :: FC -> FC -> FC
fixFC outer :: FC
outer inner :: FC
inner | FC
inner FC -> FC -> Bool
`fcIn` FC
outer = FC
inner
| Bool
otherwise = FC
outer
fixFCH :: String -> FC -> FC -> FC
fixFCH fn :: String
fn outer :: FC
outer inner :: FC
inner | FC
inner FC -> FC -> Bool
`fcIn` FC
outer = FC
inner
| Bool
otherwise = String -> FC
FileFC String
fn
declExtensions :: SyntaxInfo -> [Syntax] -> IdrisParser [PDecl]
declExtensions :: SyntaxInfo -> [Syntax] -> IdrisParser [PDecl]
declExtensions syn :: SyntaxInfo
syn rules :: [Syntax]
rules = SyntaxInfo
-> [Maybe (Name, SynMatch)] -> [Syntax] -> IdrisParser [PDecl]
declExtension SyntaxInfo
syn [] ((Syntax -> Bool) -> [Syntax] -> [Syntax]
forall a. (a -> Bool) -> [a] -> [a]
filter Syntax -> Bool
isDeclRule [Syntax]
rules)
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "user-defined declaration"
where
isDeclRule :: Syntax -> Bool
isDeclRule (DeclRule _ _) = Bool
True
isDeclRule _ = Bool
False
declExtension :: SyntaxInfo -> [Maybe (Name, SynMatch)] -> [Syntax]
-> IdrisParser [PDecl]
declExtension :: SyntaxInfo
-> [Maybe (Name, SynMatch)] -> [Syntax] -> IdrisParser [PDecl]
declExtension syn :: SyntaxInfo
syn ns :: [Maybe (Name, SynMatch)]
ns rules :: [Syntax]
rules =
[IdrisParser [PDecl]] -> IdrisParser [PDecl]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice ([IdrisParser [PDecl]] -> IdrisParser [PDecl])
-> [IdrisParser [PDecl]] -> IdrisParser [PDecl]
forall a b. (a -> b) -> a -> b
$ (([Syntax] -> IdrisParser [PDecl])
-> [[Syntax]] -> [IdrisParser [PDecl]])
-> [[Syntax]]
-> ([Syntax] -> IdrisParser [PDecl])
-> [IdrisParser [PDecl]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Syntax] -> IdrisParser [PDecl])
-> [[Syntax]] -> [IdrisParser [PDecl]]
forall a b. (a -> b) -> [a] -> [b]
map ((Syntax -> Syntax -> Bool) -> [Syntax] -> [[Syntax]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ([SSymbol] -> [SSymbol] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
ruleGroup ([SSymbol] -> [SSymbol] -> Bool)
-> (Syntax -> [SSymbol]) -> Syntax -> Syntax -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Syntax -> [SSymbol]
syntaxSymbols) [Syntax]
rules) (([Syntax] -> IdrisParser [PDecl]) -> [IdrisParser [PDecl]])
-> ([Syntax] -> IdrisParser [PDecl]) -> [IdrisParser [PDecl]]
forall a b. (a -> b) -> a -> b
$ \rs :: [Syntax]
rs ->
case [Syntax] -> Syntax
forall a. [a] -> a
head [Syntax]
rs of
DeclRule (symb :: SSymbol
symb:_) _ -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (IdrisParser [PDecl] -> IdrisParser [PDecl])
-> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall a b. (a -> b) -> a -> b
$ do
Maybe (Name, SynMatch)
n <- SSymbol -> IdrisParser (Maybe (Name, SynMatch))
extSymbol SSymbol
symb
SyntaxInfo
-> [Maybe (Name, SynMatch)] -> [Syntax] -> IdrisParser [PDecl]
declExtension SyntaxInfo
syn (Maybe (Name, SynMatch)
n Maybe (Name, SynMatch)
-> [Maybe (Name, SynMatch)] -> [Maybe (Name, SynMatch)]
forall a. a -> [a] -> [a]
: [Maybe (Name, SynMatch)]
ns) [[SSymbol] -> [PDecl] -> Syntax
DeclRule [SSymbol]
ss [PDecl]
t | (DeclRule (_:ss :: [SSymbol]
ss) t :: [PDecl]
t) <- [Syntax]
rs]
DeclRule [] dec :: [PDecl]
dec -> let r :: [PDecl]
r = (PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
update ((Maybe (Name, SynMatch) -> Maybe (Name, SynMatch))
-> [Maybe (Name, SynMatch)] -> [(Name, SynMatch)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Maybe (Name, SynMatch) -> Maybe (Name, SynMatch)
forall a. a -> a
id [Maybe (Name, SynMatch)]
ns)) [PDecl]
dec in
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [PDecl]
r
where
update :: [(Name, SynMatch)] -> PDecl -> PDecl
update :: [(Name, SynMatch)] -> PDecl -> PDecl
update ns :: [(Name, SynMatch)]
ns = [(Name, SynMatch)] -> PDecl -> PDecl
updateNs [(Name, SynMatch)]
ns (PDecl -> PDecl) -> (PDecl -> PDecl) -> PDecl -> PDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PTerm -> PTerm) -> PDecl -> PDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Name, SynMatch)] -> PTerm -> PTerm
updateRefs [(Name, SynMatch)]
ns) (PDecl -> PDecl) -> (PDecl -> PDecl) -> PDecl -> PDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PTerm -> PTerm) -> PDecl -> PDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Name, SynMatch)] -> PTerm -> PTerm
updateSynMatch [(Name, SynMatch)]
ns)
updateRefs :: [(Name, SynMatch)] -> PTerm -> PTerm
updateRefs ns :: [(Name, SynMatch)]
ns = (PTerm -> PTerm) -> PTerm -> PTerm
mapPT PTerm -> PTerm
newref
where
newref :: PTerm -> PTerm
newref (PRef fc :: FC
fc fcs :: [FC]
fcs n :: Name
n) = FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
fcs ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n)
newref t :: PTerm
t = PTerm
t
updateB :: [(Name, SynMatch)] -> Name -> Name
updateB :: [(Name, SynMatch)] -> Name -> Name
updateB ns :: [(Name, SynMatch)]
ns (NS n :: Name
n mods :: [Text]
mods) = Name -> [Text] -> Name
NS ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n) [Text]
mods
updateB ns :: [(Name, SynMatch)]
ns n :: Name
n = case Name -> [(Name, SynMatch)] -> Maybe SynMatch
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, SynMatch)]
ns of
Just (SynBind tfc :: FC
tfc t :: Name
t) -> Name
t
_ -> Name
n
updateNs :: [(Name, SynMatch)] -> PDecl -> PDecl
updateNs :: [(Name, SynMatch)] -> PDecl -> PDecl
updateNs ns :: [(Name, SynMatch)]
ns (PTy doc :: Docstring (Either Err PTerm)
doc argdoc :: [(Name, Docstring (Either Err PTerm))]
argdoc s :: SyntaxInfo
s fc :: FC
fc o :: FnOpts
o n :: Name
n fc' :: FC
fc' t :: PTerm
t)
= Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> FnOpts
-> Name
-> FC
-> PTerm
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> FnOpts
-> Name
-> FC
-> t
-> PDecl' t
PTy Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argdoc SyntaxInfo
s FC
fc FnOpts
o ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n) FC
fc' PTerm
t
updateNs ns :: [(Name, SynMatch)]
ns (PClauses fc :: FC
fc o :: FnOpts
o n :: Name
n cs :: [PClause' PTerm]
cs)
= FC -> FnOpts -> Name -> [PClause' PTerm] -> PDecl
forall t. FC -> FnOpts -> Name -> [PClause' t] -> PDecl' t
PClauses FC
fc FnOpts
o ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n) ((PClause' PTerm -> PClause' PTerm)
-> [PClause' PTerm] -> [PClause' PTerm]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PClause' PTerm -> PClause' PTerm
updateClause [(Name, SynMatch)]
ns) [PClause' PTerm]
cs)
updateNs ns :: [(Name, SynMatch)]
ns (PCAF fc :: FC
fc n :: Name
n t :: PTerm
t) = FC -> Name -> PTerm -> PDecl
forall t. FC -> Name -> t -> PDecl' t
PCAF FC
fc ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n) PTerm
t
updateNs ns :: [(Name, SynMatch)]
ns (PData ds :: Docstring (Either Err PTerm)
ds cds :: [(Name, Docstring (Either Err PTerm))]
cds s :: SyntaxInfo
s fc :: FC
fc o :: DataOpts
o dat :: PData' PTerm
dat)
= 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)
ds [(Name, Docstring (Either Err PTerm))]
cds SyntaxInfo
s FC
fc DataOpts
o ([(Name, SynMatch)] -> PData' PTerm -> PData' PTerm
forall t. [(Name, SynMatch)] -> PData' t -> PData' t
updateData [(Name, SynMatch)]
ns PData' PTerm
dat)
updateNs ns :: [(Name, SynMatch)]
ns (PParams fc :: FC
fc ps :: [(Name, PTerm)]
ps ds :: [PDecl]
ds) = FC -> [(Name, PTerm)] -> [PDecl] -> PDecl
forall t. FC -> [(Name, t)] -> [PDecl' t] -> PDecl' t
PParams FC
fc [(Name, PTerm)]
ps ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
updateNs [(Name, SynMatch)]
ns) [PDecl]
ds)
updateNs ns :: [(Name, SynMatch)]
ns (PNamespace s :: String
s fc :: FC
fc ds :: [PDecl]
ds) = String -> FC -> [PDecl] -> PDecl
forall t. String -> FC -> [PDecl' t] -> PDecl' t
PNamespace String
s FC
fc ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
updateNs [(Name, SynMatch)]
ns) [PDecl]
ds)
updateNs ns :: [(Name, SynMatch)]
ns (PRecord doc :: Docstring (Either Err PTerm)
doc syn :: SyntaxInfo
syn fc :: FC
fc o :: DataOpts
o n :: Name
n fc' :: FC
fc' ps :: [(Name, FC, Plicity, PTerm)]
ps pdocs :: [(Name, Docstring (Either Err PTerm))]
pdocs fields :: [(Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm)))]
fields cname :: Maybe (Name, FC)
cname cdoc :: Docstring (Either Err PTerm)
cdoc s :: SyntaxInfo
s)
= Docstring (Either Err PTerm)
-> SyntaxInfo
-> FC
-> DataOpts
-> Name
-> FC
-> [(Name, FC, Plicity, PTerm)]
-> [(Name, Docstring (Either Err PTerm))]
-> [(Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm)))]
-> Maybe (Name, FC)
-> Docstring (Either Err PTerm)
-> SyntaxInfo
-> PDecl
forall t.
Docstring (Either Err t)
-> SyntaxInfo
-> FC
-> DataOpts
-> Name
-> FC
-> [(Name, FC, Plicity, t)]
-> [(Name, Docstring (Either Err t))]
-> [(Maybe (Name, FC), Plicity, t,
Maybe (Docstring (Either Err t)))]
-> Maybe (Name, FC)
-> Docstring (Either Err t)
-> SyntaxInfo
-> PDecl' t
PRecord Docstring (Either Err PTerm)
doc SyntaxInfo
syn FC
fc DataOpts
o ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n) FC
fc' [(Name, FC, Plicity, PTerm)]
ps [(Name, Docstring (Either Err PTerm))]
pdocs
(((Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm)))
-> (Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm))))
-> [(Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm)))]
-> [(Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm)))]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)]
-> (Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm)))
-> (Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm)))
forall b b c d.
[(Name, SynMatch)]
-> (Maybe (Name, b), b, c, d) -> (Maybe (Name, b), b, c, d)
updateField [(Name, SynMatch)]
ns) [(Maybe (Name, FC), Plicity, PTerm,
Maybe (Docstring (Either Err PTerm)))]
fields)
([(Name, SynMatch)] -> Maybe (Name, FC) -> Maybe (Name, FC)
forall b. [(Name, SynMatch)] -> Maybe (Name, b) -> Maybe (Name, b)
updateRecCon [(Name, SynMatch)]
ns Maybe (Name, FC)
cname)
Docstring (Either Err PTerm)
cdoc
SyntaxInfo
s
updateNs ns :: [(Name, SynMatch)]
ns (PInterface docs :: Docstring (Either Err PTerm)
docs s :: SyntaxInfo
s fc :: FC
fc cs :: [(Name, PTerm)]
cs cn :: Name
cn fc' :: FC
fc' ps :: [(Name, FC, PTerm)]
ps pdocs :: [(Name, Docstring (Either Err PTerm))]
pdocs pdets :: [(Name, FC)]
pdets ds :: [PDecl]
ds cname :: Maybe (Name, FC)
cname cdocs :: Docstring (Either Err PTerm)
cdocs)
= 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)
docs SyntaxInfo
s FC
fc [(Name, PTerm)]
cs ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
cn) FC
fc' [(Name, FC, PTerm)]
ps [(Name, Docstring (Either Err PTerm))]
pdocs [(Name, FC)]
pdets
((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
updateNs [(Name, SynMatch)]
ns) [PDecl]
ds)
([(Name, SynMatch)] -> Maybe (Name, FC) -> Maybe (Name, FC)
forall b. [(Name, SynMatch)] -> Maybe (Name, b) -> Maybe (Name, b)
updateRecCon [(Name, SynMatch)]
ns Maybe (Name, FC)
cname)
Docstring (Either Err PTerm)
cdocs
updateNs ns :: [(Name, SynMatch)]
ns (PImplementation docs :: Docstring (Either Err PTerm)
docs pdocs :: [(Name, Docstring (Either Err PTerm))]
pdocs s :: SyntaxInfo
s fc :: FC
fc cs :: [(Name, PTerm)]
cs pnames :: [Name]
pnames acc :: Accessibility
acc opts :: FnOpts
opts cn :: Name
cn fc' :: FC
fc' ps :: [PTerm]
ps pextra :: [(Name, PTerm)]
pextra ity :: PTerm
ity ni :: Maybe Name
ni ds :: [PDecl]
ds)
= Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> [(Name, PTerm)]
-> [Name]
-> Accessibility
-> FnOpts
-> 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
-> FnOpts
-> Name
-> FC
-> [t]
-> [(Name, t)]
-> t
-> Maybe Name
-> [PDecl' t]
-> PDecl' t
PImplementation Docstring (Either Err PTerm)
docs [(Name, Docstring (Either Err PTerm))]
pdocs SyntaxInfo
s FC
fc [(Name, PTerm)]
cs [Name]
pnames Accessibility
acc FnOpts
opts ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
cn) FC
fc'
[PTerm]
ps [(Name, PTerm)]
pextra PTerm
ity ((Name -> Name) -> Maybe Name -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns) Maybe Name
ni)
((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
updateNs [(Name, SynMatch)]
ns) [PDecl]
ds)
updateNs ns :: [(Name, SynMatch)]
ns (PMutual fc :: FC
fc ds :: [PDecl]
ds) = FC -> [PDecl] -> PDecl
forall t. FC -> [PDecl' t] -> PDecl' t
PMutual FC
fc ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
updateNs [(Name, SynMatch)]
ns) [PDecl]
ds)
updateNs ns :: [(Name, SynMatch)]
ns (PProvider docs :: Docstring (Either Err PTerm)
docs s :: SyntaxInfo
s fc :: FC
fc fc' :: FC
fc' pw :: ProvideWhat' PTerm
pw n :: Name
n)
= Docstring (Either Err PTerm)
-> SyntaxInfo -> FC -> FC -> ProvideWhat' PTerm -> Name -> PDecl
forall t.
Docstring (Either Err t)
-> SyntaxInfo -> FC -> FC -> ProvideWhat' t -> Name -> PDecl' t
PProvider Docstring (Either Err PTerm)
docs SyntaxInfo
s FC
fc FC
fc' ProvideWhat' PTerm
pw ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n)
updateNs ns :: [(Name, SynMatch)]
ns d :: PDecl
d = PDecl
d
updateRecCon :: [(Name, SynMatch)] -> Maybe (Name, b) -> Maybe (Name, b)
updateRecCon ns :: [(Name, SynMatch)]
ns Nothing = Maybe (Name, b)
forall a. Maybe a
Nothing
updateRecCon ns :: [(Name, SynMatch)]
ns (Just (n :: Name
n, fc :: b
fc)) = (Name, b) -> Maybe (Name, b)
forall a. a -> Maybe a
Just ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n, b
fc)
updateField :: [(Name, SynMatch)]
-> (Maybe (Name, b), b, c, d) -> (Maybe (Name, b), b, c, d)
updateField ns :: [(Name, SynMatch)]
ns (m :: Maybe (Name, b)
m, p :: b
p, t :: c
t, doc :: d
doc) = ([(Name, SynMatch)] -> Maybe (Name, b) -> Maybe (Name, b)
forall b. [(Name, SynMatch)] -> Maybe (Name, b) -> Maybe (Name, b)
updateRecCon [(Name, SynMatch)]
ns Maybe (Name, b)
m, b
p, c
t, d
doc)
updateClause :: [(Name, SynMatch)] -> PClause' PTerm -> PClause' PTerm
updateClause ns :: [(Name, SynMatch)]
ns (PClause fc :: FC
fc n :: Name
n t :: PTerm
t ts :: [PTerm]
ts t' :: PTerm
t' ds :: [PDecl]
ds)
= FC
-> Name -> PTerm -> [PTerm] -> PTerm -> [PDecl] -> PClause' PTerm
forall t. FC -> Name -> t -> [t] -> t -> [PDecl' t] -> PClause' t
PClause FC
fc ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n) PTerm
t [PTerm]
ts PTerm
t' ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
update [(Name, SynMatch)]
ns) [PDecl]
ds)
updateClause ns :: [(Name, SynMatch)]
ns (PWith fc :: FC
fc n :: Name
n t :: PTerm
t ts :: [PTerm]
ts t' :: PTerm
t' m :: Maybe (Name, FC)
m ds :: [PDecl]
ds)
= 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, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n) PTerm
t [PTerm]
ts PTerm
t' Maybe (Name, FC)
m ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
update [(Name, SynMatch)]
ns) [PDecl]
ds)
updateClause ns :: [(Name, SynMatch)]
ns (PClauseR fc :: FC
fc ts :: [PTerm]
ts t :: PTerm
t ds :: [PDecl]
ds)
= FC -> [PTerm] -> PTerm -> [PDecl] -> PClause' PTerm
forall t. FC -> [t] -> t -> [PDecl' t] -> PClause' t
PClauseR FC
fc [PTerm]
ts PTerm
t ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
update [(Name, SynMatch)]
ns) [PDecl]
ds)
updateClause ns :: [(Name, SynMatch)]
ns (PWithR fc :: FC
fc ts :: [PTerm]
ts t :: PTerm
t m :: Maybe (Name, FC)
m ds :: [PDecl]
ds)
= FC
-> [PTerm]
-> PTerm
-> Maybe (Name, FC)
-> [PDecl]
-> PClause' PTerm
forall t.
FC -> [t] -> t -> Maybe (Name, FC) -> [PDecl' t] -> PClause' t
PWithR FC
fc [PTerm]
ts PTerm
t Maybe (Name, FC)
m ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)] -> PDecl -> PDecl
update [(Name, SynMatch)]
ns) [PDecl]
ds)
updateData :: [(Name, SynMatch)] -> PData' t -> PData' t
updateData ns :: [(Name, SynMatch)]
ns (PDatadecl n :: Name
n fc :: FC
fc t :: t
t cs :: [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
cs)
= Name
-> FC
-> t
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
-> PData' t
forall t.
Name
-> FC
-> t
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
-> PData' t
PDatadecl ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n) FC
fc t
t (((Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])
-> (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name]))
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
-> [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
forall a b. (a -> b) -> [a] -> [b]
map ([(Name, SynMatch)]
-> (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])
-> (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])
forall a b d e f g.
[(Name, SynMatch)]
-> (a, b, Name, d, e, f, g) -> (a, b, Name, d, e, f, g)
updateCon [(Name, SynMatch)]
ns) [(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Name, FC, t, FC, [Name])]
cs)
updateData ns :: [(Name, SynMatch)]
ns (PLaterdecl n :: Name
n fc :: FC
fc t :: t
t)
= Name -> FC -> t -> PData' t
forall t. Name -> FC -> t -> PData' t
PLaterdecl ([(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
n) FC
fc t
t
updateCon :: [(Name, SynMatch)]
-> (a, b, Name, d, e, f, g) -> (a, b, Name, d, e, f, g)
updateCon ns :: [(Name, SynMatch)]
ns (cd :: a
cd, ads :: b
ads, cn :: Name
cn, fc :: d
fc, ty :: e
ty, fc' :: f
fc', fns :: g
fns)
= (a
cd, b
ads, [(Name, SynMatch)] -> Name -> Name
updateB [(Name, SynMatch)]
ns Name
cn, d
fc, e
ty, f
fc', g
fns)
ruleGroup :: [a] -> [a] -> Bool
ruleGroup [] [] = Bool
True
ruleGroup (s1 :: a
s1:_) (s2 :: a
s2:_) = a
s1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
s2
ruleGroup _ _ = Bool
False
extSymbol :: SSymbol -> IdrisParser (Maybe (Name, SynMatch))
extSymbol :: SSymbol -> IdrisParser (Maybe (Name, SynMatch))
extSymbol (Keyword n :: Name
n) = Maybe (Name, SynMatch)
forall a. Maybe a
Nothing Maybe (Name, SynMatch)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser (Maybe (Name, SynMatch))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword (Name -> String
forall a. Show a => a -> String
show Name
n)
extSymbol (Expr n :: Name
n) = do PTerm
tm <- SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn
Maybe (Name, SynMatch) -> IdrisParser (Maybe (Name, SynMatch))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Name, SynMatch) -> IdrisParser (Maybe (Name, SynMatch)))
-> Maybe (Name, SynMatch) -> IdrisParser (Maybe (Name, SynMatch))
forall a b. (a -> b) -> a -> b
$ (Name, SynMatch) -> Maybe (Name, SynMatch)
forall a. a -> Maybe a
Just (Name
n, PTerm -> SynMatch
SynTm PTerm
tm)
extSymbol (SimpleExpr n :: Name
n) = do PTerm
tm <- SyntaxInfo -> IdrisParser PTerm
simpleExpr SyntaxInfo
syn
Maybe (Name, SynMatch) -> IdrisParser (Maybe (Name, SynMatch))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Name, SynMatch) -> IdrisParser (Maybe (Name, SynMatch)))
-> Maybe (Name, SynMatch) -> IdrisParser (Maybe (Name, SynMatch))
forall a b. (a -> b) -> a -> b
$ (Name, SynMatch) -> Maybe (Name, SynMatch)
forall a. a -> Maybe a
Just (Name
n, PTerm -> SynMatch
SynTm PTerm
tm)
extSymbol (Binding n :: Name
n) = do (b :: Name
b, fc :: FC
fc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
name
Maybe (Name, SynMatch) -> IdrisParser (Maybe (Name, SynMatch))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Name, SynMatch) -> IdrisParser (Maybe (Name, SynMatch)))
-> Maybe (Name, SynMatch) -> IdrisParser (Maybe (Name, SynMatch))
forall a b. (a -> b) -> a -> b
$ (Name, SynMatch) -> Maybe (Name, SynMatch)
forall a. a -> Maybe a
Just (Name
n, FC -> Name -> SynMatch
SynBind FC
fc Name
b)
extSymbol (Symbol s :: String
s) = Maybe (Name, SynMatch)
forall a. Maybe a
Nothing Maybe (Name, SynMatch)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser (Maybe (Name, SynMatch))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ OutputAnnotation
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *) a.
(MonadState IState m, Parsing m) =>
OutputAnnotation -> m a -> m a
highlight OutputAnnotation
AnnKeyword (String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
symbol String
s)
syntaxDecl :: SyntaxInfo -> IdrisParser PDecl
syntaxDecl :: SyntaxInfo -> IdrisParser PDecl
syntaxDecl syn :: SyntaxInfo
syn = do (s :: Syntax
s, fc :: FC
fc) <- StateT IState (WriterT FC (Parsec Void String)) Syntax
-> StateT IState (WriterT FC (Parsec Void String)) (Syntax, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (StateT IState (WriterT FC (Parsec Void String)) Syntax
-> StateT IState (WriterT FC (Parsec Void String)) (Syntax, FC))
-> StateT IState (WriterT FC (Parsec Void String)) Syntax
-> StateT IState (WriterT FC (Parsec Void String)) (Syntax, FC)
forall a b. (a -> b) -> a -> b
$ SyntaxInfo
-> StateT IState (WriterT FC (Parsec Void String)) Syntax
syntaxRule SyntaxInfo
syn
(IState -> IState)
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IState -> IState)
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> (IState -> IState)
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ \i :: IState
i -> IState
i IState -> Syntax -> IState
`addSyntax` Syntax
s
PDecl -> IdrisParser PDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> Syntax -> PDecl
forall t. FC -> Syntax -> PDecl' t
PSyntax FC
fc Syntax
s)
addSyntax :: IState -> Syntax -> IState
addSyntax :: IState -> Syntax -> IState
addSyntax i :: IState
i s :: Syntax
s = IState
i { syntax_rules :: SyntaxRules
syntax_rules = [Syntax] -> SyntaxRules -> SyntaxRules
updateSyntaxRules [Syntax
s] SyntaxRules
rs,
syntax_keywords :: [String]
syntax_keywords = [String]
ks [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ns,
ibc_write :: [IBCWrite]
ibc_write = Syntax -> IBCWrite
IBCSyntax Syntax
s IBCWrite -> [IBCWrite] -> [IBCWrite]
forall a. a -> [a] -> [a]
: (String -> IBCWrite) -> [String] -> [IBCWrite]
forall a b. (a -> b) -> [a] -> [b]
map String -> IBCWrite
IBCKeyword [String]
ks [IBCWrite] -> [IBCWrite] -> [IBCWrite]
forall a. [a] -> [a] -> [a]
++ [IBCWrite]
ibc }
where rs :: SyntaxRules
rs = IState -> SyntaxRules
syntax_rules IState
i
ns :: [String]
ns = IState -> [String]
syntax_keywords IState
i
ibc :: [IBCWrite]
ibc = IState -> [IBCWrite]
ibc_write IState
i
ks :: [String]
ks = (Name -> String) -> [Name] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Name -> String
forall a. Show a => a -> String
show (Syntax -> [Name]
syntaxNames Syntax
s)
addReplSyntax :: IState -> Syntax -> IState
addReplSyntax :: IState -> Syntax -> IState
addReplSyntax i :: IState
i s :: Syntax
s = IState
i { syntax_rules :: SyntaxRules
syntax_rules = [Syntax] -> SyntaxRules -> SyntaxRules
updateSyntaxRules [Syntax
s] SyntaxRules
rs,
syntax_keywords :: [String]
syntax_keywords = [String]
ks [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ns }
where rs :: SyntaxRules
rs = IState -> SyntaxRules
syntax_rules IState
i
ns :: [String]
ns = IState -> [String]
syntax_keywords IState
i
ks :: [String]
ks = (Name -> String) -> [Name] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Name -> String
forall a. Show a => a -> String
show (Syntax -> [Name]
syntaxNames Syntax
s)
syntaxRule :: SyntaxInfo -> IdrisParser Syntax
syntaxRule :: SyntaxInfo
-> StateT IState (WriterT FC (Parsec Void String)) Syntax
syntaxRule syn :: SyntaxInfo
syn
= do SynContext
sty <- StateT IState (WriterT FC (Parsec Void String)) SynContext
-> StateT IState (WriterT FC (Parsec Void String)) SynContext
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do
StateT IState (WriterT FC (Parsec Void String)) ()
pushIndent
SynContext
sty <- SynContext
-> StateT IState (WriterT FC (Parsec Void String)) SynContext
-> StateT IState (WriterT FC (Parsec Void String)) SynContext
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option SynContext
AnySyntax
(SynContext
TermSyntax SynContext
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) SynContext
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "term"
StateT IState (WriterT FC (Parsec Void String)) SynContext
-> StateT IState (WriterT FC (Parsec Void String)) SynContext
-> StateT IState (WriterT FC (Parsec Void String)) SynContext
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SynContext
PatternSyntax SynContext
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) SynContext
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "pattern")
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "syntax"
SynContext
-> StateT IState (WriterT FC (Parsec Void String)) SynContext
forall (m :: * -> *) a. Monad m => a -> m a
return SynContext
sty)
[SSymbol]
syms <- StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) [SSymbol]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some StateT IState (WriterT FC (Parsec Void String)) SSymbol
syntaxSym
Bool
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((SSymbol -> Bool) -> [SSymbol] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SSymbol -> Bool
isExpr [SSymbol]
syms) (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ ErrorItem Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
P.unexpected (ErrorItem Char
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> (String -> ErrorItem Char)
-> String
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
P.Label (NonEmpty Char -> ErrorItem Char)
-> (String -> NonEmpty Char) -> String -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NonEmpty.fromList (String -> StateT IState (WriterT FC (Parsec Void String)) ())
-> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ "missing keywords in syntax rule"
let ns :: [Name]
ns = (SSymbol -> Maybe Name) -> [SSymbol] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SSymbol -> Maybe Name
getName [SSymbol]
syms
Bool
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub [Name]
ns))
(StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ ErrorItem Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
P.unexpected (ErrorItem Char
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> (String -> ErrorItem Char)
-> String
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
P.Label (NonEmpty Char -> ErrorItem Char)
-> (String -> NonEmpty Char) -> String -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NonEmpty.fromList (String -> StateT IState (WriterT FC (Parsec Void String)) ())
-> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ "repeated variable in syntax rule"
Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '='
PTerm
tm <- SyntaxInfo -> IdrisParser PTerm
typeExpr (SyntaxInfo -> SyntaxInfo
allowImp SyntaxInfo
syn) IdrisParser PTerm
-> (PTerm -> IdrisParser PTerm) -> IdrisParser PTerm
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Name] -> PTerm -> IdrisParser PTerm
uniquifyBinders [Name
n | Binding n :: Name
n <- [SSymbol]
syms]
StateT IState (WriterT FC (Parsec Void String)) ()
terminator
Syntax -> StateT IState (WriterT FC (Parsec Void String)) Syntax
forall (m :: * -> *) a. Monad m => a -> m a
return ([SSymbol] -> PTerm -> SynContext -> Syntax
Rule ([SSymbol] -> [SSymbol]
mkSimple [SSymbol]
syms) PTerm
tm SynContext
sty)
StateT IState (WriterT FC (Parsec Void String)) Syntax
-> StateT IState (WriterT FC (Parsec Void String)) Syntax
-> StateT IState (WriterT FC (Parsec Void String)) Syntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "decl"; String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "syntax"
[SSymbol]
syms <- StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) [SSymbol]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some StateT IState (WriterT FC (Parsec Void String)) SSymbol
syntaxSym
Bool
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((SSymbol -> Bool) -> [SSymbol] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SSymbol -> Bool
isExpr [SSymbol]
syms) (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ ErrorItem Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
P.unexpected (ErrorItem Char
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> (String -> ErrorItem Char)
-> String
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
P.Label (NonEmpty Char -> ErrorItem Char)
-> (String -> NonEmpty Char) -> String -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NonEmpty.fromList (String -> StateT IState (WriterT FC (Parsec Void String)) ())
-> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ "missing keywords in syntax rule"
let ns :: [Name]
ns = (SSymbol -> Maybe Name) -> [SSymbol] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SSymbol -> Maybe Name
getName [SSymbol]
syms
Bool
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub [Name]
ns))
(StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ ErrorItem Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
P.unexpected (ErrorItem Char
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> (String -> ErrorItem Char)
-> String
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
P.Label (NonEmpty Char -> ErrorItem Char)
-> (String -> NonEmpty Char) -> String -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NonEmpty.fromList (String -> StateT IState (WriterT FC (Parsec Void String)) ())
-> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ "repeated variable in syntax rule"
Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '='
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
[[PDecl]]
dec <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (SyntaxInfo -> IdrisParser [PDecl]
decl SyntaxInfo
syn)
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
Syntax -> StateT IState (WriterT FC (Parsec Void String)) Syntax
forall (m :: * -> *) a. Monad m => a -> m a
return ([SSymbol] -> [PDecl] -> Syntax
DeclRule ([SSymbol] -> [SSymbol]
mkSimple [SSymbol]
syms) ([[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
dec))
where
isExpr :: SSymbol -> Bool
isExpr (Expr _) = Bool
True
isExpr _ = Bool
False
getName :: SSymbol -> Maybe Name
getName (Expr n :: Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
getName _ = Maybe Name
forall a. Maybe a
Nothing
mkSimple :: [SSymbol] -> [SSymbol]
mkSimple (Expr e :: Name
e : es :: [SSymbol]
es) = Name -> SSymbol
SimpleExpr Name
e SSymbol -> [SSymbol] -> [SSymbol]
forall a. a -> [a] -> [a]
: [SSymbol] -> [SSymbol]
mkSimple' [SSymbol]
es
mkSimple xs :: [SSymbol]
xs = [SSymbol] -> [SSymbol]
mkSimple' [SSymbol]
xs
mkSimple' :: [SSymbol] -> [SSymbol]
mkSimple' (Expr e :: Name
e : Expr e1 :: Name
e1 : es :: [SSymbol]
es) = Name -> SSymbol
SimpleExpr Name
e SSymbol -> [SSymbol] -> [SSymbol]
forall a. a -> [a] -> [a]
: Name -> SSymbol
SimpleExpr Name
e1 SSymbol -> [SSymbol] -> [SSymbol]
forall a. a -> [a] -> [a]
:
[SSymbol] -> [SSymbol]
mkSimple [SSymbol]
es
mkSimple' (Expr e :: Name
e : Symbol s :: String
s : es :: [SSymbol]
es)
| (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
opChars) String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "" = Name -> SSymbol
SimpleExpr Name
e SSymbol -> [SSymbol] -> [SSymbol]
forall a. a -> [a] -> [a]
: String -> SSymbol
Symbol String
s SSymbol -> [SSymbol] -> [SSymbol]
forall a. a -> [a] -> [a]
: [SSymbol] -> [SSymbol]
mkSimple' [SSymbol]
es
where ts :: String
ts = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
s
mkSimple' (e :: SSymbol
e : es :: [SSymbol]
es) = SSymbol
e SSymbol -> [SSymbol] -> [SSymbol]
forall a. a -> [a] -> [a]
: [SSymbol] -> [SSymbol]
mkSimple' [SSymbol]
es
mkSimple' [] = []
uniquifyBinders :: [Name] -> PTerm -> IdrisParser PTerm
uniquifyBinders :: [Name] -> PTerm -> IdrisParser PTerm
uniquifyBinders userNames :: [Name]
userNames = Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 []
where
fixBind :: Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind :: Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 rens :: [(Name, Name)]
rens (PRef fc :: FC
fc hls :: [FC]
hls n :: Name
n) | Just n' :: Name
n' <- Name -> [(Name, Name)] -> Maybe Name
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, Name)]
rens =
PTerm -> IdrisParser PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> IdrisParser PTerm) -> PTerm -> IdrisParser PTerm
forall a b. (a -> b) -> a -> b
$ FC -> [FC] -> Name -> PTerm
PRef FC
fc [FC]
hls Name
n'
fixBind 0 rens :: [(Name, Name)]
rens (PPatvar fc :: FC
fc n :: Name
n) | Just n' :: Name
n' <- Name -> [(Name, Name)] -> Maybe Name
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, Name)]
rens =
PTerm -> IdrisParser PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> IdrisParser PTerm) -> PTerm -> IdrisParser PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PPatvar FC
fc Name
n'
fixBind 0 rens :: [(Name, Name)]
rens (PLam fc :: FC
fc n :: Name
n nfc :: FC
nfc ty :: PTerm
ty body :: PTerm
body)
| Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
userNames = (PTerm -> PTerm -> PTerm)
-> IdrisParser PTerm -> IdrisParser PTerm -> IdrisParser PTerm
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
n FC
nfc)
(Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
ty)
(Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
body)
| Bool
otherwise =
do PTerm
ty' <- Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
ty
Name
n' <- Name -> StateT IState (WriterT FC (Parsec Void String)) Name
gensym Name
n
PTerm
body' <- Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 ((Name
n,Name
n')(Name, Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. a -> [a] -> [a]
:[(Name, Name)]
rens) PTerm
body
PTerm -> IdrisParser PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> IdrisParser PTerm) -> PTerm -> IdrisParser PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> FC -> PTerm -> PTerm -> PTerm
PLam FC
fc Name
n' FC
nfc PTerm
ty' PTerm
body'
fixBind 0 rens :: [(Name, Name)]
rens (PPi plic :: Plicity
plic n :: Name
n nfc :: FC
nfc argTy :: PTerm
argTy body :: PTerm
body)
| Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
userNames = (PTerm -> PTerm -> PTerm)
-> IdrisParser PTerm -> IdrisParser PTerm -> IdrisParser PTerm
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
plic Name
n FC
nfc)
(Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
argTy)
(Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
body)
| Bool
otherwise =
do PTerm
ty' <- Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
argTy
Name
n' <- Name -> StateT IState (WriterT FC (Parsec Void String)) Name
gensym Name
n
PTerm
body' <- Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 ((Name
n,Name
n')(Name, Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. a -> [a] -> [a]
:[(Name, Name)]
rens) PTerm
body
PTerm -> IdrisParser PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> IdrisParser PTerm) -> PTerm -> IdrisParser PTerm
forall a b. (a -> b) -> a -> b
$ (Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
plic Name
n' FC
nfc PTerm
ty' PTerm
body')
fixBind 0 rens :: [(Name, Name)]
rens (PLet fc :: FC
fc rig :: RigCount
rig n :: Name
n nfc :: FC
nfc ty :: PTerm
ty val :: PTerm
val body :: PTerm
body)
| Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
userNames = (PTerm -> PTerm -> PTerm -> PTerm)
-> IdrisParser PTerm
-> IdrisParser PTerm
-> IdrisParser PTerm
-> IdrisParser PTerm
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rig Name
n FC
nfc)
(Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
ty)
(Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
val)
(Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
body)
| Bool
otherwise =
do PTerm
ty' <- Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
ty
PTerm
val' <- Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 [(Name, Name)]
rens PTerm
val
Name
n' <- Name -> StateT IState (WriterT FC (Parsec Void String)) Name
gensym Name
n
PTerm
body' <- Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind 0 ((Name
n,Name
n')(Name, Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. a -> [a] -> [a]
:[(Name, Name)]
rens) PTerm
body
PTerm -> IdrisParser PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> IdrisParser PTerm) -> PTerm -> IdrisParser PTerm
forall a b. (a -> b) -> a -> b
$ FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
rig Name
n' FC
nfc PTerm
ty' PTerm
val' PTerm
body'
fixBind 0 rens :: [(Name, Name)]
rens (PMatchApp fc :: FC
fc n :: Name
n) | Just n' :: Name
n' <- Name -> [(Name, Name)] -> Maybe Name
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, Name)]
rens =
PTerm -> IdrisParser PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> IdrisParser PTerm) -> PTerm -> IdrisParser PTerm
forall a b. (a -> b) -> a -> b
$ FC -> Name -> PTerm
PMatchApp FC
fc Name
n'
fixBind 0 rens :: [(Name, Name)]
rens (PQuoteName n :: Name
n True fc :: FC
fc) | Just n' :: Name
n' <- Name -> [(Name, Name)] -> Maybe Name
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, Name)]
rens =
PTerm -> IdrisParser PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm -> IdrisParser PTerm) -> PTerm -> IdrisParser PTerm
forall a b. (a -> b) -> a -> b
$ Name -> Bool -> FC -> PTerm
PQuoteName Name
n' Bool
True FC
fc
fixBind q :: Int
q rens :: [(Name, Name)]
rens (PQuasiquote tm :: PTerm
tm goal :: Maybe PTerm
goal) =
(PTerm -> Maybe PTerm -> PTerm) -> Maybe PTerm -> PTerm -> PTerm
forall a b c. (a -> b -> c) -> b -> a -> c
flip PTerm -> Maybe PTerm -> PTerm
PQuasiquote Maybe PTerm
goal (PTerm -> PTerm) -> IdrisParser PTerm -> IdrisParser PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [(Name, Name)]
rens PTerm
tm
fixBind q :: Int
q rens :: [(Name, Name)]
rens (PUnquote tm :: PTerm
tm) =
PTerm -> PTerm
PUnquote (PTerm -> PTerm) -> IdrisParser PTerm -> IdrisParser PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [(Name, Name)]
rens PTerm
tm
fixBind q :: Int
q rens :: [(Name, Name)]
rens x :: PTerm
x = (PTerm -> IdrisParser PTerm) -> PTerm -> IdrisParser PTerm
forall on (m :: * -> *).
(Uniplate on, Monad m) =>
(on -> m on) -> on -> m on
descendM (Int -> [(Name, Name)] -> PTerm -> IdrisParser PTerm
fixBind Int
q [(Name, Name)]
rens) PTerm
x
gensym :: Name -> IdrisParser Name
gensym :: Name -> StateT IState (WriterT FC (Parsec Void String)) Name
gensym n :: Name
n = do IState
ist <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
let idx :: Int
idx = IState -> Int
idris_name IState
ist
IState -> StateT IState (WriterT FC (Parsec Void String)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put IState
ist { idris_name :: Int
idris_name = Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 }
Name -> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> StateT IState (WriterT FC (Parsec Void String)) Name)
-> Name -> StateT IState (WriterT FC (Parsec Void String)) Name
forall a b. (a -> b) -> a -> b
$ Int -> String -> Name
sMN Int
idx (Name -> String
forall a. Show a => a -> String
show Name
n)
syntaxSym :: IdrisParser SSymbol
syntaxSym :: StateT IState (WriterT FC (Parsec Void String)) SSymbol
syntaxSym = StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '['; Name
n <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
name; Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ']'
SSymbol -> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> SSymbol
Expr Name
n))
StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '{'; Name
n <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
name; Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '}'
SSymbol -> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> SSymbol
Binding Name
n))
StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do Name
n <- [String] -> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). Parsing m => [String] -> m Name
iName []
SSymbol -> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> SSymbol
Keyword Name
n)
StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do String
sym <- StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
stringLiteral
SSymbol -> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SSymbol
Symbol String
sym)
StateT IState (WriterT FC (Parsec Void String)) SSymbol
-> String
-> StateT IState (WriterT FC (Parsec Void String)) SSymbol
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "syntax symbol"
fnDecl :: SyntaxInfo -> IdrisParser [PDecl]
fnDecl :: SyntaxInfo -> IdrisParser [PDecl]
fnDecl syn :: SyntaxInfo
syn = IdrisParser [PDecl] -> IdrisParser [PDecl]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do StateT IState (WriterT FC (Parsec Void String)) ()
notEndBlock
PDecl
d <- SyntaxInfo -> IdrisParser PDecl
fnDecl' SyntaxInfo
syn
IState
i <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
let d' :: PDecl
d' = (PTerm -> PTerm) -> PDecl -> PDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SyntaxInfo -> PTerm -> PTerm
debindApp SyntaxInfo
syn (PTerm -> PTerm) -> (PTerm -> PTerm) -> PTerm -> PTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxInfo -> IState -> PTerm -> PTerm
desugar SyntaxInfo
syn IState
i) PDecl
d
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [PDecl
d']) IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "function declaration"
fnDecl' :: SyntaxInfo -> IdrisParser PDecl
fnDecl' :: SyntaxInfo -> IdrisParser PDecl
fnDecl' syn :: SyntaxInfo
syn = (IdrisParser PDecl -> IdrisParser PDecl
checkDeclFixity (IdrisParser PDecl -> IdrisParser PDecl)
-> IdrisParser PDecl -> IdrisParser PDecl
forall a b. (a -> b) -> a -> b
$
do (doc :: Docstring (Either Err PTerm)
doc, argDocs :: [(Name, Docstring (Either Err PTerm))]
argDocs, fc :: FC
fc, opts' :: FnOpts
opts', n :: Name
n, nfc :: FC
nfc, acc :: Accessibility
acc) <- StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], FC, FnOpts, Name, FC,
Accessibility)
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], FC, FnOpts, Name, FC,
Accessibility)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do
StateT IState (WriterT FC (Parsec Void String)) ()
pushIndent
(doc :: Docstring (Either Err PTerm)
doc, argDocs :: [(Name, Docstring (Either Err PTerm))]
argDocs) <- SyntaxInfo
-> IdrisParser
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
docstring SyntaxInfo
syn
(opts :: FnOpts
opts, acc :: Accessibility
acc) <- IdrisParser (FnOpts, Accessibility)
fnOpts
(n_in :: Name
n_in, nfc :: FC
nfc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
let n :: Name
n = SyntaxInfo -> Name -> Name
expandNS SyntaxInfo
syn Name
n_in
FC
fc <- StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a. MonadWriter FC m => m a -> m FC
extent (StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) FC)
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall a b. (a -> b) -> a -> b
$ Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ':'
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], FC, FnOpts, Name, FC,
Accessibility)
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], FC, FnOpts, Name, FC,
Accessibility)
forall (m :: * -> *) a. Monad m => a -> m a
return (Docstring (Either Err PTerm)
doc, [(Name, Docstring (Either Err PTerm))]
argDocs, FC
fc, FnOpts
opts, Name
n, FC
nfc, Accessibility
acc))
PTerm
ty <- SyntaxInfo -> IdrisParser PTerm
typeExpr (SyntaxInfo -> SyntaxInfo
allowImp SyntaxInfo
syn)
StateT IState (WriterT FC (Parsec Void String)) ()
terminator
Bool
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SyntaxInfo -> Bool
syn_toplevel SyntaxInfo
syn) (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ Name
-> Accessibility
-> StateT IState (WriterT FC (Parsec Void String)) ()
addAcc Name
n Accessibility
acc
PDecl -> IdrisParser PDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> FnOpts
-> Name
-> FC
-> PTerm
-> PDecl
forall t.
Docstring (Either Err t)
-> [(Name, Docstring (Either Err t))]
-> SyntaxInfo
-> FC
-> FnOpts
-> Name
-> FC
-> t
-> PDecl' t
PTy Docstring (Either Err PTerm)
doc [(Name, Docstring (Either Err PTerm))]
argDocs SyntaxInfo
syn FC
fc FnOpts
opts' Name
n FC
nfc PTerm
ty)
IdrisParser PDecl -> IdrisParser PDecl -> IdrisParser PDecl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser PDecl
postulate SyntaxInfo
syn
IdrisParser PDecl -> IdrisParser PDecl -> IdrisParser PDecl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser PDecl
caf SyntaxInfo
syn
IdrisParser PDecl -> IdrisParser PDecl -> IdrisParser PDecl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser PDecl
pattern SyntaxInfo
syn)
IdrisParser PDecl -> String -> IdrisParser PDecl
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "function declaration"
fnOpts :: IdrisParser ([FnOpt], Accessibility)
fnOpts :: IdrisParser (FnOpts, Accessibility)
fnOpts = do
FnOpts
opts <- StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpts
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT IState (WriterT FC (Parsec Void String)) FnOpt
fnOpt
Accessibility
acc <- IdrisParser Accessibility
accessibility
FnOpts
opts' <- StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpts
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT IState (WriterT FC (Parsec Void String)) FnOpt
fnOpt
let allOpts :: FnOpts
allOpts = FnOpts
opts FnOpts -> FnOpts -> FnOpts
forall a. [a] -> [a] -> [a]
++ FnOpts
opts'
let existingTotality :: FnOpts
existingTotality = FnOpts
allOpts FnOpts -> FnOpts -> FnOpts
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [FnOpt
TotalFn, FnOpt
CoveringFn, FnOpt
PartialFn]
FnOpts
opts'' <- FnOpts
-> FnOpts -> StateT IState (WriterT FC (Parsec Void String)) FnOpts
forall (m :: * -> *).
(MonadState IState m, MonadFail m) =>
FnOpts -> FnOpts -> m FnOpts
addDefaultTotality (FnOpts -> FnOpts
forall a. Eq a => [a] -> [a]
nub FnOpts
existingTotality) FnOpts
allOpts
(FnOpts, Accessibility) -> IdrisParser (FnOpts, Accessibility)
forall (m :: * -> *) a. Monad m => a -> m a
return (FnOpts
opts'', Accessibility
acc)
where prettyTot :: FnOpt -> String
prettyTot TotalFn = "total"
prettyTot PartialFn = "partial"
prettyTot CoveringFn = "covering"
addDefaultTotality :: FnOpts -> FnOpts -> m FnOpts
addDefaultTotality [] opts :: FnOpts
opts = do
IState
ist <- m IState
forall s (m :: * -> *). MonadState s m => m s
get
case IState -> DefaultTotality
default_total IState
ist of
DefaultCheckingTotal -> FnOpts -> m FnOpts
forall (m :: * -> *) a. Monad m => a -> m a
return (FnOpt
TotalFnFnOpt -> FnOpts -> FnOpts
forall a. a -> [a] -> [a]
:FnOpts
opts)
DefaultCheckingCovering -> FnOpts -> m FnOpts
forall (m :: * -> *) a. Monad m => a -> m a
return (FnOpt
CoveringFnFnOpt -> FnOpts -> FnOpts
forall a. a -> [a] -> [a]
:FnOpts
opts)
DefaultCheckingPartial -> FnOpts -> m FnOpts
forall (m :: * -> *) a. Monad m => a -> m a
return FnOpts
opts
addDefaultTotality [tot :: FnOpt
tot] opts :: FnOpts
opts = FnOpts -> m FnOpts
forall (m :: * -> *) a. Monad m => a -> m a
return FnOpts
opts
addDefaultTotality (tot1 :: FnOpt
tot1:tot2 :: FnOpt
tot2:tots :: FnOpts
tots) opts :: FnOpts
opts =
String -> m FnOpts
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Conflicting totality modifiers specified " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FnOpt -> String
prettyTot FnOpt
tot1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ " and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FnOpt -> String
prettyTot FnOpt
tot2)
fnOpt :: IdrisParser FnOpt
fnOpt :: StateT IState (WriterT FC (Parsec Void String)) FnOpt
fnOpt = do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "total"; FnOpt -> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (m :: * -> *) a. Monad m => a -> m a
return FnOpt
TotalFn
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
PartialFn FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "partial"
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
CoveringFn FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "covering"
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "export"); String
c <- StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
stringLiteral;
FnOpt -> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (m :: * -> *) a. Monad m => a -> m a
return (FnOpt -> StateT IState (WriterT FC (Parsec Void String)) FnOpt)
-> FnOpt -> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall a b. (a -> b) -> a -> b
$ String -> FnOpt
CExport String
c
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
NoImplicit FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "no_implicit")
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
Inlinable FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "inline")
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
StaticFn FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "static")
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
ErrorHandler FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "error_handler")
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
ErrorReverse FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "error_reverse")
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
ErrorReduce FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "error_reduce")
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
Reflection FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "reflection")
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
AutoHint FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "hint")
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
OverlappingDictionary FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "overlapping")
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%'; String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "specialise";
Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '['; [(Name, Maybe Int)]
ns <- StateT IState (WriterT FC (Parsec Void String)) (Name, Maybe Int)
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT
IState (WriterT FC (Parsec Void String)) [(Name, Maybe Int)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy StateT IState (WriterT FC (Parsec Void String)) (Name, Maybe Int)
nameTimes (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ','); Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ']';
FnOpt -> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (m :: * -> *) a. Monad m => a -> m a
return (FnOpt -> StateT IState (WriterT FC (Parsec Void String)) FnOpt)
-> FnOpt -> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall a b. (a -> b) -> a -> b
$ [(Name, Maybe Int)] -> FnOpt
Specialise [(Name, Maybe Int)]
ns
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FnOpt
Implicit FnOpt
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "implicit"
StateT IState (WriterT FC (Parsec Void String)) FnOpt
-> String -> StateT IState (WriterT FC (Parsec Void String)) FnOpt
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "function modifier"
where nameTimes :: IdrisParser (Name, Maybe Int)
nameTimes :: StateT IState (WriterT FC (Parsec Void String)) (Name, Maybe Int)
nameTimes = do Name
n <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
Maybe Int
t <- Maybe Int
-> StateT IState (WriterT FC (Parsec Void String)) (Maybe Int)
-> StateT IState (WriterT FC (Parsec Void String)) (Maybe Int)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Maybe Int
forall a. Maybe a
Nothing (do Integer
reds <- StateT IState (WriterT FC (Parsec Void String)) Integer
forall (m :: * -> *). Parsing m => m Integer
natural
Maybe Int
-> StateT IState (WriterT FC (Parsec Void String)) (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
reds)))
(Name, Maybe Int)
-> StateT
IState (WriterT FC (Parsec Void String)) (Name, Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Maybe Int
t)
postulate :: SyntaxInfo -> IdrisParser PDecl
postulate :: SyntaxInfo -> IdrisParser PDecl
postulate syn :: SyntaxInfo
syn = do (doc :: Docstring (Either Err PTerm)
doc, ext :: Bool
ext)
<- StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm), Bool)
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm), Bool)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm), Bool)
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm), Bool))
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm), Bool)
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm), Bool)
forall a b. (a -> b) -> a -> b
$ do (doc :: Docstring (Either Err PTerm)
doc, _) <- SyntaxInfo
-> IdrisParser
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
docstring SyntaxInfo
syn
StateT IState (WriterT FC (Parsec Void String)) ()
pushIndent
Bool
ext <- StateT IState (WriterT FC (Parsec Void String)) Bool
ppostDecl
(Docstring (Either Err PTerm), Bool)
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm), Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Docstring (Either Err PTerm)
doc, Bool
ext)
IState
ist <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
(opts :: FnOpts
opts, acc :: Accessibility
acc) <- IdrisParser (FnOpts, Accessibility)
fnOpts
(n_in :: Name
n_in, nfc :: FC
nfc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
let n :: Name
n = SyntaxInfo -> Name -> Name
expandNS SyntaxInfo
syn Name
n_in
Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ':'
PTerm
ty <- SyntaxInfo -> IdrisParser PTerm
typeExpr (SyntaxInfo -> SyntaxInfo
allowImp SyntaxInfo
syn)
FC
fc <- StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a. MonadWriter FC m => m a -> m FC
extent (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall a b. (a -> b) -> a -> b
$ StateT IState (WriterT FC (Parsec Void String)) ()
terminator
Name
-> Accessibility
-> StateT IState (WriterT FC (Parsec Void String)) ()
addAcc Name
n Accessibility
acc
PDecl -> IdrisParser PDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
-> Docstring (Either Err PTerm)
-> SyntaxInfo
-> FC
-> FC
-> FnOpts
-> Name
-> PTerm
-> PDecl
forall t.
Bool
-> Docstring (Either Err t)
-> SyntaxInfo
-> FC
-> FC
-> FnOpts
-> Name
-> t
-> PDecl' t
PPostulate Bool
ext Docstring (Either Err PTerm)
doc SyntaxInfo
syn FC
fc FC
nfc FnOpts
opts Name
n PTerm
ty)
IdrisParser PDecl -> String -> IdrisParser PDecl
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "postulate"
where ppostDecl :: StateT IState (WriterT FC (Parsec Void String)) Bool
ppostDecl = do ()
fc <- String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "postulate"; Bool -> StateT IState (WriterT FC (Parsec Void String)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
StateT IState (WriterT FC (Parsec Void String)) Bool
-> StateT IState (WriterT FC (Parsec Void String)) Bool
-> StateT IState (WriterT FC (Parsec Void String)) Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%'; String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "extern"; Bool -> StateT IState (WriterT FC (Parsec Void String)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
using_ :: SyntaxInfo -> IdrisParser [PDecl]
using_ :: SyntaxInfo -> IdrisParser [PDecl]
using_ syn :: SyntaxInfo
syn =
do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "using"
Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '('; [Using]
ns <- SyntaxInfo -> IdrisParser [Using]
usingDeclList SyntaxInfo
syn; Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ')'
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
let uvars :: [Using]
uvars = SyntaxInfo -> [Using]
using SyntaxInfo
syn
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (SyntaxInfo -> IdrisParser [PDecl]
decl (SyntaxInfo
syn { using :: [Using]
using = [Using]
uvars [Using] -> [Using] -> [Using]
forall a. [a] -> [a] -> [a]
++ [Using]
ns }))
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds)
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "using declaration"
params :: SyntaxInfo -> IdrisParser [PDecl]
params :: SyntaxInfo -> IdrisParser [PDecl]
params syn :: SyntaxInfo
syn =
do (ns :: [(RigCount, Name, FC, PTerm)]
ns, fc :: FC
fc) <- StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
-> StateT
IState
(WriterT FC (Parsec Void String))
([(RigCount, Name, FC, PTerm)], FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
-> StateT
IState
(WriterT FC (Parsec Void String))
([(RigCount, Name, FC, PTerm)], FC))
-> StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
-> StateT
IState
(WriterT FC (Parsec Void String))
([(RigCount, Name, FC, PTerm)], FC)
forall a b. (a -> b) -> a -> b
$ do
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "parameters"
Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '(' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
-> StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SyntaxInfo
-> StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
typeDeclList SyntaxInfo
syn StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ')'
let ns' :: [(Name, PTerm)]
ns' = [(Name
n, PTerm
ty) | (_, n :: Name
n, _, ty :: PTerm
ty) <- [(RigCount, Name, FC, PTerm)]
ns]
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
let pvars :: [(Name, PTerm)]
pvars = SyntaxInfo -> [(Name, PTerm)]
syn_params SyntaxInfo
syn
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (SyntaxInfo -> IdrisParser [PDecl]
decl SyntaxInfo
syn { syn_params :: [(Name, PTerm)]
syn_params = [(Name, PTerm)]
pvars [(Name, PTerm)] -> [(Name, PTerm)] -> [(Name, PTerm)]
forall a. [a] -> [a] -> [a]
++ [(Name, PTerm)]
ns' })
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [FC -> [(Name, PTerm)] -> [PDecl] -> PDecl
forall t. FC -> [(Name, t)] -> [PDecl' t] -> PDecl' t
PParams FC
fc [(Name, PTerm)]
ns' ([[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds)]
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "parameters declaration"
openInterface :: SyntaxInfo -> IdrisParser [PDecl]
openInterface :: SyntaxInfo -> IdrisParser [PDecl]
openInterface syn :: SyntaxInfo
syn =
do (ns :: [(Name, FC)]
ns, fc :: FC
fc) <- StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
-> StateT
IState (WriterT FC (Parsec Void String)) ([(Name, FC)], FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
-> StateT
IState (WriterT FC (Parsec Void String)) ([(Name, FC)], FC))
-> StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
-> StateT
IState (WriterT FC (Parsec Void String)) ([(Name, FC)], FC)
forall a b. (a -> b) -> a -> b
$ do
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "using"
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "implementation"
StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 (StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName) (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ',')
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (SyntaxInfo -> IdrisParser [PDecl]
decl SyntaxInfo
syn)
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [FC -> [Name] -> [PDecl] -> PDecl
forall t. FC -> [Name] -> [PDecl' t] -> PDecl' t
POpenInterfaces FC
fc (((Name, FC) -> Name) -> [(Name, FC)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, FC) -> Name
forall a b. (a, b) -> a
fst [(Name, FC)]
ns) ([[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds)]
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "open interface declaration"
mutual :: SyntaxInfo -> IdrisParser [PDecl]
mutual :: SyntaxInfo -> IdrisParser [PDecl]
mutual syn :: SyntaxInfo
syn =
do FC
fc <- StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a. MonadWriter FC m => m a -> m FC
extent (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall a b. (a -> b) -> a -> b
$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "mutual"
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (SyntaxInfo -> IdrisParser [PDecl]
decl (SyntaxInfo
syn { mut_nesting :: Int
mut_nesting = SyntaxInfo -> Int
mut_nesting SyntaxInfo
syn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 } ))
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [FC -> [PDecl] -> PDecl
forall t. FC -> [PDecl' t] -> PDecl' t
PMutual FC
fc ([[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds)]
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "mutual block"
namespace :: SyntaxInfo -> IdrisParser [PDecl]
namespace :: SyntaxInfo -> IdrisParser [PDecl]
namespace syn :: SyntaxInfo
syn =
do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "namespace"
(n :: String
n, nfc :: FC
nfc) <- StateT IState (WriterT FC (Parsec Void String)) String
-> StateT IState (WriterT FC (Parsec Void String)) (String, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
identifier
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (SyntaxInfo -> IdrisParser [PDecl]
decl SyntaxInfo
syn { syn_namespace :: [String]
syn_namespace = String
n String -> [String] -> [String]
forall a. a -> [a] -> [a]
: SyntaxInfo -> [String]
syn_namespace SyntaxInfo
syn })
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> FC -> [PDecl] -> PDecl
forall t. String -> FC -> [PDecl' t] -> PDecl' t
PNamespace String
n FC
nfc ([[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds)]
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "namespace declaration"
implementationBlock :: SyntaxInfo -> IdrisParser [PDecl]
implementationBlock :: SyntaxInfo -> IdrisParser [PDecl]
implementationBlock syn :: SyntaxInfo
syn = do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "where"
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (SyntaxInfo -> IdrisParser [PDecl]
fnDecl SyntaxInfo
syn)
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds)
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "implementation block"
interfaceBlock :: SyntaxInfo -> IdrisParser (Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
interfaceBlock :: SyntaxInfo
-> IdrisParser
(Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
interfaceBlock syn :: SyntaxInfo
syn = do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "where"
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
(cn :: Maybe (Name, FC)
cn, cd :: Docstring ()
cd) <- (Maybe (Name, FC), Docstring ())
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Name, FC), Docstring ())
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Name, FC), Docstring ())
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option (Maybe (Name, FC)
forall a. Maybe a
Nothing, Docstring ()
forall a. Docstring a
emptyDocstring) (StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Name, FC), Docstring ())
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Name, FC), Docstring ()))
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Name, FC), Docstring ())
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Name, FC), Docstring ())
forall a b. (a -> b) -> a -> b
$
StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Name, FC), Docstring ())
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Name, FC), Docstring ())
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do (doc :: Docstring ()
doc, _) <- (Docstring (), [(Name, Docstring ())])
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (), [(Name, Docstring ())])
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (), [(Name, Docstring ())])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option (Docstring (), [(Name, Docstring ())])
forall a. (Docstring a, [(Name, Docstring a)])
noDocs StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (), [(Name, Docstring ())])
docComment
(Name, FC)
n <- StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
constructor
(Maybe (Name, FC), Docstring ())
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe (Name, FC), Docstring ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name, FC) -> Maybe (Name, FC)
forall a. a -> Maybe a
Just (Name, FC)
n, Docstring ()
doc))
IState
ist <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
let cd' :: Docstring (Either Err PTerm)
cd' = SyntaxInfo
-> IState -> Docstring () -> Docstring (Either Err PTerm)
annotate SyntaxInfo
syn IState
ist Docstring ()
cd
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (StateT IState (WriterT FC (Parsec Void String)) ()
notEndBlock StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (SyntaxInfo -> IdrisParser [PDecl]
implementation SyntaxInfo
syn)
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do PDecl
x <- SyntaxInfo -> IdrisParser PDecl
data_ SyntaxInfo
syn
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [PDecl
x]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser [PDecl]
fnDecl SyntaxInfo
syn)
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
(Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
-> IdrisParser
(Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Name, FC)
cn, Docstring (Either Err PTerm)
cd', [[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds)
IdrisParser
(Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
-> String
-> IdrisParser
(Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "interface block"
where
constructor :: IdrisParser (Name, FC)
constructor :: StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
constructor = String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "constructor" StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
annotate :: SyntaxInfo -> IState -> Docstring () -> Docstring (Either Err PTerm)
annotate :: SyntaxInfo
-> IState -> Docstring () -> Docstring (Either Err PTerm)
annotate syn :: SyntaxInfo
syn ist :: IState
ist = (String -> Either Err PTerm)
-> Docstring () -> Docstring (Either Err PTerm)
forall a b. (String -> b) -> Docstring a -> Docstring b
annotCode ((String -> Either Err PTerm)
-> Docstring () -> Docstring (Either Err PTerm))
-> (String -> Either Err PTerm)
-> Docstring ()
-> Docstring (Either Err PTerm)
forall a b. (a -> b) -> a -> b
$ SyntaxInfo -> IState -> String -> Either Err PTerm
tryFullExpr SyntaxInfo
syn IState
ist
interface_ :: SyntaxInfo -> IdrisParser [PDecl]
interface_ :: SyntaxInfo -> IdrisParser [PDecl]
interface_ syn :: SyntaxInfo
syn = do (doc :: Docstring (Either Err PTerm)
doc, argDocs :: [(Name, Docstring (Either Err PTerm))]
argDocs, acc :: Accessibility
acc)
<- StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Accessibility)
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Accessibility)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do (doc :: Docstring (Either Err PTerm)
doc, argDocs :: [(Name, Docstring (Either Err PTerm))]
argDocs) <- SyntaxInfo
-> IdrisParser
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
docstring SyntaxInfo
syn
Accessibility
acc <- IdrisParser Accessibility
accessibility
StateT IState (WriterT FC (Parsec Void String)) ()
interfaceKeyword
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Accessibility)
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))], Accessibility)
forall (m :: * -> *) a. Monad m => a -> m a
return (Docstring (Either Err PTerm)
doc, [(Name, Docstring (Either Err PTerm))]
argDocs, Accessibility
acc))
((cons' :: [(Name, PTerm)]
cons', n :: Name
n, nfc :: FC
nfc, cs :: [(Name, FC, PTerm)]
cs, fds :: [(Name, FC)]
fds), fc :: FC
fc) <- StateT
IState
(WriterT FC (Parsec Void String))
([(Name, PTerm)], Name, FC, [(Name, FC, PTerm)], [(Name, FC)])
-> StateT
IState
(WriterT FC (Parsec Void String))
(([(Name, PTerm)], Name, FC, [(Name, FC, PTerm)], [(Name, FC)]),
FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (StateT
IState
(WriterT FC (Parsec Void String))
([(Name, PTerm)], Name, FC, [(Name, FC, PTerm)], [(Name, FC)])
-> StateT
IState
(WriterT FC (Parsec Void String))
(([(Name, PTerm)], Name, FC, [(Name, FC, PTerm)], [(Name, FC)]),
FC))
-> StateT
IState
(WriterT FC (Parsec Void String))
([(Name, PTerm)], Name, FC, [(Name, FC, PTerm)], [(Name, FC)])
-> StateT
IState
(WriterT FC (Parsec Void String))
(([(Name, PTerm)], Name, FC, [(Name, FC, PTerm)], [(Name, FC)]),
FC)
forall a b. (a -> b) -> a -> b
$ do
[(RigCount, Name, FC, PTerm)]
cons <- SyntaxInfo
-> StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
constraintList SyntaxInfo
syn
let cons' :: [(Name, PTerm)]
cons' = [(Name
c, PTerm
ty) | (_, c :: Name
c, _, ty :: PTerm
ty) <- [(RigCount, Name, FC, PTerm)]
cons]
(n_in :: Name
n_in, nfc :: FC
nfc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
let n :: Name
n = SyntaxInfo -> Name -> Name
expandNS SyntaxInfo
syn Name
n_in
[(Name, FC, PTerm)]
cs <- StateT IState (WriterT FC (Parsec Void String)) (Name, FC, PTerm)
-> StateT
IState (WriterT FC (Parsec Void String)) [(Name, FC, PTerm)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT IState (WriterT FC (Parsec Void String)) (Name, FC, PTerm)
carg
[(Name, FC)]
fds <- [(Name, FC)]
-> StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
-> StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option [(Name
cn, FC
NoFC) | (cn :: Name
cn, _, _) <- [(Name, FC, PTerm)]
cs] StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
fundeps
([(Name, PTerm)], Name, FC, [(Name, FC, PTerm)], [(Name, FC)])
-> StateT
IState
(WriterT FC (Parsec Void String))
([(Name, PTerm)], Name, FC, [(Name, FC, PTerm)], [(Name, FC)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, PTerm)]
cons', Name
n, FC
nfc, [(Name, FC, PTerm)]
cs, [(Name, FC)]
fds)
(cn :: Maybe (Name, FC)
cn, cd :: Docstring (Either Err PTerm)
cd, ds :: [PDecl]
ds) <- (Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
-> IdrisParser
(Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
-> IdrisParser
(Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option (Maybe (Name, FC)
forall a. Maybe a
Nothing, (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
-> Docstring (Either Err PTerm)
forall a b. (a, b) -> a
fst (Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
forall a. (Docstring a, [(Name, Docstring a)])
noDocs, []) (SyntaxInfo
-> IdrisParser
(Maybe (Name, FC), Docstring (Either Err PTerm), [PDecl])
interfaceBlock SyntaxInfo
syn)
Accessibility
-> Name
-> [Name]
-> StateT IState (WriterT FC (Parsec Void String)) ()
accData Accessibility
acc Name
n ((PDecl -> [Name]) -> [PDecl] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PDecl -> [Name]
declared [PDecl]
ds)
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [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
syn FC
fc [(Name, PTerm)]
cons' Name
n FC
nfc [(Name, FC, PTerm)]
cs [(Name, Docstring (Either Err PTerm))]
argDocs [(Name, FC)]
fds [PDecl]
ds Maybe (Name, FC)
cn Docstring (Either Err PTerm)
cd]
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "interface declaration"
where
fundeps :: IdrisParser [(Name, FC)]
fundeps :: StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
fundeps = do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '|'; StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy (StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
name) (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ',')
classWarning :: String
classWarning :: String
classWarning = "Use of a fragile keyword `class`. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"`class` is provided for those coming from Haskell. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Please use `interface` instead, which is equivalent."
interfaceKeyword :: IdrisParser ()
interfaceKeyword :: StateT IState (WriterT FC (Parsec Void String)) ()
interfaceKeyword = String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "interface"
StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do FC
fc <- StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a. MonadWriter FC m => m a -> m FC
extent (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall a b. (a -> b) -> a -> b
$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "class"
FC
-> Maybe Opt
-> Err
-> StateT IState (WriterT FC (Parsec Void String)) ()
parserWarning FC
fc Maybe Opt
forall a. Maybe a
Nothing (String -> Err
forall t. String -> Err' t
Msg String
classWarning)
carg :: IdrisParser (Name, FC, PTerm)
carg :: StateT IState (WriterT FC (Parsec Void String)) (Name, FC, PTerm)
carg = do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '('; (i :: Name
i, ifc :: FC
ifc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
name; Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ':'; PTerm
ty <- SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn; Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ')'
(Name, FC, PTerm)
-> StateT
IState (WriterT FC (Parsec Void String)) (Name, FC, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
i, FC
ifc, PTerm
ty)
StateT IState (WriterT FC (Parsec Void String)) (Name, FC, PTerm)
-> StateT
IState (WriterT FC (Parsec Void String)) (Name, FC, PTerm)
-> StateT
IState (WriterT FC (Parsec Void String)) (Name, FC, PTerm)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do (i :: Name
i, ifc :: FC
ifc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
name
(Name, FC, PTerm)
-> StateT
IState (WriterT FC (Parsec Void String)) (Name, FC, PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
i, FC
ifc, FC -> PTerm
PType FC
ifc)
implementation :: SyntaxInfo -> IdrisParser [PDecl]
implementation :: SyntaxInfo -> IdrisParser [PDecl]
implementation syn :: SyntaxInfo
syn = do (doc :: Docstring (Either Err PTerm)
doc, argDocs :: [(Name, Docstring (Either Err PTerm))]
argDocs) <- SyntaxInfo
-> IdrisParser
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
docstring SyntaxInfo
syn
(opts :: FnOpts
opts, acc :: Accessibility
acc) <- IdrisParser (FnOpts, Accessibility)
fnOpts
StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT IState (WriterT FC (Parsec Void String)) ()
implementationKeyword
((en :: Maybe Name
en, cs :: [(RigCount, Name, FC, PTerm)]
cs, cs' :: [(Name, PTerm)]
cs', cn :: Name
cn, cnfc :: FC
cnfc, args :: [PTerm]
args, pnames :: [Name]
pnames), fc :: FC
fc) <- StateT
IState
(WriterT FC (Parsec Void String))
(Maybe Name, [(RigCount, Name, FC, PTerm)], [(Name, PTerm)], Name,
FC, [PTerm], [Name])
-> StateT
IState
(WriterT FC (Parsec Void String))
((Maybe Name, [(RigCount, Name, FC, PTerm)], [(Name, PTerm)], Name,
FC, [PTerm], [Name]),
FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (StateT
IState
(WriterT FC (Parsec Void String))
(Maybe Name, [(RigCount, Name, FC, PTerm)], [(Name, PTerm)], Name,
FC, [PTerm], [Name])
-> StateT
IState
(WriterT FC (Parsec Void String))
((Maybe Name, [(RigCount, Name, FC, PTerm)], [(Name, PTerm)], Name,
FC, [PTerm], [Name]),
FC))
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe Name, [(RigCount, Name, FC, PTerm)], [(Name, PTerm)], Name,
FC, [PTerm], [Name])
-> StateT
IState
(WriterT FC (Parsec Void String))
((Maybe Name, [(RigCount, Name, FC, PTerm)], [(Name, PTerm)], Name,
FC, [PTerm], [Name]),
FC)
forall a b. (a -> b) -> a -> b
$ do
Maybe Name
en <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Maybe Name)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT IState (WriterT FC (Parsec Void String)) Name
implementationName
[(RigCount, Name, FC, PTerm)]
cs <- SyntaxInfo
-> StateT
IState
(WriterT FC (Parsec Void String))
[(RigCount, Name, FC, PTerm)]
constraintList SyntaxInfo
syn
let cs' :: [(Name, PTerm)]
cs' = [(Name
c, PTerm
ty) | (_, c :: Name
c, _, ty :: PTerm
ty) <- [(RigCount, Name, FC, PTerm)]
cs]
(cn :: Name
cn, cnfc :: FC
cnfc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
[PTerm]
args <- IdrisParser PTerm
-> StateT IState (WriterT FC (Parsec Void String)) [PTerm]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (SyntaxInfo -> IdrisParser PTerm
simpleExpr SyntaxInfo
syn)
[Name]
pnames <- IdrisParser [Name]
implementationUsing
(Maybe Name, [(RigCount, Name, FC, PTerm)], [(Name, PTerm)], Name,
FC, [PTerm], [Name])
-> StateT
IState
(WriterT FC (Parsec Void String))
(Maybe Name, [(RigCount, Name, FC, PTerm)], [(Name, PTerm)], Name,
FC, [PTerm], [Name])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name
en, [(RigCount, Name, FC, PTerm)]
cs, [(Name, PTerm)]
cs', Name
cn, FC
cnfc, [PTerm]
args, [Name]
pnames)
let sc :: PTerm
sc = FC -> PTerm -> [PArg] -> PTerm
PApp FC
fc (FC -> [FC] -> Name -> PTerm
PRef FC
cnfc [FC
cnfc] Name
cn) ((PTerm -> PArg) -> [PTerm] -> [PArg]
forall a b. (a -> b) -> [a] -> [b]
map PTerm -> PArg
forall t. t -> PArg' t
pexp [PTerm]
args)
let t :: PTerm
t = (RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm)
-> [(RigCount, Name, FC, PTerm)] -> PTerm -> PTerm
bindList (\r :: RigCount
r -> Plicity -> Name -> FC -> PTerm -> PTerm -> PTerm
PPi Plicity
constraint { pcount :: RigCount
pcount = RigCount
r }) [(RigCount, Name, FC, PTerm)]
cs PTerm
sc
[PDecl]
ds <- SyntaxInfo -> IdrisParser [PDecl]
implementationBlock SyntaxInfo
syn
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> [(Name, PTerm)]
-> [Name]
-> Accessibility
-> FnOpts
-> 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
-> FnOpts
-> 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
syn FC
fc [(Name, PTerm)]
cs' [Name]
pnames Accessibility
acc FnOpts
opts Name
cn FC
cnfc [PTerm]
args [] PTerm
t Maybe Name
en [PDecl]
ds]
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "implementation declaration"
where implementationName :: IdrisParser Name
implementationName :: StateT IState (WriterT FC (Parsec Void String)) Name
implementationName = do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '['; Name
n_in <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName; Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ']'
let n :: Name
n = SyntaxInfo -> Name -> Name
expandNS SyntaxInfo
syn Name
n_in
Name -> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
StateT IState (WriterT FC (Parsec Void String)) Name
-> String -> StateT IState (WriterT FC (Parsec Void String)) Name
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "implementation name"
instanceWarning :: String
instanceWarning :: String
instanceWarning = "Use of fragile keyword `instance`. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"`instance` is provided for those coming from Haskell. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Please use `implementation` (which is equivalent) instead, or omit it."
implementationKeyword :: IdrisParser ()
implementationKeyword :: StateT IState (WriterT FC (Parsec Void String)) ()
implementationKeyword = String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "implementation"
StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do FC
fc <- StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a. MonadWriter FC m => m a -> m FC
extent (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall a b. (a -> b) -> a -> b
$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "instance"
FC
-> Maybe Opt
-> Err
-> StateT IState (WriterT FC (Parsec Void String)) ()
parserWarning FC
fc Maybe Opt
forall a. Maybe a
Nothing (String -> Err
forall t. String -> Err' t
Msg String
instanceWarning)
implementationUsing :: IdrisParser [Name]
implementationUsing :: IdrisParser [Name]
implementationUsing = do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "using"
[(Name, FC)]
ns <- StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 (StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName) (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ',')
[Name] -> IdrisParser [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return (((Name, FC) -> Name) -> [(Name, FC)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, FC) -> Name
forall a b. (a, b) -> a
fst [(Name, FC)]
ns)
IdrisParser [Name] -> IdrisParser [Name] -> IdrisParser [Name]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Name] -> IdrisParser [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return []
docstring :: SyntaxInfo
-> IdrisParser (Docstring (Either Err PTerm),
[(Name,Docstring (Either Err PTerm))])
docstring :: SyntaxInfo
-> IdrisParser
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
docstring syn :: SyntaxInfo
syn = do (doc :: Docstring ()
doc, argDocs :: [(Name, Docstring ())]
argDocs) <- (Docstring (), [(Name, Docstring ())])
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (), [(Name, Docstring ())])
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (), [(Name, Docstring ())])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option (Docstring (), [(Name, Docstring ())])
forall a. (Docstring a, [(Name, Docstring a)])
noDocs StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (), [(Name, Docstring ())])
docComment
IState
ist <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
let doc' :: Docstring (Either Err PTerm)
doc' = (String -> Either Err PTerm)
-> Docstring () -> Docstring (Either Err PTerm)
forall a b. (String -> b) -> Docstring a -> Docstring b
annotCode (SyntaxInfo -> IState -> String -> Either Err PTerm
tryFullExpr SyntaxInfo
syn IState
ist) Docstring ()
doc
argDocs' :: [(Name, Docstring (Either Err PTerm))]
argDocs' = [ (Name
n, (String -> Either Err PTerm)
-> Docstring () -> Docstring (Either Err PTerm)
forall a b. (String -> b) -> Docstring a -> Docstring b
annotCode (SyntaxInfo -> IState -> String -> Either Err PTerm
tryFullExpr SyntaxInfo
syn IState
ist) Docstring ()
d)
| (n :: Name
n, d :: Docstring ()
d) <- [(Name, Docstring ())]
argDocs ]
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
-> IdrisParser
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
forall (m :: * -> *) a. Monad m => a -> m a
return (Docstring (Either Err PTerm)
doc', [(Name, Docstring (Either Err PTerm))]
argDocs')
usingDeclList :: SyntaxInfo -> IdrisParser [Using]
usingDeclList :: SyntaxInfo -> IdrisParser [Using]
usingDeclList syn :: SyntaxInfo
syn
= IdrisParser [Using] -> IdrisParser [Using]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (StateT IState (WriterT FC (Parsec Void String)) Using
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> IdrisParser [Using]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 (SyntaxInfo -> StateT IState (WriterT FC (Parsec Void String)) Using
usingDecl SyntaxInfo
syn) (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ','))
IdrisParser [Using] -> IdrisParser [Using] -> IdrisParser [Using]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do [Name]
ns <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> IdrisParser [Name]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
name (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ',')
Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ':'
PTerm
t <- SyntaxInfo -> IdrisParser PTerm
typeExpr (SyntaxInfo -> SyntaxInfo
disallowImp SyntaxInfo
syn)
[Using] -> IdrisParser [Using]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name -> Using) -> [Name] -> [Using]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Name
x -> Name -> PTerm -> Using
UImplicit Name
x PTerm
t) [Name]
ns)
IdrisParser [Using] -> String -> IdrisParser [Using]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "using declaration list"
usingDecl :: SyntaxInfo -> IdrisParser Using
usingDecl :: SyntaxInfo -> StateT IState (WriterT FC (Parsec Void String)) Using
usingDecl syn :: SyntaxInfo
syn = StateT IState (WriterT FC (Parsec Void String)) Using
-> StateT IState (WriterT FC (Parsec Void String)) Using
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do Name
x <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ':'
PTerm
t <- SyntaxInfo -> IdrisParser PTerm
typeExpr (SyntaxInfo -> SyntaxInfo
disallowImp SyntaxInfo
syn)
Using -> StateT IState (WriterT FC (Parsec Void String)) Using
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> PTerm -> Using
UImplicit Name
x PTerm
t))
StateT IState (WriterT FC (Parsec Void String)) Using
-> StateT IState (WriterT FC (Parsec Void String)) Using
-> StateT IState (WriterT FC (Parsec Void String)) Using
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do Name
c <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
[Name]
xs <- StateT IState (WriterT FC (Parsec Void String)) Name
-> IdrisParser [Name]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
Using -> StateT IState (WriterT FC (Parsec Void String)) Using
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Name] -> Using
UConstraint Name
c [Name]
xs)
StateT IState (WriterT FC (Parsec Void String)) Using
-> String -> StateT IState (WriterT FC (Parsec Void String)) Using
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "using declaration"
pattern :: SyntaxInfo -> IdrisParser PDecl
pattern :: SyntaxInfo -> IdrisParser PDecl
pattern syn :: SyntaxInfo
syn = do (clause :: PClause' PTerm
clause, fc :: FC
fc) <- StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> StateT
IState (WriterT FC (Parsec Void String)) (PClause' PTerm, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (SyntaxInfo
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
clause SyntaxInfo
syn)
PDecl -> IdrisParser PDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> FnOpts -> Name -> [PClause' PTerm] -> PDecl
forall t. FC -> FnOpts -> Name -> [PClause' t] -> PDecl' t
PClauses FC
fc [] (Int -> String -> Name
sMN 2 "_") [PClause' PTerm
clause])
IdrisParser PDecl -> String -> IdrisParser PDecl
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "pattern"
caf :: SyntaxInfo -> IdrisParser PDecl
caf :: SyntaxInfo -> IdrisParser PDecl
caf syn :: SyntaxInfo
syn = do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "let"
(n :: Name
n, fc :: FC
fc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (SyntaxInfo -> Name -> Name
expandNS SyntaxInfo
syn (Name -> Name)
-> StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName)
StateT IState (WriterT FC (Parsec Void String)) ()
pushIndent
Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '='
PTerm
t <- IdrisParser PTerm -> IdrisParser PTerm
forall a. IdrisParser a -> IdrisParser a
indented (IdrisParser PTerm -> IdrisParser PTerm)
-> IdrisParser PTerm -> IdrisParser PTerm
forall a b. (a -> b) -> a -> b
$ SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn
StateT IState (WriterT FC (Parsec Void String)) ()
terminator
PDecl -> IdrisParser PDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> Name -> PTerm -> PDecl
forall t. FC -> Name -> t -> PDecl' t
PCAF FC
fc Name
n PTerm
t)
IdrisParser PDecl -> String -> IdrisParser PDecl
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "constant applicative form declaration"
argExpr :: SyntaxInfo -> IdrisParser PTerm
argExpr :: SyntaxInfo -> IdrisParser PTerm
argExpr syn :: SyntaxInfo
syn = let syn' :: SyntaxInfo
syn' = SyntaxInfo
syn { inPattern :: Bool
inPattern = Bool
True } in
IdrisParser PTerm -> IdrisParser PTerm
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (SyntaxInfo -> IdrisParser PTerm
hsimpleExpr SyntaxInfo
syn') IdrisParser PTerm -> IdrisParser PTerm -> IdrisParser PTerm
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SyntaxInfo -> IdrisParser PTerm
simpleExternalExpr SyntaxInfo
syn'
IdrisParser PTerm -> String -> IdrisParser PTerm
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "argument expression"
rhs :: SyntaxInfo -> Name -> IdrisParser (PTerm, FC)
rhs :: SyntaxInfo -> Name -> IdrisParser (PTerm, FC)
rhs syn :: SyntaxInfo
syn n :: Name
n = do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '='
StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). (Parsing m, MonadState IState m) => m ()
indentGt
IdrisParser PTerm -> IdrisParser (PTerm, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (IdrisParser PTerm -> IdrisParser (PTerm, FC))
-> IdrisParser PTerm -> IdrisParser (PTerm, FC)
forall a b. (a -> b) -> a -> b
$ SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn
IdrisParser (PTerm, FC)
-> IdrisParser (PTerm, FC) -> IdrisParser (PTerm, FC)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
symbol "?=";
(name :: Name
name, fc :: FC
fc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC))
-> StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall a b. (a -> b) -> a -> b
$ Name
-> StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Name
n' (String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
symbol "{" StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) Name
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) Name
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
symbol "}")
PTerm
r <- SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn
(PTerm, FC) -> IdrisParser (PTerm, FC)
forall (m :: * -> *) a. Monad m => a -> m a
return (FC -> Name -> PTerm -> PTerm
addLet FC
fc Name
name PTerm
r, FC
fc)
IdrisParser (PTerm, FC)
-> IdrisParser (PTerm, FC) -> IdrisParser (PTerm, FC)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdrisParser PTerm -> IdrisParser (PTerm, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent IdrisParser PTerm
impossible
IdrisParser (PTerm, FC) -> String -> IdrisParser (PTerm, FC)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "function right hand side"
where mkN :: Name -> Name
mkN :: Name -> Name
mkN (UN x :: Text
x) = if (Text -> Bool
tnull Text
x Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isAlpha (Text -> Char
thead Text
x)))
then String -> Name
sUN "infix_op_lemma_1"
else String -> Name
sUN (Text -> String
str Text
xString -> String -> String
forall a. [a] -> [a] -> [a]
++"_lemma_1")
mkN (NS x :: Name
x n :: [Text]
n) = Name -> [Text] -> Name
NS (Name -> Name
mkN Name
x) [Text]
n
n' :: Name
n' :: Name
n' = Name -> Name
mkN Name
n
addLet :: FC -> Name -> PTerm -> PTerm
addLet :: FC -> Name -> PTerm -> PTerm
addLet fc :: FC
fc nm :: Name
nm (PLet fc' :: FC
fc' rig :: RigCount
rig n :: Name
n nfc :: FC
nfc ty :: PTerm
ty val :: PTerm
val r :: PTerm
r) = FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc' RigCount
rig Name
n FC
nfc PTerm
ty PTerm
val (FC -> Name -> PTerm -> PTerm
addLet FC
fc Name
nm PTerm
r)
addLet fc :: FC
fc nm :: Name
nm (PCase fc' :: FC
fc' t :: PTerm
t cs :: [(PTerm, PTerm)]
cs) = FC -> PTerm -> [(PTerm, PTerm)] -> PTerm
PCase FC
fc' PTerm
t (((PTerm, PTerm) -> (PTerm, PTerm))
-> [(PTerm, PTerm)] -> [(PTerm, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (PTerm, PTerm) -> (PTerm, PTerm)
forall a. (a, PTerm) -> (a, PTerm)
addLetC [(PTerm, PTerm)]
cs)
where addLetC :: (a, PTerm) -> (a, PTerm)
addLetC (l :: a
l, r :: PTerm
r) = (a
l, FC -> Name -> PTerm -> PTerm
addLet FC
fc Name
nm PTerm
r)
addLet fc :: FC
fc nm :: Name
nm r :: PTerm
r = (FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
RigW (String -> Name
sUN "value") FC
NoFC PTerm
Placeholder PTerm
r (FC -> Name -> PTerm
PMetavar FC
NoFC Name
nm))
clause :: SyntaxInfo -> IdrisParser PClause
clause :: SyntaxInfo
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
clause syn :: SyntaxInfo
syn
= do [PTerm]
wargs <- StateT IState (WriterT FC (Parsec Void String)) [PTerm]
-> StateT IState (WriterT FC (Parsec Void String)) [PTerm]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do StateT IState (WriterT FC (Parsec Void String)) ()
pushIndent; IdrisParser PTerm
-> StateT IState (WriterT FC (Parsec Void String)) [PTerm]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (SyntaxInfo -> IdrisParser PTerm
wExpr SyntaxInfo
syn))
IState
ist <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
Name
n <- case IState -> Maybe Name
lastParse IState
ist of
Just t :: Name
t -> Name -> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
t
Nothing -> String -> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid clause"
(do (r :: PTerm
r, fc :: FC
fc) <- SyntaxInfo -> Name -> IdrisParser (PTerm, FC)
rhs SyntaxInfo
syn Name
n
let wsyn :: SyntaxInfo
wsyn = SyntaxInfo
syn { syn_namespace :: [String]
syn_namespace = [], syn_toplevel :: Bool
syn_toplevel = Bool
False }
(wheres :: [PDecl]
wheres, nmap :: [(Name, Name)]
nmap) <- Name -> SyntaxInfo -> IdrisParser ([PDecl], [(Name, Name)])
whereBlock Name
n SyntaxInfo
wsyn IdrisParser ([PDecl], [(Name, Name)])
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser ([PDecl], [(Name, Name)])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT IState (WriterT FC (Parsec Void String)) ()
popIndent
IdrisParser ([PDecl], [(Name, Name)])
-> IdrisParser ([PDecl], [(Name, Name)])
-> IdrisParser ([PDecl], [(Name, Name)])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([], []) ([PDecl], [(Name, Name)])
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser ([PDecl], [(Name, Name)])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
terminator
PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (PClause' PTerm
-> StateT
IState (WriterT FC (Parsec Void String)) (PClause' PTerm))
-> PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall a b. (a -> b) -> a -> b
$ FC -> [PTerm] -> PTerm -> [PDecl] -> PClause' PTerm
forall t. FC -> [t] -> t -> [PDecl' t] -> PClause' t
PClauseR FC
fc [PTerm]
wargs PTerm
r [PDecl]
wheres) StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
StateT IState (WriterT FC (Parsec Void String)) ()
popIndent
((wval :: PTerm
wval, pn :: Maybe (Name, FC)
pn), fc :: FC
fc) <- StateT
IState (WriterT FC (Parsec Void String)) (PTerm, Maybe (Name, FC))
-> StateT
IState
(WriterT FC (Parsec Void String))
((PTerm, Maybe (Name, FC)), FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (StateT
IState (WriterT FC (Parsec Void String)) (PTerm, Maybe (Name, FC))
-> StateT
IState
(WriterT FC (Parsec Void String))
((PTerm, Maybe (Name, FC)), FC))
-> StateT
IState (WriterT FC (Parsec Void String)) (PTerm, Maybe (Name, FC))
-> StateT
IState
(WriterT FC (Parsec Void String))
((PTerm, Maybe (Name, FC)), FC)
forall a b. (a -> b) -> a -> b
$ do
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "with"
PTerm
wval <- SyntaxInfo -> IdrisParser PTerm
bracketed SyntaxInfo
syn
Maybe (Name, FC)
pn <- StateT IState (WriterT FC (Parsec Void String)) (Maybe (Name, FC))
optProof
(PTerm, Maybe (Name, FC))
-> StateT
IState (WriterT FC (Parsec Void String)) (PTerm, Maybe (Name, FC))
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm
wval, Maybe (Name, FC)
pn)
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]])
-> IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall a b. (a -> b) -> a -> b
$ SyntaxInfo -> IdrisParser [PDecl]
fnDecl SyntaxInfo
syn
let withs :: [PDecl]
withs = [[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (PClause' PTerm
-> StateT
IState (WriterT FC (Parsec Void String)) (PClause' PTerm))
-> PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall a b. (a -> b) -> a -> b
$ FC
-> [PTerm]
-> PTerm
-> Maybe (Name, FC)
-> [PDecl]
-> PClause' PTerm
forall t.
FC -> [t] -> t -> Maybe (Name, FC) -> [PDecl' t] -> PClause' t
PWithR FC
fc [PTerm]
wargs PTerm
wval Maybe (Name, FC)
pn [PDecl]
withs)
StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do PTerm
ty <- IdrisParser PTerm -> IdrisParser PTerm
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do StateT IState (WriterT FC (Parsec Void String)) ()
pushIndent
PTerm
ty <- SyntaxInfo -> IdrisParser PTerm
simpleExpr SyntaxInfo
syn
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
symbol "<=="
PTerm -> IdrisParser PTerm
forall (m :: * -> *) a. Monad m => a -> m a
return PTerm
ty)
(n :: Name
n, fc :: FC
fc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (SyntaxInfo -> Name -> Name
expandNS SyntaxInfo
syn (Name -> Name)
-> StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName)
(r :: PTerm
r, _) <- SyntaxInfo -> Name -> IdrisParser (PTerm, FC)
rhs SyntaxInfo
syn Name
n
let wsyn :: SyntaxInfo
wsyn = SyntaxInfo
syn { syn_namespace :: [String]
syn_namespace = [] }
(wheres :: [PDecl]
wheres, nmap :: [(Name, Name)]
nmap) <- Name -> SyntaxInfo -> IdrisParser ([PDecl], [(Name, Name)])
whereBlock Name
n SyntaxInfo
wsyn IdrisParser ([PDecl], [(Name, Name)])
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser ([PDecl], [(Name, Name)])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT IState (WriterT FC (Parsec Void String)) ()
popIndent
IdrisParser ([PDecl], [(Name, Name)])
-> IdrisParser ([PDecl], [(Name, Name)])
-> IdrisParser ([PDecl], [(Name, Name)])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([], []) ([PDecl], [(Name, Name)])
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser ([PDecl], [(Name, Name)])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
terminator
let capp :: PTerm
capp = FC -> RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm -> PTerm
PLet FC
fc RigCount
RigW (Int -> String -> Name
sMN 0 "match") FC
NoFC
PTerm
ty
(FC -> Name -> PTerm
PMatchApp FC
fc Name
n)
(FC -> [FC] -> Name -> PTerm
PRef FC
fc [] (Int -> String -> Name
sMN 0 "match"))
IState
ist <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
IState -> StateT IState (WriterT FC (Parsec Void String)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
ist { lastParse :: Maybe Name
lastParse = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n })
PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (PClause' PTerm
-> StateT
IState (WriterT FC (Parsec Void String)) (PClause' PTerm))
-> PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall a b. (a -> b) -> a -> b
$ 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
capp [] PTerm
r [PDecl]
wheres
StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
pushIndent
(n :: Name
n, nfc :: FC
nfc, capp :: PTerm
capp, wargs :: [PTerm]
wargs) <- IdrisParser (Name, FC, PTerm, [PTerm])
lhs
(IState -> IState)
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IState -> IState)
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> (IState -> IState)
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ \ist :: IState
ist -> IState
ist { lastParse :: Maybe Name
lastParse = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n }
(do (rs :: PTerm
rs, fc :: FC
fc) <- SyntaxInfo -> Name -> IdrisParser (PTerm, FC)
rhs SyntaxInfo
syn Name
n
let wsyn :: SyntaxInfo
wsyn = SyntaxInfo
syn { syn_namespace :: [String]
syn_namespace = [] }
(wheres :: [PDecl]
wheres, nmap :: [(Name, Name)]
nmap) <- Name -> SyntaxInfo -> IdrisParser ([PDecl], [(Name, Name)])
whereBlock Name
n SyntaxInfo
wsyn IdrisParser ([PDecl], [(Name, Name)])
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser ([PDecl], [(Name, Name)])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT IState (WriterT FC (Parsec Void String)) ()
popIndent
IdrisParser ([PDecl], [(Name, Name)])
-> IdrisParser ([PDecl], [(Name, Name)])
-> IdrisParser ([PDecl], [(Name, Name)])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([], []) ([PDecl], [(Name, Name)])
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser ([PDecl], [(Name, Name)])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT IState (WriterT FC (Parsec Void String)) ()
terminator
PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (PClause' PTerm
-> StateT
IState (WriterT FC (Parsec Void String)) (PClause' PTerm))
-> PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall a b. (a -> b) -> a -> b
$ 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
capp [PTerm]
wargs PTerm
rs [PDecl]
wheres) StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
StateT IState (WriterT FC (Parsec Void String)) ()
popIndent
((wval :: PTerm
wval, pn :: Maybe (Name, FC)
pn), fc :: FC
fc) <- StateT
IState (WriterT FC (Parsec Void String)) (PTerm, Maybe (Name, FC))
-> StateT
IState
(WriterT FC (Parsec Void String))
((PTerm, Maybe (Name, FC)), FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (StateT
IState (WriterT FC (Parsec Void String)) (PTerm, Maybe (Name, FC))
-> StateT
IState
(WriterT FC (Parsec Void String))
((PTerm, Maybe (Name, FC)), FC))
-> StateT
IState (WriterT FC (Parsec Void String)) (PTerm, Maybe (Name, FC))
-> StateT
IState
(WriterT FC (Parsec Void String))
((PTerm, Maybe (Name, FC)), FC)
forall a b. (a -> b) -> a -> b
$ do
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "with"
PTerm
wval <- SyntaxInfo -> IdrisParser PTerm
bracketed SyntaxInfo
syn
Maybe (Name, FC)
pn <- StateT IState (WriterT FC (Parsec Void String)) (Maybe (Name, FC))
optProof
(PTerm, Maybe (Name, FC))
-> StateT
IState (WriterT FC (Parsec Void String)) (PTerm, Maybe (Name, FC))
forall (m :: * -> *) a. Monad m => a -> m a
return (PTerm
wval, Maybe (Name, FC)
pn)
StateT IState (WriterT FC (Parsec Void String)) ()
openBlock
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]])
-> IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall a b. (a -> b) -> a -> b
$ SyntaxInfo -> IdrisParser [PDecl]
fnDecl SyntaxInfo
syn
StateT IState (WriterT FC (Parsec Void String)) ()
closeBlock
let withs :: [PDecl]
withs = (PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> PTerm -> [PTerm] -> PDecl -> PDecl
fillLHSD Name
n PTerm
capp [PTerm]
wargs) ([PDecl] -> [PDecl]) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> a -> b
$ [[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds
PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall (m :: * -> *) a. Monad m => a -> m a
return (PClause' PTerm
-> StateT
IState (WriterT FC (Parsec Void String)) (PClause' PTerm))
-> PClause' PTerm
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall a b. (a -> b) -> a -> b
$ 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
capp [PTerm]
wargs PTerm
wval Maybe (Name, FC)
pn [PDecl]
withs)
StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
-> String
-> StateT IState (WriterT FC (Parsec Void String)) (PClause' PTerm)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "function clause"
where
lhsInfixApp :: IdrisParser (Name, FC, [PArg], [PTerm])
lhsInfixApp :: IdrisParser (Name, FC, [PArg], [PTerm])
lhsInfixApp = do PTerm
l <- SyntaxInfo -> IdrisParser PTerm
argExpr SyntaxInfo
syn
(op :: String
op, nfc :: FC
nfc) <- StateT IState (WriterT FC (Parsec Void String)) String
-> StateT IState (WriterT FC (Parsec Void String)) (String, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
symbolicOperator
Bool
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "=" Bool -> Bool -> Bool
|| String
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "?=" ) (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "infix clause definition with \"=\" and \"?=\" not supported "
let n :: Name
n = SyntaxInfo -> Name -> Name
expandNS SyntaxInfo
syn (String -> Name
sUN String
op)
PTerm
r <- SyntaxInfo -> IdrisParser PTerm
argExpr SyntaxInfo
syn
[PTerm]
wargs <- IdrisParser PTerm
-> StateT IState (WriterT FC (Parsec Void String)) [PTerm]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (SyntaxInfo -> IdrisParser PTerm
wExpr SyntaxInfo
syn)
(Name, FC, [PArg], [PTerm])
-> IdrisParser (Name, FC, [PArg], [PTerm])
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, FC
nfc, [PTerm -> PArg
forall t. t -> PArg' t
pexp PTerm
l, PTerm -> PArg
forall t. t -> PArg' t
pexp PTerm
r], [PTerm]
wargs)
lhsPrefixApp :: IdrisParser (Name, FC, [PArg], [PTerm])
lhsPrefixApp :: IdrisParser (Name, FC, [PArg], [PTerm])
lhsPrefixApp = do (n :: Name
n, nfc :: FC
nfc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (SyntaxInfo -> Name -> Name
expandNS SyntaxInfo
syn (Name -> Name)
-> StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName)
[PArg]
args <- StateT IState (WriterT FC (Parsec Void String)) PArg
-> StateT IState (WriterT FC (Parsec Void String)) [PArg]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (StateT IState (WriterT FC (Parsec Void String)) PArg
-> StateT IState (WriterT FC (Parsec Void String)) PArg
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (SyntaxInfo -> StateT IState (WriterT FC (Parsec Void String)) PArg
implicitArg (SyntaxInfo
syn { inPattern :: Bool
inPattern = Bool
True } ))
StateT IState (WriterT FC (Parsec Void String)) PArg
-> StateT IState (WriterT FC (Parsec Void String)) PArg
-> StateT IState (WriterT FC (Parsec Void String)) PArg
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT IState (WriterT FC (Parsec Void String)) PArg
-> StateT IState (WriterT FC (Parsec Void String)) PArg
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (SyntaxInfo -> StateT IState (WriterT FC (Parsec Void String)) PArg
constraintArg (SyntaxInfo
syn { inPattern :: Bool
inPattern = Bool
True }))
StateT IState (WriterT FC (Parsec Void String)) PArg
-> StateT IState (WriterT FC (Parsec Void String)) PArg
-> StateT IState (WriterT FC (Parsec Void String)) PArg
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((PTerm -> PArg)
-> IdrisParser PTerm
-> StateT IState (WriterT FC (Parsec Void String)) PArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PTerm -> PArg
forall t. t -> PArg' t
pexp (SyntaxInfo -> IdrisParser PTerm
argExpr SyntaxInfo
syn)))
[PTerm]
wargs <- IdrisParser PTerm
-> StateT IState (WriterT FC (Parsec Void String)) [PTerm]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (SyntaxInfo -> IdrisParser PTerm
wExpr SyntaxInfo
syn)
(Name, FC, [PArg], [PTerm])
-> IdrisParser (Name, FC, [PArg], [PTerm])
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, FC
nfc, [PArg]
args, [PTerm]
wargs)
lhs :: IdrisParser (Name, FC, PTerm, [PTerm])
lhs :: IdrisParser (Name, FC, PTerm, [PTerm])
lhs = do ((n :: Name
n, nfc :: FC
nfc, args :: [PArg]
args, wargs :: [PTerm]
wargs), lhs_fc :: FC
lhs_fc) <- IdrisParser (Name, FC, [PArg], [PTerm])
-> StateT
IState
(WriterT FC (Parsec Void String))
((Name, FC, [PArg], [PTerm]), FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (IdrisParser (Name, FC, [PArg], [PTerm])
-> IdrisParser (Name, FC, [PArg], [PTerm])
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try IdrisParser (Name, FC, [PArg], [PTerm])
lhsInfixApp IdrisParser (Name, FC, [PArg], [PTerm])
-> IdrisParser (Name, FC, [PArg], [PTerm])
-> IdrisParser (Name, FC, [PArg], [PTerm])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdrisParser (Name, FC, [PArg], [PTerm])
lhsPrefixApp)
let capp :: PTerm
capp = FC -> PTerm -> [PArg] -> PTerm
PApp FC
lhs_fc (FC -> [FC] -> Name -> PTerm
PRef FC
nfc [FC
nfc] Name
n) [PArg]
args
(Name, FC, PTerm, [PTerm])
-> IdrisParser (Name, FC, PTerm, [PTerm])
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, FC
nfc, PTerm
capp, [PTerm]
wargs)
optProof :: StateT IState (WriterT FC (Parsec Void String)) (Maybe (Name, FC))
optProof = Maybe (Name, FC)
-> StateT
IState (WriterT FC (Parsec Void String)) (Maybe (Name, FC))
-> StateT
IState (WriterT FC (Parsec Void String)) (Maybe (Name, FC))
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Maybe (Name, FC)
forall a. Maybe a
Nothing (do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "proof"
(Name, FC)
n <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
Maybe (Name, FC)
-> StateT
IState (WriterT FC (Parsec Void String)) (Maybe (Name, FC))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name, FC) -> Maybe (Name, FC)
forall a. a -> Maybe a
Just (Name, FC)
n))
fillLHS :: Name -> PTerm -> [PTerm] -> PClause -> PClause
fillLHS :: Name -> PTerm -> [PTerm] -> PClause' PTerm -> PClause' PTerm
fillLHS n :: Name
n capp :: PTerm
capp owargs :: [PTerm]
owargs (PClauseR fc :: FC
fc wargs :: [PTerm]
wargs v :: PTerm
v ws :: [PDecl]
ws)
= 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
capp ([PTerm]
owargs [PTerm] -> [PTerm] -> [PTerm]
forall a. [a] -> [a] -> [a]
++ [PTerm]
wargs) PTerm
v [PDecl]
ws
fillLHS n :: Name
n capp :: PTerm
capp owargs :: [PTerm]
owargs (PWithR fc :: FC
fc wargs :: [PTerm]
wargs v :: PTerm
v pn :: Maybe (Name, FC)
pn ws :: [PDecl]
ws)
= 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
capp ([PTerm]
owargs [PTerm] -> [PTerm] -> [PTerm]
forall a. [a] -> [a] -> [a]
++ [PTerm]
wargs) PTerm
v Maybe (Name, FC)
pn
((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> PTerm -> [PTerm] -> PDecl -> PDecl
fillLHSD Name
n PTerm
capp ([PTerm]
owargs [PTerm] -> [PTerm] -> [PTerm]
forall a. [a] -> [a] -> [a]
++ [PTerm]
wargs)) [PDecl]
ws)
fillLHS _ _ _ c :: PClause' PTerm
c = PClause' PTerm
c
fillLHSD :: Name -> PTerm -> [PTerm] -> PDecl -> PDecl
fillLHSD :: Name -> PTerm -> [PTerm] -> PDecl -> PDecl
fillLHSD n :: Name
n c :: PTerm
c a :: [PTerm]
a (PClauses fc :: FC
fc o :: FnOpts
o fn :: Name
fn cs :: [PClause' PTerm]
cs) = FC -> FnOpts -> Name -> [PClause' PTerm] -> PDecl
forall t. FC -> FnOpts -> Name -> [PClause' t] -> PDecl' t
PClauses FC
fc FnOpts
o Name
fn ((PClause' PTerm -> PClause' PTerm)
-> [PClause' PTerm] -> [PClause' PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> PTerm -> [PTerm] -> PClause' PTerm -> PClause' PTerm
fillLHS Name
n PTerm
c [PTerm]
a) [PClause' PTerm]
cs)
fillLHSD n :: Name
n c :: PTerm
c a :: [PTerm]
a x :: PDecl
x = PDecl
x
wExpr :: SyntaxInfo -> IdrisParser PTerm
wExpr :: SyntaxInfo -> IdrisParser PTerm
wExpr syn :: SyntaxInfo
syn = do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '|'
SyntaxInfo -> IdrisParser PTerm
expr' (SyntaxInfo
syn { inPattern :: Bool
inPattern = Bool
True })
IdrisParser PTerm -> String -> IdrisParser PTerm
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "with pattern"
whereBlock :: Name -> SyntaxInfo -> IdrisParser ([PDecl], [(Name, Name)])
whereBlock :: Name -> SyntaxInfo -> IdrisParser ([PDecl], [(Name, Name)])
whereBlock n :: Name
n syn :: SyntaxInfo
syn
= do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "where"
[[PDecl]]
ds <- IdrisParser [PDecl]
-> StateT IState (WriterT FC (Parsec Void String)) [[PDecl]]
forall a. IdrisParser a -> IdrisParser [a]
indentedBlock1 (SyntaxInfo -> IdrisParser [PDecl]
decl SyntaxInfo
syn)
let dns :: [Name]
dns = ([PDecl] -> [Name]) -> [[PDecl]] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((PDecl -> [Name]) -> [PDecl] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PDecl -> [Name]
declared) [[PDecl]]
ds
([PDecl], [(Name, Name)]) -> IdrisParser ([PDecl], [(Name, Name)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([[PDecl]] -> [PDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PDecl]]
ds, (Name -> (Name, Name)) -> [Name] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Name
x -> (Name
x, SyntaxInfo -> Name -> Name
decoration SyntaxInfo
syn Name
x)) [Name]
dns)
IdrisParser ([PDecl], [(Name, Name)])
-> String -> IdrisParser ([PDecl], [(Name, Name)])
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "where block"
codegen_ :: IdrisParser Codegen
codegen_ :: IdrisParser Codegen
codegen_ = do String
n <- StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
identifier
Codegen -> IdrisParser Codegen
forall (m :: * -> *) a. Monad m => a -> m a
return (IRFormat -> String -> Codegen
Via IRFormat
IBCFormat ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
n))
IdrisParser Codegen -> IdrisParser Codegen -> IdrisParser Codegen
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "Bytecode"; Codegen -> IdrisParser Codegen
forall (m :: * -> *) a. Monad m => a -> m a
return Codegen
Bytecode
IdrisParser Codegen -> String -> IdrisParser Codegen
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "code generation language"
directive :: SyntaxInfo -> IdrisParser [PDecl]
directive :: SyntaxInfo -> IdrisParser [PDecl]
directive syn :: SyntaxInfo
syn = do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "lib")
Codegen
cgn <- IdrisParser Codegen
codegen_
String
lib <- StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
stringLiteral
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Codegen -> String -> Directive
DLib Codegen
cgn String
lib)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "link")
Codegen
cgn <- IdrisParser Codegen
codegen_; String
obj <- StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
stringLiteral
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Codegen -> String -> Directive
DLink Codegen
cgn String
obj)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "flag")
Codegen
cgn <- IdrisParser Codegen
codegen_; String
flag <- StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
stringLiteral
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Codegen -> String -> Directive
DFlag Codegen
cgn String
flag)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "include")
Codegen
cgn <- IdrisParser Codegen
codegen_
String
hdr <- StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
stringLiteral
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Codegen -> String -> Directive
DInclude Codegen
cgn String
hdr)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "hide"); Name
n <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Name -> Directive
DHide Name
n)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "freeze"); Name
n <- [String] -> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). Parsing m => [String] -> m Name
iName []
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Name -> Directive
DFreeze Name
n)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "thaw"); Name
n <- [String] -> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). Parsing m => [String] -> m Name
iName []
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Name -> Directive
DThaw Name
n)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "assert_injective"); Name
n <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Name -> Directive
DInjective Name
n)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "access")
Accessibility
acc <- IdrisParser Accessibility
accessibility
IState
ist <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
IState -> StateT IState (WriterT FC (Parsec Void String)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put IState
ist { default_access :: Accessibility
default_access = Accessibility
acc }
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Accessibility -> Directive
DAccess Accessibility
acc)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "default"); DefaultTotality
tot <- IdrisParser DefaultTotality
totality
IState
i <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
IState -> StateT IState (WriterT FC (Parsec Void String)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IState
i { default_total :: DefaultTotality
default_total = DefaultTotality
tot } )
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (DefaultTotality -> Directive
DDefault DefaultTotality
tot)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "logging")
Integer
i <- StateT IState (WriterT FC (Parsec Void String)) Integer
forall (m :: * -> *). Parsing m => m Integer
natural
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Integer -> Directive
DLogging Integer
i)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "dynamic")
[String]
libs <- StateT IState (WriterT FC (Parsec Void String)) String
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) [String]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
stringLiteral (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ',')
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective ([String] -> Directive
DDynamicLibs [String]
libs)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "name")
(ty :: Name
ty, tyFC :: FC
tyFC) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
[(Name, FC)]
ns <- StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 (StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
name) (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ',')
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Name -> FC -> [(Name, FC)] -> Directive
DNameHint Name
ty FC
tyFC [(Name, FC)]
ns)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "error_handlers")
(fn :: Name
fn, nfc :: FC
nfc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
(arg :: Name
arg, afc :: FC
afc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
[(Name, FC)]
ns <- StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
-> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) [(Name, FC)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 (StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
name) (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ',')
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Name -> FC -> Name -> FC -> [(Name, FC)] -> Directive
DErrorHandlers Name
fn FC
nfc Name
arg FC
afc [(Name, FC)]
ns) ]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "language"); LanguageExt
ext <- IdrisParser LanguageExt
pLangExt;
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (LanguageExt -> Directive
DLanguage LanguageExt
ext)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "deprecate")
Name
n <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
String
alt <- String
-> StateT IState (WriterT FC (Parsec Void String)) String
-> StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option "" StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
stringLiteral
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Name -> String -> Directive
DDeprecate Name
n String
alt)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "fragile")
Name
n <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
String
alt <- String
-> StateT IState (WriterT FC (Parsec Void String)) String
-> StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option "" StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => m String
stringLiteral
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Name -> String -> Directive
DFragile Name
n String
alt)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do FC
fc <- StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a. MonadWriter FC m => m a -> m FC
extent (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall a b. (a -> b) -> a -> b
$ StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "used")
Name
fn <- StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
Name
arg <- [String] -> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). Parsing m => [String] -> m Name
iName []
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (FC -> Name -> Name -> Directive
DUsed FC
fc Name
fn Name
arg)]
IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "auto_implicits")
Bool
b <- StateT IState (WriterT FC (Parsec Void String)) Bool
on_off
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Directive -> PDecl
forall t. Directive -> PDecl' t
PDirective (Bool -> Directive
DAutoImplicits Bool
b)]
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "directive"
where on_off :: StateT IState (WriterT FC (Parsec Void String)) Bool
on_off = do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "on"; Bool -> StateT IState (WriterT FC (Parsec Void String)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
StateT IState (WriterT FC (Parsec Void String)) Bool
-> StateT IState (WriterT FC (Parsec Void String)) Bool
-> StateT IState (WriterT FC (Parsec Void String)) Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "off"; Bool -> StateT IState (WriterT FC (Parsec Void String)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
pLangExt :: IdrisParser LanguageExt
pLangExt :: IdrisParser LanguageExt
pLangExt = (String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "TypeProviders" StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a. Monad m => a -> m a
return LanguageExt
TypeProviders)
IdrisParser LanguageExt
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "ErrorReflection" StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a. Monad m => a -> m a
return LanguageExt
ErrorReflection)
IdrisParser LanguageExt
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "UniquenessTypes" StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a. Monad m => a -> m a
return LanguageExt
UniquenessTypes)
IdrisParser LanguageExt
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "LinearTypes" StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a. Monad m => a -> m a
return LanguageExt
LinearTypes)
IdrisParser LanguageExt
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "DSLNotation" StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a. Monad m => a -> m a
return LanguageExt
DSLNotation)
IdrisParser LanguageExt
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "ElabReflection" StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a. Monad m => a -> m a
return LanguageExt
ElabReflection)
IdrisParser LanguageExt
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "FirstClassReflection" StateT IState (WriterT FC (Parsec Void String)) ()
-> IdrisParser LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LanguageExt -> IdrisParser LanguageExt
forall (m :: * -> *) a. Monad m => a -> m a
return LanguageExt
FCReflection)
totality :: IdrisParser DefaultTotality
totality :: IdrisParser DefaultTotality
totality
= do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "total"; DefaultTotality -> IdrisParser DefaultTotality
forall (m :: * -> *) a. Monad m => a -> m a
return DefaultTotality
DefaultCheckingTotal
IdrisParser DefaultTotality
-> IdrisParser DefaultTotality -> IdrisParser DefaultTotality
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "partial"; DefaultTotality -> IdrisParser DefaultTotality
forall (m :: * -> *) a. Monad m => a -> m a
return DefaultTotality
DefaultCheckingPartial
IdrisParser DefaultTotality
-> IdrisParser DefaultTotality -> IdrisParser DefaultTotality
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "covering"; DefaultTotality -> IdrisParser DefaultTotality
forall (m :: * -> *) a. Monad m => a -> m a
return DefaultTotality
DefaultCheckingCovering
provider :: SyntaxInfo -> IdrisParser [PDecl]
provider :: SyntaxInfo -> IdrisParser [PDecl]
provider syn :: SyntaxInfo
syn = do Docstring (Either Err PTerm)
doc <- StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm))
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm))
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (do (doc :: Docstring (Either Err PTerm)
doc, _) <- SyntaxInfo
-> IdrisParser
(Docstring (Either Err PTerm),
[(Name, Docstring (Either Err PTerm))])
docstring SyntaxInfo
syn
OutputAnnotation
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *) a.
(MonadState IState m, Parsing m) =>
OutputAnnotation -> m a -> m a
highlight OutputAnnotation
AnnKeyword (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ())
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall a b. (a -> b) -> a -> b
$ Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "provide"
Docstring (Either Err PTerm)
-> StateT
IState
(WriterT FC (Parsec Void String))
(Docstring (Either Err PTerm))
forall (m :: * -> *) a. Monad m => a -> m a
return Docstring (Either Err PTerm)
doc)
Docstring (Either Err PTerm) -> IdrisParser [PDecl]
provideTerm Docstring (Either Err PTerm)
doc IdrisParser [PDecl] -> IdrisParser [PDecl] -> IdrisParser [PDecl]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Docstring (Either Err PTerm) -> IdrisParser [PDecl]
providePostulate Docstring (Either Err PTerm)
doc
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "type provider"
where provideTerm :: Docstring (Either Err PTerm) -> IdrisParser [PDecl]
provideTerm doc :: Docstring (Either Err PTerm)
doc =
do Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '('; (n :: Name
n, nfc :: FC
nfc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName; Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ':'; PTerm
t <- SyntaxInfo -> IdrisParser PTerm
typeExpr SyntaxInfo
syn; Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar ')'
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "with"
(e :: PTerm
e, fc :: FC
fc) <- IdrisParser PTerm -> IdrisParser (PTerm, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn) IdrisParser (PTerm, FC) -> String -> IdrisParser (PTerm, FC)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "provider expression"
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Docstring (Either Err PTerm)
-> SyntaxInfo -> FC -> FC -> ProvideWhat' PTerm -> Name -> PDecl
forall t.
Docstring (Either Err t)
-> SyntaxInfo -> FC -> FC -> ProvideWhat' t -> Name -> PDecl' t
PProvider Docstring (Either Err PTerm)
doc SyntaxInfo
syn FC
fc FC
nfc (PTerm -> PTerm -> ProvideWhat' PTerm
forall t. t -> t -> ProvideWhat' t
ProvTerm PTerm
t PTerm
e) Name
n]
providePostulate :: Docstring (Either Err PTerm) -> IdrisParser [PDecl]
providePostulate doc :: Docstring (Either Err PTerm)
doc =
do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "postulate"
(n :: Name
n, nfc :: FC
nfc) <- StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT IState (WriterT FC (Parsec Void String)) (Name, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName
String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *).
(Parsing m, MonadState IState m) =>
String -> m ()
keyword "with"
(e :: PTerm
e, fc :: FC
fc) <- IdrisParser PTerm -> IdrisParser (PTerm, FC)
forall (m :: * -> *) a. MonadWriter FC m => m a -> m (a, FC)
withExtent (SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn) IdrisParser (PTerm, FC) -> String -> IdrisParser (PTerm, FC)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "provider expression"
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [Docstring (Either Err PTerm)
-> SyntaxInfo -> FC -> FC -> ProvideWhat' PTerm -> Name -> PDecl
forall t.
Docstring (Either Err t)
-> SyntaxInfo -> FC -> FC -> ProvideWhat' t -> Name -> PDecl' t
PProvider Docstring (Either Err PTerm)
doc SyntaxInfo
syn FC
fc FC
nfc (PTerm -> ProvideWhat' PTerm
forall t. t -> ProvideWhat' t
ProvPostulate PTerm
e) Name
n]
transform :: SyntaxInfo -> IdrisParser [PDecl]
transform :: SyntaxInfo -> IdrisParser [PDecl]
transform syn :: SyntaxInfo
syn = do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "transform")
PTerm
l <- SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn
FC
fc <- StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a. MonadWriter FC m => m a -> m FC
extent (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall a b. (a -> b) -> a -> b
$ String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
symbol "==>"
PTerm
r <- SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn
[PDecl] -> IdrisParser [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return [FC -> Bool -> PTerm -> PTerm -> PDecl
forall t. FC -> Bool -> t -> t -> PDecl' t
PTransform FC
fc Bool
False PTerm
l PTerm
r]
IdrisParser [PDecl] -> String -> IdrisParser [PDecl]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "transform"
runElabDecl :: SyntaxInfo -> IdrisParser PDecl
runElabDecl :: SyntaxInfo -> IdrisParser PDecl
runElabDecl syn :: SyntaxInfo
syn =
do FC
kwFC <- StateT IState (WriterT FC (Parsec Void String)) FC
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (OutputAnnotation
-> StateT IState (WriterT FC (Parsec Void String)) FC
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a.
(MonadState IState m, Parsing m) =>
OutputAnnotation -> m a -> m a
highlight OutputAnnotation
AnnKeyword (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall (m :: * -> *) a. MonadWriter FC m => m a -> m FC
extent (StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC)
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) FC
forall a b. (a -> b) -> a -> b
$ Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
lchar '%' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "runElab"))
PTerm
script <- SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
syn IdrisParser PTerm -> String -> IdrisParser PTerm
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "elaborator script"
PDecl -> IdrisParser PDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (PDecl -> IdrisParser PDecl) -> PDecl -> IdrisParser PDecl
forall a b. (a -> b) -> a -> b
$ FC -> PTerm -> [String] -> PDecl
forall t. FC -> t -> [String] -> PDecl' t
PRunElabDecl FC
kwFC PTerm
script (SyntaxInfo -> [String]
syn_namespace SyntaxInfo
syn)
IdrisParser PDecl -> String -> IdrisParser PDecl
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "top-level elaborator script"
parseExpr :: IState -> String -> Either ParseError PTerm
parseExpr :: IState -> String -> Either ParseError PTerm
parseExpr st :: IState
st = IdrisParser PTerm
-> IState -> String -> String -> Either ParseError PTerm
forall st res.
Parser st res -> st -> String -> String -> Either ParseError res
runparser (SyntaxInfo -> IdrisParser PTerm
fullExpr SyntaxInfo
defaultSyntax) IState
st "(input)"
parseConst :: IState -> String -> Either ParseError Const
parseConst :: IState -> String -> Either ParseError Const
parseConst st :: IState
st = Parser IState Const
-> IState -> String -> String -> Either ParseError Const
forall st res.
Parser st res -> st -> String -> String -> Either ParseError res
runparser Parser IState Const
forall (m :: * -> *). Parsing m => m Const
constant IState
st "(input)"
parseTactic :: IState -> String -> Either ParseError PTactic
parseTactic :: IState -> String -> Either ParseError PTactic
parseTactic st :: IState
st = Parser IState PTactic
-> IState -> String -> String -> Either ParseError PTactic
forall st res.
Parser st res -> st -> String -> String -> Either ParseError res
runparser (SyntaxInfo -> Parser IState PTactic
fullTactic SyntaxInfo
defaultSyntax) IState
st "(input)"
parseElabShellStep :: IState -> String -> Either ParseError (Either ElabShellCmd PDo)
parseElabShellStep :: IState -> String -> Either ParseError (Either ElabShellCmd PDo)
parseElabShellStep ist :: IState
ist = Parser IState (Either ElabShellCmd PDo)
-> IState
-> String
-> String
-> Either ParseError (Either ElabShellCmd PDo)
forall st res.
Parser st res -> st -> String -> String -> Either ParseError res
runparser (PDo -> Either ElabShellCmd PDo
forall a b. b -> Either a b
Right (PDo -> Either ElabShellCmd PDo)
-> StateT IState (WriterT FC (Parsec Void String)) PDo
-> Parser IState (Either ElabShellCmd PDo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SyntaxInfo -> StateT IState (WriterT FC (Parsec Void String)) PDo
do_ SyntaxInfo
defaultSyntax Parser IState (Either ElabShellCmd PDo)
-> Parser IState (Either ElabShellCmd PDo)
-> Parser IState (Either ElabShellCmd PDo)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ElabShellCmd -> Either ElabShellCmd PDo
forall a b. a -> Either a b
Left (ElabShellCmd -> Either ElabShellCmd PDo)
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> Parser IState (Either ElabShellCmd PDo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
elabShellCmd) IState
ist "(input)"
where elabShellCmd :: StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
elabShellCmd = Char -> StateT IState (WriterT FC (Parsec Void String)) Char
forall (m :: * -> *). Parsing m => Char -> m Char
char ':' StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "qed" StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure ElabShellCmd
EQED ) StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "abandon" StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure ElabShellCmd
EAbandon ) StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "undo" StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure ElabShellCmd
EUndo ) StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "state" StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure ElabShellCmd
EProofState) StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "term" StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure ElabShellCmd
EProofTerm ) StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
([String]
-> (PTerm -> ElabShellCmd)
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall b.
[String]
-> (PTerm -> b)
-> StateT IState (WriterT FC (Parsec Void String)) b
expressionTactic ["e", "eval"] PTerm -> ElabShellCmd
EEval ) StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
([String]
-> (PTerm -> ElabShellCmd)
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall b.
[String]
-> (PTerm -> b)
-> StateT IState (WriterT FC (Parsec Void String)) b
expressionTactic ["t", "type"] PTerm -> ElabShellCmd
ECheck) StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
([String]
-> (PTerm -> ElabShellCmd)
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall b.
[String]
-> (PTerm -> b)
-> StateT IState (WriterT FC (Parsec Void String)) b
expressionTactic ["search"] PTerm -> ElabShellCmd
ESearch ) StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(do String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved "doc"
Either Name Const
doc <- (Const -> Either Name Const
forall a b. b -> Either a b
Right (Const -> Either Name Const)
-> Parser IState Const
-> StateT
IState (WriterT FC (Parsec Void String)) (Either Name Const)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser IState Const
forall (m :: * -> *). Parsing m => m Const
constant) StateT IState (WriterT FC (Parsec Void String)) (Either Name Const)
-> StateT
IState (WriterT FC (Parsec Void String)) (Either Name Const)
-> StateT
IState (WriterT FC (Parsec Void String)) (Either Name Const)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Name -> Either Name Const
forall a b. a -> Either a b
Left (Name -> Either Name Const)
-> StateT IState (WriterT FC (Parsec Void String)) Name
-> StateT
IState (WriterT FC (Parsec Void String)) (Either Name Const)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT IState (WriterT FC (Parsec Void String)) Name
forall (m :: * -> *). (Parsing m, MonadState IState m) => m Name
fnName)
StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
ElabShellCmd
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Name Const -> ElabShellCmd
EDocStr Either Name Const
doc))
StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
-> String
-> StateT IState (WriterT FC (Parsec Void String)) ElabShellCmd
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "elab command"
expressionTactic :: [String]
-> (PTerm -> b)
-> StateT IState (WriterT FC (Parsec Void String)) b
expressionTactic cmds :: [String]
cmds tactic :: PTerm -> b
tactic =
do [StateT IState (WriterT FC (Parsec Void String)) ()]
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
asum ((String -> StateT IState (WriterT FC (Parsec Void String)) ())
-> [String] -> [StateT IState (WriterT FC (Parsec Void String)) ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => String -> m ()
reserved [String]
cmds)
PTerm
t <- IdrisParser PTerm -> IdrisParser PTerm
forall (f :: * -> *) b.
(MonadFail f, MonadParsec Void String f, MonadWriter FC f,
MonadState IState f) =>
f b -> f b
spaced (SyntaxInfo -> IdrisParser PTerm
expr SyntaxInfo
defaultSyntax)
IState
i <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
b -> StateT IState (WriterT FC (Parsec Void String)) b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> StateT IState (WriterT FC (Parsec Void String)) b)
-> b -> StateT IState (WriterT FC (Parsec Void String)) b
forall a b. (a -> b) -> a -> b
$ PTerm -> b
tactic (SyntaxInfo -> IState -> PTerm -> PTerm
desugar SyntaxInfo
defaultSyntax IState
i PTerm
t)
spaced :: f b -> f b
spaced parser :: f b
parser = f ()
forall (m :: * -> *). (Parsing m, MonadState IState m) => m ()
indentGt f () -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f b
parser
parseImports :: FilePath -> String -> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
parseImports :: String
-> String
-> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
parseImports fname :: String
fname input :: String
input
= do IState
i <- Idris IState
getIState
case Parser
IState
((Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark),
[(FC, OutputAnnotation)], IState)
-> IState
-> String
-> String
-> Either
ParseError
((Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark),
[(FC, OutputAnnotation)], IState)
forall st res.
Parser st res -> st -> String -> String -> Either ParseError res
runparser Parser
IState
((Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark),
[(FC, OutputAnnotation)], IState)
imports IState
i String
fname String
input of
Left err :: ParseError
err -> ParseError -> Idris OutputDoc
forall w. Message w => w -> Idris OutputDoc
formatMessage ParseError
err Idris OutputDoc
-> (OutputDoc
-> Idris
(Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark))
-> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
forall a. String -> Idris a
ifail (String
-> Idris
(Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark))
-> (OutputDoc -> String)
-> OutputDoc
-> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputDoc -> String
forall a. Show a => a -> String
show
Right (x :: (Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
x, annots :: [(FC, OutputAnnotation)]
annots, i :: IState
i) ->
do IState -> Idris ()
putIState IState
i
String
fname' <- 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
Dir.makeAbsolute String
fname
Set (FC', OutputAnnotation) -> Idris ()
sendHighlighting (Set (FC', OutputAnnotation) -> Idris ())
-> Set (FC', OutputAnnotation) -> Idris ()
forall a b. (a -> b) -> a -> b
$ [(FC', OutputAnnotation)] -> Set (FC', OutputAnnotation)
forall a. Ord a => [a] -> Set a
S.fromList ([(FC', OutputAnnotation)] -> Set (FC', OutputAnnotation))
-> [(FC', OutputAnnotation)] -> Set (FC', OutputAnnotation)
forall a b. (a -> b) -> a -> b
$ [(FC, OutputAnnotation)] -> String -> [(FC', OutputAnnotation)]
addPath [(FC, OutputAnnotation)]
annots String
fname'
(Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
-> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
x
where imports :: IdrisParser ((Maybe (Docstring ()), [String],
[ImportInfo],
Maybe Mark),
[(FC, OutputAnnotation)], IState)
imports :: Parser
IState
((Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark),
[(FC, OutputAnnotation)], IState)
imports = do StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT IState (WriterT FC (Parsec Void String)) ()
shebang
StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => m ()
whiteSpace
(mdoc :: Maybe (Docstring ())
mdoc, mname :: [String]
mname, annots :: [(FC, OutputAnnotation)]
annots) <- IdrisParser
(Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])
moduleHeader
[ImportInfo]
ps_exp <- IdrisParser ImportInfo
-> StateT IState (WriterT FC (Parsec Void String)) [ImportInfo]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many IdrisParser ImportInfo
import_
Mark
mrk <- StateT IState (WriterT FC (Parsec Void String)) Mark
forall (m :: * -> *). Parsing m => m Mark
mark
Bool
isEof <- StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) Bool
forall (m :: * -> *) a. Parsing m => m a -> m Bool
lookAheadMatches StateT IState (WriterT FC (Parsec Void String)) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
let mrk' :: Maybe Mark
mrk' = if Bool
isEof
then Maybe Mark
forall a. Maybe a
Nothing
else Mark -> Maybe Mark
forall a. a -> Maybe a
Just Mark
mrk
IState
i <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
let ps :: [ImportInfo]
ps = [ImportInfo]
ps_exp
((Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark),
[(FC, OutputAnnotation)], IState)
-> Parser
IState
((Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark),
[(FC, OutputAnnotation)], IState)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (Docstring ())
mdoc, [String]
mname, [ImportInfo]
ps, Maybe Mark
mrk'), [(FC, OutputAnnotation)]
annots, IState
i)
addPath :: [(FC, OutputAnnotation)] -> FilePath -> [(FC', OutputAnnotation)]
addPath :: [(FC, OutputAnnotation)] -> String -> [(FC', OutputAnnotation)]
addPath [] _ = []
addPath ((fc :: FC
fc, AnnNamespace ns :: [Text]
ns Nothing) : annots :: [(FC, OutputAnnotation)]
annots) path :: String
path =
(FC -> FC'
FC' FC
fc, [Text] -> Maybe String -> OutputAnnotation
AnnNamespace [Text]
ns (String -> Maybe String
forall a. a -> Maybe a
Just String
path)) (FC', OutputAnnotation)
-> [(FC', OutputAnnotation)] -> [(FC', OutputAnnotation)]
forall a. a -> [a] -> [a]
: [(FC, OutputAnnotation)] -> String -> [(FC', OutputAnnotation)]
addPath [(FC, OutputAnnotation)]
annots String
path
addPath ((fc :: FC
fc,annot :: OutputAnnotation
annot):annots :: [(FC, OutputAnnotation)]
annots) path :: String
path = (FC -> FC'
FC' FC
fc, OutputAnnotation
annot) (FC', OutputAnnotation)
-> [(FC', OutputAnnotation)] -> [(FC', OutputAnnotation)]
forall a. a -> [a] -> [a]
: [(FC, OutputAnnotation)] -> String -> [(FC', OutputAnnotation)]
addPath [(FC, OutputAnnotation)]
annots String
path
shebang :: IdrisParser ()
shebang :: StateT IState (WriterT FC (Parsec Void String)) ()
shebang = String -> StateT IState (WriterT FC (Parsec Void String)) String
forall (m :: * -> *). Parsing m => String -> m String
string "#!" StateT IState (WriterT FC (Parsec Void String)) String
-> StateT IState (WriterT FC (Parsec Void String)) String
-> StateT IState (WriterT FC (Parsec Void String)) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IState (WriterT FC (Parsec Void String)) Char
-> StateT IState (WriterT FC (Parsec Void String)) String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Token String -> Bool)
-> StateT IState (WriterT FC (Parsec Void String)) Char
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy ((Token String -> Bool)
-> StateT IState (WriterT FC (Parsec Void String)) Char)
-> (Token String -> Bool)
-> StateT IState (WriterT FC (Parsec Void String)) Char
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEol) StateT IState (WriterT FC (Parsec Void String)) String
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => m ()
eol StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
-> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
fixColour :: Bool -> PP.Doc -> PP.Doc
fixColour :: Bool -> Doc -> Doc
fixColour False doc :: Doc
doc = Doc -> Doc
PP.plain Doc
doc
fixColour True doc :: Doc
doc = Doc
doc
parseProg :: SyntaxInfo -> FilePath -> String -> Maybe Mark -> Idris [PDecl]
parseProg :: SyntaxInfo -> String -> String -> Maybe Mark -> Idris [PDecl]
parseProg syn :: SyntaxInfo
syn fname :: String
fname input :: String
input mrk :: Maybe Mark
mrk
= do IState
i <- Idris IState
getIState
case Parser IState ([PDecl], IState)
-> IState
-> String
-> String
-> Either ParseError ([PDecl], IState)
forall st res.
Parser st res -> st -> String -> String -> Either ParseError res
runparser Parser IState ([PDecl], IState)
mainProg IState
i String
fname String
input of
Left err :: ParseError
err -> do ParseError -> Idris ()
forall w. Message w => w -> Idris ()
emitWarning ParseError
err
IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState
i { errSpan :: Maybe FC
errSpan = FC -> Maybe FC
forall a. a -> Maybe a
Just (ParseError -> FC
forall a. Message a => a -> FC
messageExtent ParseError
err) })
[PDecl] -> Idris [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Right (x :: [PDecl]
x, i :: IState
i) -> do IState -> Idris ()
putIState IState
i
Idris ()
reportParserWarnings
[PDecl] -> Idris [PDecl]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PDecl] -> Idris [PDecl]) -> [PDecl] -> Idris [PDecl]
forall a b. (a -> b) -> a -> b
$ [PDecl] -> [PDecl]
collect [PDecl]
x
where mainProg :: IdrisParser ([PDecl], IState)
mainProg :: Parser IState ([PDecl], IState)
mainProg = case Maybe Mark
mrk of
Nothing -> do IState
i <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get; ([PDecl], IState) -> Parser IState ([PDecl], IState)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], IState
i)
Just mrk :: Mark
mrk -> do
Mark -> StateT IState (WriterT FC (Parsec Void String)) ()
forall (m :: * -> *). Parsing m => Mark -> m ()
restore Mark
mrk
[PDecl]
ds <- SyntaxInfo -> IdrisParser [PDecl]
prog SyntaxInfo
syn
IState
i' <- StateT IState (WriterT FC (Parsec Void String)) IState
forall s (m :: * -> *). MonadState s m => m s
get
([PDecl], IState) -> Parser IState ([PDecl], IState)
forall (m :: * -> *) a. Monad m => a -> m a
return ([PDecl]
ds, IState
i')
collect :: [PDecl] -> [PDecl]
collect :: [PDecl] -> [PDecl]
collect (c :: PDecl
c@(PClauses _ o :: FnOpts
o _ _) : ds :: [PDecl]
ds)
= Maybe Name -> [PClause' PTerm] -> [PDecl] -> [PDecl]
clauses (PDecl -> Maybe Name
cname PDecl
c) [] (PDecl
c PDecl -> [PDecl] -> [PDecl]
forall a. a -> [a] -> [a]
: [PDecl]
ds)
where clauses :: Maybe Name -> [PClause] -> [PDecl] -> [PDecl]
clauses :: Maybe Name -> [PClause' PTerm] -> [PDecl] -> [PDecl]
clauses j :: Maybe Name
j@(Just n :: Name
n) acc :: [PClause' PTerm]
acc (PClauses fc :: FC
fc _ _ [PClause fc' :: FC
fc' n' :: Name
n' l :: PTerm
l ws :: [PTerm]
ws r :: PTerm
r w :: [PDecl]
w] : ds :: [PDecl]
ds)
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = Maybe Name -> [PClause' PTerm] -> [PDecl] -> [PDecl]
clauses Maybe Name
j (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
l [PTerm]
ws PTerm
r ([PDecl] -> [PDecl]
collect [PDecl]
w) PClause' PTerm -> [PClause' PTerm] -> [PClause' PTerm]
forall a. a -> [a] -> [a]
: [PClause' PTerm]
acc) [PDecl]
ds
clauses j :: Maybe Name
j@(Just n :: Name
n) acc :: [PClause' PTerm]
acc (PClauses fc :: FC
fc _ _ [PWith fc' :: FC
fc' n' :: Name
n' l :: PTerm
l ws :: [PTerm]
ws r :: PTerm
r pn :: Maybe (Name, FC)
pn w :: [PDecl]
w] : ds :: [PDecl]
ds)
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' = Maybe Name -> [PClause' PTerm] -> [PDecl] -> [PDecl]
clauses Maybe Name
j (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
l [PTerm]
ws PTerm
r Maybe (Name, FC)
pn ([PDecl] -> [PDecl]
collect [PDecl]
w) PClause' PTerm -> [PClause' PTerm] -> [PClause' PTerm]
forall a. a -> [a] -> [a]
: [PClause' PTerm]
acc) [PDecl]
ds
clauses (Just n :: Name
n) acc :: [PClause' PTerm]
acc xs :: [PDecl]
xs = FC -> FnOpts -> Name -> [PClause' PTerm] -> PDecl
forall t. FC -> FnOpts -> Name -> [PClause' t] -> PDecl' t
PClauses (PDecl -> FC
fcOf PDecl
c) FnOpts
o Name
n ([PClause' PTerm] -> [PClause' PTerm]
forall a. [a] -> [a]
reverse [PClause' PTerm]
acc) PDecl -> [PDecl] -> [PDecl]
forall a. a -> [a] -> [a]
: [PDecl] -> [PDecl]
collect [PDecl]
xs
clauses Nothing acc :: [PClause' PTerm]
acc (x :: PDecl
x:xs :: [PDecl]
xs) = [PDecl] -> [PDecl]
collect [PDecl]
xs
clauses Nothing acc :: [PClause' PTerm]
acc [] = []
cname :: PDecl -> Maybe Name
cname :: PDecl -> Maybe Name
cname (PClauses fc :: FC
fc _ _ [PClause _ n :: Name
n _ _ _ _]) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
cname (PClauses fc :: FC
fc _ _ [PWith _ n :: Name
n _ _ _ _ _]) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
cname (PClauses fc :: FC
fc _ _ [PClauseR _ _ _ _]) = Maybe Name
forall a. Maybe a
Nothing
cname (PClauses fc :: FC
fc _ _ [PWithR _ _ _ _ _]) = Maybe Name
forall a. Maybe a
Nothing
fcOf :: PDecl -> FC
fcOf :: PDecl -> FC
fcOf (PClauses fc :: FC
fc _ _ _) = FC
fc
collect (PParams f :: FC
f ns :: [(Name, PTerm)]
ns ps :: [PDecl]
ps : ds :: [PDecl]
ds) = FC -> [(Name, PTerm)] -> [PDecl] -> PDecl
forall t. FC -> [(Name, t)] -> [PDecl' t] -> PDecl' t
PParams FC
f [(Name, PTerm)]
ns ([PDecl] -> [PDecl]
collect [PDecl]
ps) PDecl -> [PDecl] -> [PDecl]
forall a. a -> [a] -> [a]
: [PDecl] -> [PDecl]
collect [PDecl]
ds
collect (POpenInterfaces f :: FC
f ns :: [Name]
ns ps :: [PDecl]
ps : ds :: [PDecl]
ds) = FC -> [Name] -> [PDecl] -> PDecl
forall t. FC -> [Name] -> [PDecl' t] -> PDecl' t
POpenInterfaces FC
f [Name]
ns ([PDecl] -> [PDecl]
collect [PDecl]
ps) PDecl -> [PDecl] -> [PDecl]
forall a. a -> [a] -> [a]
: [PDecl] -> [PDecl]
collect [PDecl]
ds
collect (PMutual f :: FC
f ms :: [PDecl]
ms : ds :: [PDecl]
ds) = FC -> [PDecl] -> PDecl
forall t. FC -> [PDecl' t] -> PDecl' t
PMutual FC
f ([PDecl] -> [PDecl]
collect [PDecl]
ms) PDecl -> [PDecl] -> [PDecl]
forall a. a -> [a] -> [a]
: [PDecl] -> [PDecl]
collect [PDecl]
ds
collect (PNamespace ns :: String
ns fc :: FC
fc ps :: [PDecl]
ps : ds :: [PDecl]
ds) = String -> FC -> [PDecl] -> PDecl
forall t. String -> FC -> [PDecl' t] -> PDecl' t
PNamespace String
ns FC
fc ([PDecl] -> [PDecl]
collect [PDecl]
ps) PDecl -> [PDecl] -> [PDecl]
forall a. a -> [a] -> [a]
: [PDecl] -> [PDecl]
collect [PDecl]
ds
collect (PInterface doc :: Docstring (Either Err PTerm)
doc f :: SyntaxInfo
f s :: FC
s cs :: [(Name, PTerm)]
cs n :: Name
n nfc :: FC
nfc ps :: [(Name, FC, PTerm)]
ps pdocs :: [(Name, Docstring (Either Err PTerm))]
pdocs fds :: [(Name, FC)]
fds ds :: [PDecl]
ds cn :: Maybe (Name, FC)
cn cd :: Docstring (Either Err PTerm)
cd : ds' :: [PDecl]
ds')
= 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
f FC
s [(Name, PTerm)]
cs Name
n FC
nfc [(Name, FC, PTerm)]
ps [(Name, Docstring (Either Err PTerm))]
pdocs [(Name, FC)]
fds ([PDecl] -> [PDecl]
collect [PDecl]
ds) Maybe (Name, FC)
cn Docstring (Either Err PTerm)
cd PDecl -> [PDecl] -> [PDecl]
forall a. a -> [a] -> [a]
: [PDecl] -> [PDecl]
collect [PDecl]
ds'
collect (PImplementation doc :: Docstring (Either Err PTerm)
doc argDocs :: [(Name, Docstring (Either Err PTerm))]
argDocs f :: SyntaxInfo
f s :: FC
s cs :: [(Name, PTerm)]
cs pnames :: [Name]
pnames acc :: Accessibility
acc opts :: FnOpts
opts n :: Name
n nfc :: FC
nfc ps :: [PTerm]
ps pextra :: [(Name, PTerm)]
pextra t :: PTerm
t en :: Maybe Name
en ds :: [PDecl]
ds : ds' :: [PDecl]
ds')
= Docstring (Either Err PTerm)
-> [(Name, Docstring (Either Err PTerm))]
-> SyntaxInfo
-> FC
-> [(Name, PTerm)]
-> [Name]
-> Accessibility
-> FnOpts
-> 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
-> FnOpts
-> 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
f FC
s [(Name, PTerm)]
cs [Name]
pnames Accessibility
acc FnOpts
opts Name
n FC
nfc [PTerm]
ps [(Name, PTerm)]
pextra PTerm
t Maybe Name
en ([PDecl] -> [PDecl]
collect [PDecl]
ds) PDecl -> [PDecl] -> [PDecl]
forall a. a -> [a] -> [a]
: [PDecl] -> [PDecl]
collect [PDecl]
ds'
collect (d :: PDecl
d : ds :: [PDecl]
ds) = PDecl
d PDecl -> [PDecl] -> [PDecl]
forall a. a -> [a] -> [a]
: [PDecl] -> [PDecl]
collect [PDecl]
ds
collect [] = []
loadModule :: FilePath -> IBCPhase -> Idris (Maybe String)
loadModule :: String -> IBCPhase -> Idris (Maybe String)
loadModule f :: String
f phase :: IBCPhase
phase
= Idris (Maybe String)
-> (Err -> Idris (Maybe String)) -> Idris (Maybe String)
forall a. Idris a -> (Err -> Idris a) -> Idris a
idrisCatch (String -> IBCPhase -> Idris (Maybe String)
loadModule' String
f IBCPhase
phase)
(\e :: Err
e -> do FC -> Idris ()
setErrSpan (Err -> FC
getErrSpan Err
e)
IState
ist <- Idris IState
getIState
FC -> OutputDoc -> Idris ()
iWarn (Err -> FC
getErrSpan Err
e) (OutputDoc -> Idris ()) -> OutputDoc -> Idris ()
forall a b. (a -> b) -> a -> b
$ IState -> Err -> OutputDoc
pprintErr IState
ist Err
e
Maybe String -> Idris (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing)
loadModule' :: FilePath -> IBCPhase -> Idris (Maybe String)
loadModule' :: String -> IBCPhase -> Idris (Maybe String)
loadModule' f :: String
f phase :: IBCPhase
phase
= do IState
i <- Idris IState
getIState
let file :: String
file = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ' ') String
f
String
ibcsd <- IState -> Idris String
valIBCSubDir IState
i
[String]
ids <- String -> Idris [String]
rankedImportDirs String
file
IFileType
fp <- [String] -> String -> String -> Idris IFileType
findImport [String]
ids String
ibcsd String
file
if String
file String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` IState -> [String]
imported IState
i
then do Int -> String -> Idris ()
logParser 1 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Already read " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
Maybe String -> Idris (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
else do IState -> Idris ()
putIState (IState
i { imported :: [String]
imported = String
file String -> [String] -> [String]
forall a. a -> [a] -> [a]
: IState -> [String]
imported IState
i })
case IFileType
fp of
IDR fn :: String
fn -> Bool -> String -> Maybe Int -> Idris ()
loadSource Bool
False String
fn Maybe Int
forall a. Maybe a
Nothing
LIDR fn :: String
fn -> Bool -> String -> Maybe Int -> Idris ()
loadSource Bool
True String
fn Maybe Int
forall a. Maybe a
Nothing
IBC fn :: String
fn src :: IFileType
src ->
Idris () -> (Err -> Idris ()) -> Idris ()
forall a. Idris a -> (Err -> Idris a) -> Idris a
idrisCatch (Bool -> IBCPhase -> String -> Idris ()
loadIBC Bool
True IBCPhase
phase String
fn)
(\c :: Err
c -> do Int -> String -> Idris ()
logParser 1 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ " failed " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IState -> Err -> String
pshow IState
i Err
c
case IFileType
src of
IDR sfn :: String
sfn -> Bool -> String -> Maybe Int -> Idris ()
loadSource Bool
False String
sfn Maybe Int
forall a. Maybe a
Nothing
LIDR sfn :: String
sfn -> Bool -> String -> Maybe Int -> Idris ()
loadSource Bool
True String
sfn Maybe Int
forall a. Maybe a
Nothing)
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
$ String -> Maybe String
forall a. a -> Maybe a
Just String
file
loadFromIFile :: Bool -> IBCPhase -> IFileType -> Maybe Int -> Idris ()
loadFromIFile :: Bool -> IBCPhase -> IFileType -> Maybe Int -> Idris ()
loadFromIFile reexp :: Bool
reexp phase :: IBCPhase
phase i :: IFileType
i@(IBC fn :: String
fn src :: IFileType
src) maxline :: Maybe Int
maxline
= do Int -> String -> Idris ()
logParser 1 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Skipping " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IFileType -> String
getSrcFile IFileType
i
Int -> String -> Idris ()
logParser 3 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "loadFromIFile i" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IFileType -> String
forall a. Show a => a -> String
show IFileType
i
Idris () -> (Err -> Idris ()) -> Idris ()
forall a. Idris a -> (Err -> Idris a) -> Idris a
idrisCatch (Bool -> IBCPhase -> String -> Idris ()
loadIBC Bool
reexp IBCPhase
phase String
fn)
(\err :: Err
err -> Err -> Idris ()
forall a. Err -> Idris a
ierror (Err -> Idris ()) -> Err -> Idris ()
forall a b. (a -> b) -> a -> b
$ String -> Err -> Err
forall t. String -> Err' t -> Err' t
LoadingFailed String
fn Err
err)
where
getSrcFile :: IFileType -> String
getSrcFile (IDR fn :: String
fn) = String
fn
getSrcFile (LIDR fn :: String
fn) = String
fn
getSrcFile (IBC f :: String
f src :: IFileType
src) = IFileType -> String
getSrcFile IFileType
src
loadFromIFile _ _ (IDR fn :: String
fn) maxline :: Maybe Int
maxline = Bool -> String -> Maybe Int -> Idris ()
loadSource' Bool
False String
fn Maybe Int
maxline
loadFromIFile _ _ (LIDR fn :: String
fn) maxline :: Maybe Int
maxline = Bool -> String -> Maybe Int -> Idris ()
loadSource' Bool
True String
fn Maybe Int
maxline
loadSource' :: Bool -> FilePath -> Maybe Int -> Idris ()
loadSource' :: Bool -> String -> Maybe Int -> Idris ()
loadSource' lidr :: Bool
lidr r :: String
r maxline :: Maybe Int
maxline
= Idris () -> (Err -> Idris ()) -> Idris ()
forall a. Idris a -> (Err -> Idris a) -> Idris a
idrisCatch (Bool -> String -> Maybe Int -> Idris ()
loadSource Bool
lidr String
r Maybe Int
maxline)
(\e :: Err
e -> do FC -> Idris ()
setErrSpan (Err -> FC
getErrSpan Err
e)
IState
ist <- Idris IState
getIState
case Err
e of
At f :: FC
f e' :: Err
e' -> FC -> OutputDoc -> Idris ()
iWarn FC
f (IState -> Err -> OutputDoc
pprintErr IState
ist Err
e')
_ -> FC -> OutputDoc -> Idris ()
iWarn (Err -> FC
getErrSpan Err
e) (IState -> Err -> OutputDoc
pprintErr IState
ist Err
e))
loadSource :: Bool -> FilePath -> Maybe Int -> Idris ()
loadSource :: Bool -> String -> Maybe Int -> Idris ()
loadSource lidr :: Bool
lidr f :: String
f toline :: Maybe Int
toline
= do Int -> String -> Idris ()
logParser 1 ("Reading " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f)
Int -> String -> Idris ()
iReport 2 ("Reading " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f)
IState
i <- Idris IState
getIState
let def_total :: DefaultTotality
def_total = IState -> DefaultTotality
default_total IState
i
String
file_in <- 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
readSource String
f
String
file <- if Bool
lidr then TC String -> Idris String
forall a. TC a -> Idris a
tclift (TC String -> Idris String) -> TC String -> Idris String
forall a b. (a -> b) -> a -> b
$ String -> String -> TC String
unlit String
f String
file_in else String -> Idris String
forall (m :: * -> *) a. Monad m => a -> m a
return String
file_in
(mdocs :: Maybe (Docstring ())
mdocs, mname :: [String]
mname, imports_in :: [ImportInfo]
imports_in, pos :: Maybe Mark
pos) <- String
-> String
-> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe Mark)
parseImports String
f String
file
[String]
ai <- Idris [String]
getAutoImports
let imports :: [ImportInfo]
imports = (String -> ImportInfo) -> [String] -> [ImportInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\n :: String
n -> Bool
-> String -> Maybe (String, FC) -> [Text] -> FC -> FC -> ImportInfo
ImportInfo Bool
True String
n Maybe (String, FC)
forall a. Maybe a
Nothing [] FC
NoFC FC
NoFC) [String]
ai [ImportInfo] -> [ImportInfo] -> [ImportInfo]
forall a. [a] -> [a] -> [a]
++ [ImportInfo]
imports_in
[String]
ids <- String -> Idris [String]
rankedImportDirs String
f
String
ibcsd <- IState -> Idris String
valIBCSubDir IState
i
let ibc :: String
ibc = String -> String -> String
ibcPathNoFallback String
ibcsd String
f
[(String, Int)]
impHashes <- Idris [(String, Int)]
-> (Err -> Idris [(String, Int)]) -> Idris [(String, Int)]
forall a. Idris a -> (Err -> Idris a) -> Idris a
idrisCatch (String -> Idris [(String, Int)]
getImportHashes String
ibc)
(\err :: Err
err -> [(String, Int)] -> Idris [(String, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
[Maybe (String, Int)]
newHashes <- ((Bool, String, [Text], FC)
-> StateT IState (ExceptT Err IO) (Maybe (String, Int)))
-> [(Bool, String, [Text], FC)]
-> StateT IState (ExceptT Err IO) [Maybe (String, Int)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ (_, f :: String
f, _, _) ->
do IFileType
fp <- [String] -> String -> String -> Idris IFileType
findImport [String]
ids String
ibcsd String
f
case IFileType
fp of
IBC fn :: String
fn src :: IFileType
src ->
StateT IState (ExceptT Err IO) (Maybe (String, Int))
-> (Err -> StateT IState (ExceptT Err IO) (Maybe (String, Int)))
-> StateT IState (ExceptT Err IO) (Maybe (String, Int))
forall a. Idris a -> (Err -> Idris a) -> Idris a
idrisCatch (do Int
hash <- String -> Idris Int
getIBCHash String
fn
Maybe (String, Int)
-> StateT IState (ExceptT Err IO) (Maybe (String, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, Int) -> Maybe (String, Int)
forall a. a -> Maybe a
Just (String
fn, Int
hash)))
(\err :: Err
err -> Maybe (String, Int)
-> StateT IState (ExceptT Err IO) (Maybe (String, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, Int)
forall a. Maybe a
Nothing)
_ -> Maybe (String, Int)
-> StateT IState (ExceptT Err IO) (Maybe (String, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, Int)
forall a. Maybe a
Nothing)
[(Bool
re, String
fn, [Text]
ns, FC
nfc) | ImportInfo re :: Bool
re fn :: String
fn _ ns :: [Text]
ns _ nfc :: FC
nfc <- [ImportInfo]
imports]
UTCTime
fmod <- IO UTCTime -> StateT IState (ExceptT Err IO) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> StateT IState (ExceptT Err IO) UTCTime)
-> IO UTCTime -> StateT IState (ExceptT Err IO) UTCTime
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
Dir.getModificationTime String
f
Bool
ibcexists <- IO Bool -> StateT IState (ExceptT Err IO) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT IState (ExceptT Err IO) Bool)
-> IO Bool -> StateT IState (ExceptT Err IO) Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
Dir.doesFileExist String
ibc
UTCTime
ibcmod <- if Bool
ibcexists
then IO UTCTime -> StateT IState (ExceptT Err IO) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> StateT IState (ExceptT Err IO) UTCTime)
-> IO UTCTime -> StateT IState (ExceptT Err IO) UTCTime
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
Dir.getModificationTime String
ibc
else UTCTime -> StateT IState (ExceptT Err IO) UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
fmod
Int -> String -> Idris ()
logParser 10 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ String
ibc String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UTCTime -> String
forall a. Show a => a -> String
show UTCTime
ibcmod
Int -> String -> Idris ()
logParser 10 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UTCTime -> String
forall a. Show a => a -> String
show UTCTime
fmod
Int -> String -> Idris ()
logParser 10 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ [(String, Int)] -> String
forall a. Show a => a -> String
show [(String, Int)]
impHashes String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Maybe (String, Int)] -> String
forall a. Show a => a -> String
show [Maybe (String, Int)]
newHashes
let needLoad :: Bool
needLoad = (UTCTime
ibcmod UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
fmod) Bool -> Bool -> Bool
||
([(String, Int)] -> [(String, Int)]
forall a. Ord a => [a] -> [a]
sort [(String, Int)]
impHashes [(String, Int)] -> [(String, Int)] -> Bool
forall a. Eq a => a -> a -> Bool
/= [(String, Int)] -> [(String, Int)]
forall a. Ord a => [a] -> [a]
sort ((Maybe (String, Int) -> Maybe (String, Int))
-> [Maybe (String, Int)] -> [(String, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Maybe (String, Int) -> Maybe (String, Int)
forall a. a -> a
id [Maybe (String, Int)]
newHashes))
if Bool -> Bool
not Bool
needLoad
then () -> Idris ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else do
Int -> String -> Idris ()
iReport 1 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Type checking " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
((Bool, String, [Text], FC) -> Idris ())
-> [(Bool, String, [Text], FC)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (re :: Bool
re, f :: String
f, ns :: [Text]
ns, nfc :: FC
nfc) ->
do IFileType
fp <- [String] -> String -> String -> Idris IFileType
findImport [String]
ids String
ibcsd String
f
case IFileType
fp of
LIDR fn :: String
fn -> String -> Idris ()
forall a. String -> Idris a
ifail (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "No ibc for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
IDR fn :: String
fn -> String -> Idris ()
forall a. String -> Idris a
ifail (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "No ibc for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
IBC fn :: String
fn src :: IFileType
src ->
do Bool -> IBCPhase -> String -> Idris ()
loadIBC Bool
True IBCPhase
IBC_Building String
fn
let srcFn :: Maybe String
srcFn = case IFileType
src of
IDR fn :: String
fn -> String -> Maybe String
forall a. a -> Maybe a
Just String
fn
LIDR fn :: String
fn -> String -> Maybe String
forall a. a -> Maybe a
Just String
fn
_ -> Maybe String
forall a. Maybe a
Nothing
Maybe String
srcFnAbs <- case Maybe String
srcFn of
Just fn :: String
fn -> (String -> Maybe String) -> Idris String -> Idris (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just (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
Dir.makeAbsolute String
fn)
Nothing -> Maybe String -> Idris (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
Set (FC', OutputAnnotation) -> Idris ()
sendHighlighting (Set (FC', OutputAnnotation) -> Idris ())
-> Set (FC', OutputAnnotation) -> Idris ()
forall a b. (a -> b) -> a -> b
$ [(FC', OutputAnnotation)] -> Set (FC', OutputAnnotation)
forall a. Ord a => [a] -> Set a
S.fromList [(FC -> FC'
FC' FC
nfc, [Text] -> Maybe String -> OutputAnnotation
AnnNamespace [Text]
ns Maybe String
srcFnAbs)])
[(Bool
re, String
fn, [Text]
ns, FC
nfc) | ImportInfo re :: Bool
re fn :: String
fn _ ns :: [Text]
ns _ nfc :: FC
nfc <- [ImportInfo]
imports]
Idris ()
reportParserWarnings
Idris ()
sendParserHighlighting
let modAliases :: Map [Text] [Text]
modAliases = [([Text], [Text])] -> Map [Text] [Text]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (String -> [Text]
prep String
alias, String -> [Text]
prep String
realName)
| ImportInfo { import_reexport :: ImportInfo -> Bool
import_reexport = Bool
reexport
, import_path :: ImportInfo -> String
import_path = String
realName
, import_rename :: ImportInfo -> Maybe (String, FC)
import_rename = Just (alias :: String
alias, _)
, import_location :: ImportInfo -> FC
import_location = FC
fc } <- [ImportInfo]
imports
]
prep :: String -> [Text]
prep = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> (String -> [String]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
Spl.splitOn [Char
pathSeparator]
aliasNames :: [(String, FC)]
aliasNames = [ (String
alias, FC
fc)
| ImportInfo { import_rename :: ImportInfo -> Maybe (String, FC)
import_rename = Just (alias :: String
alias, fc :: FC
fc)
} <- [ImportInfo]
imports
]
histogram :: [[(String, FC)]]
histogram = ((String, FC) -> (String, FC) -> Bool)
-> [(String, FC)] -> [[(String, FC)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> ((String, FC) -> String) -> (String, FC) -> (String, FC) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String, FC) -> String
forall a b. (a, b) -> a
fst) ([(String, FC)] -> [[(String, FC)]])
-> ([(String, FC)] -> [(String, FC)])
-> [(String, FC)]
-> [[(String, FC)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FC) -> (String, FC) -> Ordering)
-> [(String, FC)] -> [(String, FC)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((String, FC) -> String)
-> (String, FC) -> (String, FC) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (String, FC) -> String
forall a b. (a, b) -> a
fst) ([(String, FC)] -> [[(String, FC)]])
-> [(String, FC)] -> [[(String, FC)]]
forall a b. (a -> b) -> a -> b
$ [(String, FC)]
aliasNames
case ([(String, FC)] -> (String, FC))
-> [[(String, FC)]] -> [(String, FC)]
forall a b. (a -> b) -> [a] -> [b]
map [(String, FC)] -> (String, FC)
forall a. [a] -> a
head ([[(String, FC)]] -> [(String, FC)])
-> ([[(String, FC)]] -> [[(String, FC)]])
-> [[(String, FC)]]
-> [(String, FC)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, FC)] -> Bool) -> [[(String, FC)]] -> [[(String, FC)]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1) (Int -> Bool) -> ([(String, FC)] -> Int) -> [(String, FC)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, FC)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[(String, FC)]] -> [(String, FC)])
-> [[(String, FC)]] -> [(String, FC)]
forall a b. (a -> b) -> a -> b
$ [[(String, FC)]]
histogram of
[] -> Int -> String -> Idris ()
logParser 3 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Module aliases: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [([Text], [Text])] -> String
forall a. Show a => a -> String
show (Map [Text] [Text] -> [([Text], [Text])]
forall k a. Map k a -> [(k, a)]
M.toList Map [Text] [Text]
modAliases)
(n :: String
n,fc :: FC
fc):_ -> Err -> Idris ()
forall a. Err -> Idris a
throwError (Err -> Idris ()) -> (String -> Err) -> String -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FC -> Err -> Err
forall t. FC -> Err' t -> Err' t
At FC
fc (Err -> Err) -> (String -> Err) -> String -> Err
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
$ "import alias not unique: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
n
IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState
i { default_access :: Accessibility
default_access = Accessibility
Private, module_aliases :: Map [Text] [Text]
module_aliases = Map [Text] [Text]
modAliases })
Idris ()
clearIBC
(IBCWrite -> Idris ()) -> [IBCWrite] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ IBCWrite -> Idris ()
addIBC (((String, Int) -> IBCWrite) -> [(String, Int)] -> [IBCWrite]
forall a b. (a -> b) -> [a] -> [b]
map (\ (f :: String
f, h :: Int
h) -> String -> Int -> IBCWrite
IBCImportHash String
f Int
h)
((Maybe (String, Int) -> Maybe (String, Int))
-> [Maybe (String, Int)] -> [(String, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Maybe (String, Int) -> Maybe (String, Int)
forall a. a -> a
id [Maybe (String, Int)]
newHashes))
[String]
imps <- Idris [String]
allImportDirs
(IBCWrite -> Idris ()) -> [IBCWrite] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ IBCWrite -> Idris ()
addIBC ((String -> IBCWrite) -> [String] -> [IBCWrite]
forall a b. (a -> b) -> [a] -> [b]
map String -> IBCWrite
IBCImportDir [String]
imps)
((Bool, String) -> Idris ()) -> [(Bool, String)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IBCWrite -> Idris ()
addIBC (IBCWrite -> Idris ())
-> ((Bool, String) -> IBCWrite) -> (Bool, String) -> Idris ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, String) -> IBCWrite
IBCImport)
[ (Bool
reexport, String
realName)
| ImportInfo { import_reexport :: ImportInfo -> Bool
import_reexport = Bool
reexport
, import_path :: ImportInfo -> String
import_path = String
realName
} <- [ImportInfo]
imports
]
let syntax :: SyntaxInfo
syntax = SyntaxInfo
defaultSyntax{ syn_namespace :: [String]
syn_namespace = [String] -> [String]
forall a. [a] -> [a]
reverse [String]
mname,
maxline :: Maybe Int
maxline = Maybe Int
toline }
IState
ist <- Idris IState
getIState
let oldSpan :: Maybe FC
oldSpan = IState -> Maybe FC
idris_parsedSpan IState
ist
[PDecl]
ds' <- SyntaxInfo -> String -> String -> Maybe Mark -> Idris [PDecl]
parseProg SyntaxInfo
syntax String
f String
file Maybe Mark
pos
case ([PDecl]
ds', Maybe FC
oldSpan) of
([], Just fc :: FC
fc) ->
do IState
ist <- Idris IState
getIState
IState -> Idris ()
putIState IState
ist { idris_parsedSpan :: Maybe FC
idris_parsedSpan = Maybe FC
oldSpan
, ibc_write :: [IBCWrite]
ibc_write = FC -> IBCWrite
IBCParsedRegion FC
fc IBCWrite -> [IBCWrite] -> [IBCWrite]
forall a. a -> [a] -> [a]
:
IState -> [IBCWrite]
ibc_write IState
ist
}
_ -> () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Idris ()
sendParserHighlighting
let ds :: [PDecl]
ds = [String] -> [PDecl] -> [PDecl]
namespaces [String]
mname [PDecl]
ds'
Int -> String -> Idris ()
logParser 3 (OutputDoc -> String
forall a. Show a => a -> String
show (OutputDoc -> String) -> OutputDoc -> String
forall a b. (a -> b) -> a -> b
$ PPOption -> [PDecl] -> OutputDoc
showDecls PPOption
verbosePPOption [PDecl]
ds)
IState
i <- Idris IState
getIState
Int -> String -> Idris ()
logLvl 10 ([(Name, [PArg])] -> String
forall a. Show a => a -> String
show (Ctxt [PArg] -> [(Name, [PArg])]
forall a. Ctxt a -> [(Name, a)]
toAlist (IState -> Ctxt [PArg]
idris_implicits IState
i)))
Int -> String -> Idris ()
logLvl 3 ([FixDecl] -> String
forall a. Show a => a -> String
show (IState -> [FixDecl]
idris_infixes IState
i))
ElabInfo -> [PDecl] -> Idris ()
elabDecls (String -> ElabInfo
toplevelWith String
f) ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map PDecl -> PDecl
toMutual [PDecl]
ds)
IState
i <- Idris IState
getIState
(Name -> Idris ()) -> [Name] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\n :: Name
n -> do Int -> String -> Idris ()
logLvl 5 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Simplifying " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
n
Context
ctxt' <-
do Context
ctxt <- Idris Context
getContext
TC Context -> Idris Context
forall a. TC a -> Idris a
tclift (TC Context -> Idris Context) -> TC Context -> Idris Context
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> [[Name]] -> ErasureInfo -> Context -> TC Context
simplifyCasedef Name
n [] [] (IState -> ErasureInfo
getErasureInfo IState
i) Context
ctxt
Context -> Idris ()
setContext Context
ctxt')
(((FC, Name) -> Name) -> [(FC, Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (FC, Name) -> Name
forall a b. (a, b) -> b
snd (IState -> [(FC, Name)]
idris_totcheck IState
i))
Int -> String -> Idris ()
iReport 3 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Totality checking " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
Int -> String -> Idris ()
logLvl 1 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Totality checking " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
IState
i <- Idris IState
getIState
((FC, Name) -> Idris ()) -> [(FC, Name)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FC, Name) -> Idris ()
buildSCG (IState -> [(FC, Name)]
idris_totcheck IState
i)
((FC, Name) -> StateT IState (ExceptT Err IO) Totality)
-> [(FC, Name)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FC, Name) -> StateT IState (ExceptT Err IO) Totality
checkDeclTotality (IState -> [(FC, Name)]
idris_totcheck IState
i)
((FC, Name) -> Idris ()) -> [(FC, Name)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FC, Name) -> Idris ()
verifyTotality (IState -> [(FC, Name)]
idris_totcheck IState
i)
let deftots :: [(FC, Name)]
deftots = IState -> [(FC, Name)]
idris_defertotcheck IState
i
Int -> String -> Idris ()
logLvl 2 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Totality checking " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(FC, Name)] -> String
forall a. Show a => a -> String
show [(FC, Name)]
deftots
(Name -> Idris ()) -> [Name] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\x :: Name
x -> do Totality
tot <- Name -> StateT IState (ExceptT Err IO) Totality
getTotality Name
x
case Totality
tot of
Total _ ->
do let opts :: FnOpts
opts = case Name -> Ctxt FnOpts -> Maybe FnOpts
forall a. Name -> Ctxt a -> Maybe a
lookupCtxtExact Name
x (IState -> Ctxt FnOpts
idris_flags IState
i) of
Just os :: FnOpts
os -> FnOpts
os
Nothing -> []
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FnOpt
AssertTotal FnOpt -> FnOpts -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` FnOpts
opts) (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
Name -> Totality -> Idris ()
setTotality Name
x Totality
Unchecked
_ -> () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (((FC, Name) -> Name) -> [(FC, Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (FC, Name) -> Name
forall a b. (a, b) -> b
snd [(FC, Name)]
deftots)
((FC, Name) -> Idris ()) -> [(FC, Name)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FC, Name) -> Idris ()
buildSCG [(FC, Name)]
deftots
((FC, Name) -> StateT IState (ExceptT Err IO) Totality)
-> [(FC, Name)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FC, Name) -> StateT IState (ExceptT Err IO) Totality
checkDeclTotality [(FC, Name)]
deftots
Int -> String -> Idris ()
logLvl 1 ("Finished " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f)
String
ibcsd <- IState -> Idris String
valIBCSubDir IState
i
Int -> String -> Idris ()
logLvl 1 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Universe checking " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
Int -> String -> Idris ()
iReport 3 (String -> Idris ()) -> String -> Idris ()
forall a b. (a -> b) -> a -> b
$ "Universe checking " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
Idris ()
iucheck
IState
i <- Idris IState
getIState
Ctxt Accessibility -> Idris ()
addHides (IState -> Ctxt Accessibility
hide_list IState
i)
IState
i <- Idris IState
getIState
case Maybe (Docstring ())
mdocs of
Nothing -> () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just docs :: Docstring ()
docs -> SyntaxInfo -> [String] -> Docstring () -> Idris ()
addModDoc SyntaxInfo
syntax [String]
mname Docstring ()
docs
Bool
ok <- StateT IState (ExceptT Err IO) Bool
noErrors
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ok (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
do Idris () -> (Err -> Idris ()) -> Idris ()
forall a. Idris a -> (Err -> Idris a) -> Idris a
idrisCatch (do String -> String -> Idris ()
writeIBC String
f String
ibc; Idris ()
clearIBC)
(\c :: Err
c -> () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Bool
hl <- StateT IState (ExceptT Err IO) Bool
getDumpHighlighting
Bool -> Idris () -> Idris ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hl (Idris () -> Idris ()) -> Idris () -> Idris ()
forall a b. (a -> b) -> a -> b
$
Idris () -> (Err -> Idris ()) -> Idris ()
forall a. Idris a -> (Err -> Idris a) -> Idris a
idrisCatch (String -> Idris ()
writeHighlights String
f)
(Idris () -> Err -> Idris ()
forall a b. a -> b -> a
const (Idris () -> Err -> Idris ()) -> Idris () -> Err -> Idris ()
forall a b. (a -> b) -> a -> b
$ () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Idris ()
clearHighlights
IState
i <- Idris IState
getIState
IState -> Idris ()
putIState (IState
i { default_total :: DefaultTotality
default_total = DefaultTotality
def_total,
hide_list :: Ctxt Accessibility
hide_list = Ctxt Accessibility
forall k a. Map k a
emptyContext })
() -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
namespaces :: [String] -> [PDecl] -> [PDecl]
namespaces :: [String] -> [PDecl] -> [PDecl]
namespaces [] ds :: [PDecl]
ds = [PDecl]
ds
namespaces (x :: String
x:xs :: [String]
xs) ds :: [PDecl]
ds = [String -> FC -> [PDecl] -> PDecl
forall t. String -> FC -> [PDecl' t] -> PDecl' t
PNamespace String
x FC
NoFC ([String] -> [PDecl] -> [PDecl]
namespaces [String]
xs [PDecl]
ds)]
toMutual :: PDecl -> PDecl
toMutual :: PDecl -> PDecl
toMutual m :: PDecl
m@(PMutual _ d :: [PDecl]
d) = PDecl
m
toMutual (PNamespace x :: String
x fc :: FC
fc ds :: [PDecl]
ds) = String -> FC -> [PDecl] -> PDecl
forall t. String -> FC -> [PDecl' t] -> PDecl' t
PNamespace String
x FC
fc ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map PDecl -> PDecl
toMutual [PDecl]
ds)
toMutual (POpenInterfaces f :: FC
f ns :: [Name]
ns ds :: [PDecl]
ds) = FC -> [Name] -> [PDecl] -> PDecl
forall t. FC -> [Name] -> [PDecl' t] -> PDecl' t
POpenInterfaces FC
f [Name]
ns ((PDecl -> PDecl) -> [PDecl] -> [PDecl]
forall a b. (a -> b) -> [a] -> [b]
map PDecl -> PDecl
toMutual [PDecl]
ds)
toMutual x :: PDecl
x = let r :: PDecl
r = FC -> [PDecl] -> PDecl
forall t. FC -> [PDecl' t] -> PDecl' t
PMutual (String -> FC
fileFC "single mutual") [PDecl
x] in
case PDecl
x of
PClauses{} -> PDecl
r
PInterface{} -> PDecl
r
PData{} -> PDecl
r
PImplementation{} -> PDecl
r
_ -> PDecl
x
addModDoc :: SyntaxInfo -> [String] -> Docstring () -> Idris ()
addModDoc :: SyntaxInfo -> [String] -> Docstring () -> Idris ()
addModDoc syn :: SyntaxInfo
syn mname :: [String]
mname docs :: Docstring ()
docs =
do IState
ist <- Idris IState
getIState
Docstring DocTerm
docs' <- ElabInfo
-> Docstring (Either Err PTerm) -> Idris (Docstring DocTerm)
elabDocTerms (String -> ElabInfo
toplevelWith String
f) (IState -> Docstring (Either Err PTerm)
parsedDocs IState
ist)
let modDocs' :: Ctxt (Docstring DocTerm)
modDocs' = Name
-> Docstring DocTerm
-> Ctxt (Docstring DocTerm)
-> Ctxt (Docstring DocTerm)
forall a. Name -> a -> Ctxt a -> Ctxt a
addDef Name
docName Docstring DocTerm
docs' (IState -> Ctxt (Docstring DocTerm)
idris_moduledocs IState
ist)
IState -> Idris ()
putIState IState
ist { idris_moduledocs :: Ctxt (Docstring DocTerm)
idris_moduledocs = Ctxt (Docstring DocTerm)
modDocs' }
IBCWrite -> Idris ()
addIBC (Name -> IBCWrite
IBCModDocs Name
docName)
where
docName :: Name
docName = Name -> [Text] -> Name
NS Name
modDocName ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
mname))
parsedDocs :: IState -> Docstring (Either Err PTerm)
parsedDocs ist :: IState
ist = (String -> Either Err PTerm)
-> Docstring () -> Docstring (Either Err PTerm)
forall a b. (String -> b) -> Docstring a -> Docstring b
annotCode (SyntaxInfo -> IState -> String -> Either Err PTerm
tryFullExpr SyntaxInfo
syn IState
ist) Docstring ()
docs
addHides :: Ctxt Accessibility -> Idris ()
addHides :: Ctxt Accessibility -> Idris ()
addHides xs :: Ctxt Accessibility
xs = ((Name, Accessibility) -> Idris ())
-> [(Name, Accessibility)] -> Idris ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Name, Accessibility) -> Idris ()
doHide (Ctxt Accessibility -> [(Name, Accessibility)]
forall a. Ctxt a -> [(Name, a)]
toAlist Ctxt Accessibility
xs)
where doHide :: (Name, Accessibility) -> Idris ()
doHide (n :: Name
n, a :: Accessibility
a) = do Name -> Accessibility -> Idris ()
setAccessibility Name
n Accessibility
a
IBCWrite -> Idris ()
addIBC (Name -> Accessibility -> IBCWrite
IBCAccess Name
n Accessibility
a)