{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Inferno.Parse
( Comment (..),
OpsTable,
TopLevelDefn (..),
QQDefinition (..),
InfernoParsingError (..),
topLevel,
expr,
parseExpr,
parseType,
modulesParser,
prettyError,
rws,
)
where
import Control.Applicative (Alternative ((<|>)))
import Control.Monad (foldM, void, when)
import Control.Monad.Combinators.Expr
( Operator (InfixL, InfixN, InfixR, Prefix),
makeExprParser,
)
import Control.Monad.Reader (ReaderT (..), ask, withReaderT)
import Control.Monad.Writer (WriterT (..), tell)
import Data.Bifunctor (bimap)
import Data.Char (isAlphaNum, isSpace)
import Data.Data (Data)
import Data.Either (partitionEithers)
import qualified Data.IntMap as IntMap
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NEList
import qualified Data.Map as Map
import Data.Monoid (Endo (..))
import qualified Data.Set as Set
import Data.Text (Text, pack, singleton, unpack)
import qualified Data.Text as Text
import Debug.Trace
import Inferno.Infer.Env (closeOver)
import Inferno.Parse.Error (prettyError)
import Inferno.Types.Syntax
( Comment (..),
Expr (..),
ExtIdent (ExtIdent),
Fixity (..),
Ident (Ident),
ImplExpl (Expl, Impl),
Import (..),
InfixFixity (..),
Lit (..),
ModuleName (..),
Pat (..),
Scoped (..),
SigVar (..),
TList (..),
fromEitherList,
fromScoped,
rws,
tListFromList,
)
import Inferno.Types.Type
( BaseType (..),
ImplType (..),
InfernoType (..),
TCScheme (..),
TV (TV),
TypeClass (TypeClass),
)
import Text.Megaparsec
( MonadParsec
( eof,
hidden,
label,
notFollowedBy,
takeWhile1P,
takeWhileP,
try
),
ParseError,
ParseErrorBundle (ParseErrorBundle),
Parsec,
ShowErrorComponent (..),
SourcePos (..),
anySingle,
attachSourcePos,
between,
customFailure,
errorOffset,
getSourcePos,
many,
manyTill,
optional,
runParser,
satisfy,
sepBy1,
some,
unPos,
(<?>),
)
import Text.Megaparsec.Char
( alphaNumChar,
char,
char',
letterChar,
spaceChar,
string,
)
import qualified Text.Megaparsec.Char.Lexer as Lexer
uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)
uncurry3 :: forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
f ~(a
a, b
b, c
c) = a -> b -> c -> d
f a
a b
b c
c
type = Endo [Comment SourcePos]
output :: Comment SourcePos -> SomeParser r ()
output :: forall r. Comment SourcePos -> SomeParser r ()
output Comment SourcePos
x = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Endo a
Endo ([Comment SourcePos
x] forall a. Semigroup a => a -> a -> a
<>)
type Parser = ReaderT (OpsTable, Map.Map ModuleName OpsTable) (WriterT Comments (Parsec InfernoParsingError Text))
type SomeParser r = ReaderT r (WriterT Comments (Parsec InfernoParsingError Text))
skipLineComment :: SomeParser r ()
= do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Text
comment <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"//" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just [Char]
"character") (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
SourcePos
endPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Comment SourcePos -> SomeParser r ()
output forall a b. (a -> b) -> a -> b
$ forall pos. pos -> Text -> pos -> Comment pos
LineComment SourcePos
startPos (Text -> Text
Text.strip Text
comment) SourcePos
endPos
skipBlockComment :: SomeParser r ()
= do
startPos :: SourcePos
startPos@(SourcePos [Char]
_ Pos
_ Pos
col) <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
[Char]
comment <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"/*" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"*/")
SourcePos
endPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Comment SourcePos -> SomeParser r ()
output forall a b. (a -> b) -> a -> b
$
forall pos. pos -> Text -> pos -> Comment pos
BlockComment
SourcePos
startPos
(HasCallStack => Text -> Text -> Text -> Text
Text.replace ([Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ Char
'\n' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
List.replicate (Pos -> Int
unPos Pos
col forall a. Num a => a -> a -> a
- Int
1) Char
' ') Text
"\n" forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack [Char]
comment)
SourcePos
endPos
sc :: SomeParser r ()
sc :: forall r. SomeParser r ()
sc = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
Lexer.space (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar) forall r. SomeParser r ()
skipLineComment forall r. SomeParser r ()
skipBlockComment
lexeme :: SomeParser r a -> SomeParser r a
lexeme :: forall r a. SomeParser r a -> SomeParser r a
lexeme = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
Lexer.lexeme forall r. SomeParser r ()
sc
symbol :: Text -> SomeParser r Text
symbol :: forall r. Text -> SomeParser r Text
symbol = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
Lexer.symbol forall r. SomeParser r ()
sc
parens :: SomeParser r a -> SomeParser r a
parens :: forall r a. SomeParser r a -> SomeParser r a
parens SomeParser r a
p = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall r. Text -> SomeParser r Text
symbol Text
"(") (forall r. Text -> SomeParser r Text
symbol Text
")") SomeParser r a
p
rword :: Text -> SomeParser r ()
rword :: forall r. Text -> SomeParser r ()
rword Text
w = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
w forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy forall r. SomeParser r Char
alphaNumCharOrSeparator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall r. SomeParser r ()
sc
isAlphaNumOrSeparator :: Char -> Bool
isAlphaNumOrSeparator :: Char -> Bool
isAlphaNumOrSeparator Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
{-# INLINE isAlphaNumOrSeparator #-}
alphaNumCharOrSeparator :: SomeParser r Char
alphaNumCharOrSeparator :: forall r. SomeParser r Char
alphaNumCharOrSeparator = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isAlphaNumOrSeparator forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"alphanumeric character or '_'"
{-# INLINE alphaNumCharOrSeparator #-}
variable :: Parser Text
variable :: Parser Text
variable = do
(OpsTable
opsTable, Map ModuleName OpsTable
_) <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall {r}.
ReaderT r (WriterT Comments (Parsec InfernoParsingError Text)) Text
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, MonadFail m) =>
t [(a, b, Text)] -> Text -> m Text
check OpsTable
opsTable)
where
p :: ReaderT r (WriterT Comments (Parsec InfernoParsingError Text)) Text
p = [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall r. SomeParser r Char
alphaNumCharOrSeparator)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a variable")
check :: t [(a, b, Text)] -> Text -> m Text
check t [(a, b, Text)]
oT Text
x =
if Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
rws forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map (\(a
_, b
_, Text
i) -> Text
i) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [(a, b, Text)]
oT)
then forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Keyword " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Text
x forall a. Semigroup a => a -> a -> a
<> [Char]
" cannot be a variable/function name"
else forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
mIdent :: Parser (SourcePos, Maybe Ident)
mIdent :: Parser (SourcePos, Maybe Ident)
mIdent = forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
(SourcePos
startPos,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Ident
Ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing Char -> Bool
isAlphaNumOrSeparator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos
startPos, forall a. Maybe a
Nothing)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a wildcard parameter '_'"
mExtIdent :: Parser (SourcePos, Maybe ExtIdent)
mExtIdent :: Parser (SourcePos, Maybe ExtIdent)
mExtIdent = forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
(SourcePos
startPos,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Int Text -> ExtIdent
ExtIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing Char -> Bool
isAlphaNumOrSeparator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos
startPos, forall a. Maybe a
Nothing)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a wildcard parameter '_'"
implicitVariable :: Parser Text
implicitVariable :: Parser Text
implicitVariable = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'?' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Text -> Text
Text.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing Char -> Bool
isAlphaNumOrSeparator)
enumConstructor :: SomeParser r Ident
enumConstructor :: forall r. SomeParser r Ident
enumConstructor =
Text -> Ident
Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'#' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing Char -> Bool
isAlphaNumOrSeparator) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"an enum constructor\nfor example: #true, #false"
signedInteger :: Num a => Parser a
signedInteger :: forall a. Num a => Parser a
signedInteger = forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
Lexer.signed (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing Char -> Bool
isHSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lexer.decimal
signedFloat :: Parser Double
signedFloat :: Parser Double
signedFloat = forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
Lexer.signed (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing Char -> Bool
isHSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
Lexer.float
enumE :: (SourcePos -> () -> Scoped ModuleName -> Ident -> f) -> Parser f
enumE :: forall f.
(SourcePos -> () -> Scoped ModuleName -> Ident -> f) -> Parser f
enumE SourcePos -> () -> Scoped ModuleName -> Ident -> f
f = do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (SourcePos -> () -> Scoped ModuleName -> Ident -> f
f SourcePos
startPos () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Scoped a
Scope forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ModuleName
ModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall r. SomeParser r Ident
enumConstructor)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SourcePos -> () -> Scoped ModuleName -> Ident -> f
f SourcePos
startPos () forall a. Scoped a
LocalScope forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r. SomeParser r Ident
enumConstructor forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'.')
implVarE :: Parser (Expr () SourcePos)
implVarE :: Parser (Expr () SourcePos)
implVarE = do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var SourcePos
startPos () forall a. Scoped a
LocalScope forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtIdent -> ImplExpl
Impl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Int Text -> ExtIdent
ExtIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
implicitVariable
intE, doubleE :: Parser (Expr () SourcePos)
intE :: Parser (Expr () SourcePos)
intE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a number\nfor example: 42, 3.1415, (-6)" forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> Lit -> Expr hash pos
Lit SourcePos
startPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Lit
LInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lexer.decimal
doubleE :: Parser (Expr () SourcePos)
doubleE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a number\nfor example: 42, 3.1415, (-6)" forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> Lit -> Expr hash pos
Lit SourcePos
startPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Lit
LDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
Lexer.float
hexadecimal :: (SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
hexadecimal :: forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
hexadecimal SourcePos -> Lit -> f SourcePos
f = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a hexadecimal number\nfor example: 0xE907, 0XE907" forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ SourcePos -> Lit -> f SourcePos
f SourcePos
startPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Lit
LHex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'0' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char' Char
'x' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lexer.hexadecimal)
signedIntE, signedDoubleE :: (SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
signedIntE :: forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
signedIntE SourcePos -> Lit -> f SourcePos
f = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a number\nfor example: 42, 3.1415, (-6)" forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ SourcePos -> Lit -> f SourcePos
f SourcePos
startPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Lit
LInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Parser a
signedInteger
signedDoubleE :: forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
signedDoubleE SourcePos -> Lit -> f SourcePos
f = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a number\nfor example: 42, 3.1415, (-6)" forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ SourcePos -> Lit -> f SourcePos
f SourcePos
startPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Lit
LDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
signedFloat
noneE :: (SourcePos -> a) -> Parser a
noneE :: forall a. (SourcePos -> a) -> Parser a
noneE SourcePos -> a
e = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"an optional\nfor example: Some x, None" forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ SourcePos -> a
e SourcePos
startPos) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"None")
someE :: (SourcePos -> t -> a) -> Parser t -> Parser a
someE :: forall t a. (SourcePos -> t -> a) -> Parser t -> Parser a
someE SourcePos -> t -> a
f Parser t
p = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"an optional\nfor example: Some x, None" forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Some")
SourcePos -> t -> a
f SourcePos
startPos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser t
p
stringE :: (SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
stringE :: forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
stringE SourcePos -> Lit -> f SourcePos
f = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a string\nfor example: \"hello world\"" forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ SourcePos -> Lit -> f SourcePos
f SourcePos
startPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Lit
LText forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
Char
charNoNewline (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\"'))
where
charNoNewline :: ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
Char
charNoNewline = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\n') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
Lexer.charLiteral
interpolatedStringE, arrayComprE, arrayE :: Parser (Expr () SourcePos)
interpolatedStringE :: Parser (Expr () SourcePos)
interpolatedStringE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"an interpolated string\nfor example: `hello ${1 + 2}`" forall a b. (a -> b) -> a -> b
$
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ do
startPos :: SourcePos
startPos@(SourcePos [Char]
_ Pos
_ Pos
col) <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
[Either Text (SourcePos, Expr () SourcePos, SourcePos)]
es <- forall e. [Either Text e] -> [Either Text e]
mkInterpolatedString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'`' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[Either Text (SourcePos, Expr () SourcePos, SourcePos)]
go)
SourcePos
endPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
return $ forall hash pos.
pos -> SomeIStr (pos, Expr hash pos, pos) -> pos -> Expr hash pos
InterpolatedString SourcePos
startPos (forall e. [Either Text e] -> SomeIStr e
fromEitherList forall a b. (a -> b) -> a -> b
$ forall {p :: * -> * -> *} {d}.
Bifunctor p =>
Int -> [p Text d] -> [p Text d]
fixSpacing (Pos -> Int
unPos Pos
col) [Either Text (SourcePos, Expr () SourcePos, SourcePos)]
es) SourcePos
endPos
where
go :: ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[Either Text (SourcePos, Expr () SourcePos, SourcePos)]
go =
([] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'`')
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
singleton) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[Either Text (SourcePos, Expr () SourcePos, SourcePos)]
go)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
singleton) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'`') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[Either Text (SourcePos, Expr () SourcePos, SourcePos)]
go)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
singleton) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'$') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[Either Text (SourcePos, Expr () SourcePos, SourcePos)]
go)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( ((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Expr () SourcePos
e <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'$' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall r. SomeParser r ()
sc forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'}'
SourcePos
endPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
pure $ (SourcePos
startPos, Expr () SourcePos
e, SourcePos
endPos)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[Either Text (SourcePos, Expr () SourcePos, SourcePos)]
go
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
singleton) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
Lexer.charLiteral forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[Either Text (SourcePos, Expr () SourcePos, SourcePos)]
go)
fixSpacing :: Int -> [p Text d] -> [p Text d]
fixSpacing Int
newlineSpaceLength =
forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (HasCallStack => Text -> Text -> Text -> Text
Text.replace ([Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ Char
'\n' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
List.replicate (Int
newlineSpaceLength forall a. Num a => a -> a -> a
- Int
1) Char
' ') Text
"\n") forall a. a -> a
id)
arrayComprE :: Parser (Expr () SourcePos)
arrayComprE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"array builder\nfor example: [n * 2 + 1 | n <- range 0 10, if n % 2 == 0]" forall a b. (a -> b) -> a -> b
$
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
"["
Expr () SourcePos
e <- Parser (Expr () SourcePos)
expr
SourcePos
midPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
"|"
([(SourcePos, Ident, SourcePos, Expr () SourcePos, Maybe SourcePos)]
sels, Maybe (SourcePos, Expr () SourcePos)
cond) <- Parser
([(SourcePos, Ident, SourcePos, Expr () SourcePos,
Maybe SourcePos)],
Maybe (SourcePos, Expr () SourcePos))
rhsE
SourcePos
endPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']'
return $ forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos)
-> Maybe (pos, Expr hash pos)
-> pos
-> Expr hash pos
ArrayComp SourcePos
startPos Expr () SourcePos
e SourcePos
midPos (forall a. [a] -> NonEmpty a
NEList.fromList [(SourcePos, Ident, SourcePos, Expr () SourcePos, Maybe SourcePos)]
sels) Maybe (SourcePos, Expr () SourcePos)
cond SourcePos
endPos
where
selectE :: Parser (SourcePos, Ident, SourcePos, Expr () SourcePos)
selectE :: Parser (SourcePos, Ident, SourcePos, Expr () SourcePos)
selectE = do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Ident
var <- forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ Text -> Ident
Ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable
SourcePos
arrPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Expr () SourcePos
e <- forall r. Text -> SomeParser r Text
symbol Text
"<-" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr
return (SourcePos
startPos, Ident
var, SourcePos
arrPos, Expr () SourcePos
e)
rhsE :: Parser ([(SourcePos, Ident, SourcePos, Expr () SourcePos, Maybe SourcePos)], Maybe (SourcePos, Expr () SourcePos))
rhsE :: Parser
([(SourcePos, Ident, SourcePos, Expr () SourcePos,
Maybe SourcePos)],
Maybe (SourcePos, Expr () SourcePos))
rhsE =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
( do
(SourcePos
startPos, Ident
var, SourcePos
arrPos, Expr () SourcePos
e) <- Parser (SourcePos, Ident, SourcePos, Expr () SourcePos)
selectE
SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
","
([(SourcePos, Ident, SourcePos, Expr () SourcePos, Maybe SourcePos)]
xs, Maybe (SourcePos, Expr () SourcePos)
mcond) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser
([(SourcePos, Ident, SourcePos, Expr () SourcePos,
Maybe SourcePos)],
Maybe (SourcePos, Expr () SourcePos))
rhsE forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\(SourcePos, Expr () SourcePos)
c -> ([], forall a. a -> Maybe a
Just (SourcePos, Expr () SourcePos)
c)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SourcePos, Expr () SourcePos)
condE
pure ((SourcePos
startPos, Ident
var, SourcePos
arrPos, Expr () SourcePos
e, forall a. a -> Maybe a
Just SourcePos
pos) forall a. a -> [a] -> [a]
: [(SourcePos, Ident, SourcePos, Expr () SourcePos, Maybe SourcePos)]
xs, Maybe (SourcePos, Expr () SourcePos)
mcond)
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\(SourcePos
startPos, Ident
var, SourcePos
arrPos, Expr () SourcePos
e) -> ([(SourcePos
startPos, Ident
var, SourcePos
arrPos, Expr () SourcePos
e, forall a. Maybe a
Nothing)], forall a. Maybe a
Nothing)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SourcePos, Ident, SourcePos, Expr () SourcePos)
selectE)
condE :: Parser (SourcePos, Expr () SourcePos)
condE :: Parser (SourcePos, Expr () SourcePos)
condE = do
SourcePos
ifPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
(SourcePos
ifPos,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. Text -> SomeParser r ()
rword Text
"if" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr)
arrayE :: Parser (Expr () SourcePos)
arrayE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"array\nfor example: [1,2,3,4,5]" forall a b. (a -> b) -> a -> b
$
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
"["
[(Expr () SourcePos, Maybe SourcePos)]
args <- Parser [(Expr () SourcePos, Maybe SourcePos)]
argsE
SourcePos
endPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']'
return $ forall hash pos.
pos -> [(Expr hash pos, Maybe pos)] -> pos -> Expr hash pos
Array SourcePos
startPos [(Expr () SourcePos, Maybe SourcePos)]
args SourcePos
endPos
where
argsE :: Parser [(Expr () SourcePos, Maybe SourcePos)]
argsE :: Parser [(Expr () SourcePos, Maybe SourcePos)]
argsE =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
( do
Expr () SourcePos
e <- Parser (Expr () SourcePos)
expr
SourcePos
commaPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
","
[(Expr () SourcePos, Maybe SourcePos)]
es <- Parser [(Expr () SourcePos, Maybe SourcePos)]
argsE
return ((Expr () SourcePos
e, forall a. a -> Maybe a
Just SourcePos
commaPos) forall a. a -> [a] -> [a]
: [(Expr () SourcePos, Maybe SourcePos)]
es)
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
( do
Expr () SourcePos
e1 <- Parser (Expr () SourcePos)
expr
return [(Expr () SourcePos
e1, forall a. Maybe a
Nothing)]
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
mkInterpolatedString :: [Either Text e] -> [Either Text e]
mkInterpolatedString :: forall e. [Either Text e] -> [Either Text e]
mkInterpolatedString [] = []
mkInterpolatedString (Left Text
x : Left Text
y : [Either Text e]
xs) = forall e. [Either Text e] -> [Either Text e]
mkInterpolatedString (forall a b. a -> Either a b
Left (Text
x forall a. Semigroup a => a -> a -> a
<> Text
y) forall a. a -> [a] -> [a]
: [Either Text e]
xs)
mkInterpolatedString (Either Text e
x : [Either Text e]
xs) = Either Text e
x forall a. a -> [a] -> [a]
: forall e. [Either Text e] -> [Either Text e]
mkInterpolatedString [Either Text e]
xs
funE :: Parser (Expr () SourcePos)
funE :: Parser (Expr () SourcePos)
funE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a function\nfor example: fun x y -> x + y" forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall r. Text -> SomeParser r ()
rword Text
"fun"
[(SourcePos, Maybe ExtIdent)]
args <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser (SourcePos, Maybe ExtIdent)
mExtIdent
SourcePos
arrPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
"->" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"'->'"
Expr () SourcePos
body <- Parser (Expr () SourcePos)
expr
return $ forall hash pos.
pos
-> NonEmpty (pos, Maybe ExtIdent)
-> pos
-> Expr hash pos
-> Expr hash pos
Lam SourcePos
startPos (forall a. [a] -> NonEmpty a
NEList.fromList [(SourcePos, Maybe ExtIdent)]
args) SourcePos
arrPos Expr () SourcePos
body
renameModE :: Parser (Expr () SourcePos)
renameModE :: Parser (Expr () SourcePos)
renameModE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a 'let module' expression\nfor example: let module A = Base in A.#true" forall a b. (a -> b) -> a -> b
$
do
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall r. Text -> SomeParser r ()
rword Text
"let"
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall r. Text -> SomeParser r ()
rword Text
"module"
SourcePos
newNmPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
ModuleName
newNm <- forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ (Text -> ModuleName
ModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"module name")
forall r. Text -> SomeParser r Text
symbol Text
"=" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"'='"
SourcePos
oldNmPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
ModuleName
oldNm <- forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ (Text -> ModuleName
ModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"name of an existing module")
SourcePos
inPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
(OpsTable
opsTable, Map ModuleName OpsTable
modOpsTables) <- forall r (m :: * -> *). MonadReader r m => m r
ask
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
oldNm Map ModuleName OpsTable
modOpsTables of
Maybe OpsTable
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ ModuleName -> InfernoParsingError
ModuleNotFound ModuleName
oldNm
Just OpsTable
opsTableOldNm -> do
let opsTable' :: OpsTable
opsTable' = forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith forall a. Semigroup a => a -> a -> a
(<>) OpsTable
opsTable forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (\[(Fixity, Scoped ModuleName, Text)]
xs -> [(Fixity
fix, forall a. a -> Scoped a
Scope ModuleName
newNm, Text
op) | (Fixity
fix, Scoped ModuleName
_, Text
op) <- [(Fixity, Scoped ModuleName, Text)]
xs]) OpsTable
opsTableOldNm
let modOpsTables' :: Map ModuleName OpsTable
modOpsTables' = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ModuleName
newNm OpsTable
opsTableOldNm Map ModuleName OpsTable
modOpsTables
Expr () SourcePos
e <- forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall a b. a -> b -> a
const (OpsTable
opsTable', Map ModuleName OpsTable
modOpsTables')) forall a b. (a -> b) -> a -> b
$ (forall r. Text -> SomeParser r ()
rword Text
"in" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"_the 'in' keyword") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr
pure $ forall hash pos.
pos
-> ModuleName
-> pos
-> ModuleName
-> pos
-> Expr hash pos
-> Expr hash pos
RenameModule SourcePos
newNmPos ModuleName
newNm SourcePos
oldNmPos ModuleName
oldNm SourcePos
inPos Expr () SourcePos
e
data InfernoParsingError = ModuleNotFound ModuleName | InfixOpNotFound ModuleName Ident | UnboundTyVar Text
deriving (InfernoParsingError -> InfernoParsingError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfernoParsingError -> InfernoParsingError -> Bool
$c/= :: InfernoParsingError -> InfernoParsingError -> Bool
== :: InfernoParsingError -> InfernoParsingError -> Bool
$c== :: InfernoParsingError -> InfernoParsingError -> Bool
Eq, Int -> InfernoParsingError -> [Char] -> [Char]
[InfernoParsingError] -> [Char] -> [Char]
InfernoParsingError -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [InfernoParsingError] -> [Char] -> [Char]
$cshowList :: [InfernoParsingError] -> [Char] -> [Char]
show :: InfernoParsingError -> [Char]
$cshow :: InfernoParsingError -> [Char]
showsPrec :: Int -> InfernoParsingError -> [Char] -> [Char]
$cshowsPrec :: Int -> InfernoParsingError -> [Char] -> [Char]
Show, Eq InfernoParsingError
InfernoParsingError -> InfernoParsingError -> Bool
InfernoParsingError -> InfernoParsingError -> Ordering
InfernoParsingError -> InfernoParsingError -> InfernoParsingError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InfernoParsingError -> InfernoParsingError -> InfernoParsingError
$cmin :: InfernoParsingError -> InfernoParsingError -> InfernoParsingError
max :: InfernoParsingError -> InfernoParsingError -> InfernoParsingError
$cmax :: InfernoParsingError -> InfernoParsingError -> InfernoParsingError
>= :: InfernoParsingError -> InfernoParsingError -> Bool
$c>= :: InfernoParsingError -> InfernoParsingError -> Bool
> :: InfernoParsingError -> InfernoParsingError -> Bool
$c> :: InfernoParsingError -> InfernoParsingError -> Bool
<= :: InfernoParsingError -> InfernoParsingError -> Bool
$c<= :: InfernoParsingError -> InfernoParsingError -> Bool
< :: InfernoParsingError -> InfernoParsingError -> Bool
$c< :: InfernoParsingError -> InfernoParsingError -> Bool
compare :: InfernoParsingError -> InfernoParsingError -> Ordering
$ccompare :: InfernoParsingError -> InfernoParsingError -> Ordering
Ord)
instance ShowErrorComponent InfernoParsingError where
showErrorComponent :: InfernoParsingError -> [Char]
showErrorComponent (ModuleNotFound (ModuleName Text
modNm)) =
[Char]
"Module '" forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
modNm forall a. Semigroup a => a -> a -> a
<> [Char]
"' could not be found"
showErrorComponent (InfixOpNotFound (ModuleName Text
modNm) (Ident Text
op)) =
[Char]
"Module " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
modNm forall a. Semigroup a => a -> a -> a
<> [Char]
" does nto export `(" forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
op forall a. Semigroup a => a -> a -> a
<> [Char]
")`"
showErrorComponent (UnboundTyVar Text
ty) =
[Char]
"Unbound type variable '" forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
ty
openModArgs :: ModuleName -> Parser ([(Import SourcePos, Maybe SourcePos)], SourcePos, Expr () SourcePos)
openModArgs :: ModuleName
-> Parser
([(Import SourcePos, Maybe SourcePos)], SourcePos,
Expr () SourcePos)
openModArgs ModuleName
modNm = do
forall r. Text -> SomeParser r Text
symbol Text
"("
[(Import SourcePos, Maybe SourcePos)]
is <- ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[(Import SourcePos, Maybe SourcePos)]
go
forall r. Text -> SomeParser r Text
symbol Text
")"
(OpsTable
opsTable, Map ModuleName OpsTable
modOpsTables) <- forall r (m :: * -> *). MonadReader r m => m r
ask
OpsTable
opsTable' <-
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
( \OpsTable
oTbl Import SourcePos
i -> case Import SourcePos
i of
IOpVar SourcePos
_ Ident
op -> do
OpsTable
foundOpTbl <- Ident
-> Map ModuleName OpsTable
-> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
OpsTable
findOp Ident
op Map ModuleName OpsTable
modOpsTables
return $ forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith forall a. Semigroup a => a -> a -> a
(<>) OpsTable
oTbl OpsTable
foundOpTbl
Import SourcePos
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OpsTable
oTbl
)
OpsTable
opsTable
(forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Import SourcePos, Maybe SourcePos)]
is)
SourcePos
inPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Expr () SourcePos
e <- forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall a b. a -> b -> a
const (OpsTable
opsTable', Map ModuleName OpsTable
modOpsTables)) forall a b. (a -> b) -> a -> b
$ (forall r. Text -> SomeParser r ()
rword Text
"in" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"_the 'in' keyword") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr
return ([(Import SourcePos, Maybe SourcePos)]
is, SourcePos
inPos, Expr () SourcePos
e)
where
findOp :: Ident -> Map.Map ModuleName OpsTable -> Parser OpsTable
findOp :: Ident
-> Map ModuleName OpsTable
-> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
OpsTable
findOp i :: Ident
i@(Ident Text
op) Map ModuleName OpsTable
modOpsTables =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
modNm Map ModuleName OpsTable
modOpsTables of
Just OpsTable
opsTable -> do
let filteredOpsTable :: OpsTable
filteredOpsTable =
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe
(\[(Fixity, Scoped ModuleName, Text)]
xs -> let xs' :: [(Fixity, Scoped ModuleName, Text)]
xs' = [(Fixity
fix, forall a. Scoped a
LocalScope, Text
op') | (Fixity
fix, Scoped ModuleName
_modNm, Text
op') <- [(Fixity, Scoped ModuleName, Text)]
xs, Text
op forall a. Eq a => a -> a -> Bool
== Text
op'] in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Fixity, Scoped ModuleName, Text)]
xs' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [(Fixity, Scoped ModuleName, Text)]
xs')
OpsTable
opsTable
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null OpsTable
filteredOpsTable) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ ModuleName -> Ident -> InfernoParsingError
InfixOpNotFound ModuleName
modNm Ident
i
return OpsTable
filteredOpsTable
Maybe OpsTable
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ ModuleName -> InfernoParsingError
ModuleNotFound ModuleName
modNm
go :: ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[(Import SourcePos, Maybe SourcePos)]
go =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
(Import SourcePos)
parseImport forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall r a. SomeParser r a -> SomeParser r a
lexeme ((forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
",")) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
[(Import SourcePos, Maybe SourcePos)]
go)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\Import SourcePos
i -> [(Import SourcePos
i, forall a. Maybe a
Nothing)]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
(Import SourcePos)
parseImport)
parseImport :: ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
(Import SourcePos)
parseImport =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall pos. pos -> Ident -> Import pos
IOpVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall r a. SomeParser r a -> SomeParser r a
lexeme (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Ident
Ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing Char -> Bool
isAlphaNum) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')'))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall pos. pos -> pos -> Ident -> Import pos
IEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. SomeParser r a -> SomeParser r a
lexeme (forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"enum") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall r a. SomeParser r a -> SomeParser r a
lexeme (Text -> Ident
Ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall pos. pos -> Ident -> Import pos
IVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall r a. SomeParser r a -> SomeParser r a
lexeme (Text -> Ident
Ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable))
openModE :: Parser (Expr () SourcePos)
openModE :: Parser (Expr () SourcePos)
openModE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"an 'open' module expression\nfor example: open A in ..." forall a b. (a -> b) -> a -> b
$
do
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall r. Text -> SomeParser r ()
rword Text
"open"
SourcePos
nmPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
ModuleName
nm <- forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ (Text -> ModuleName
ModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"module name")
(forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 (forall hash pos.
pos
-> hash
-> ModuleName
-> [(Import pos, Maybe pos)]
-> pos
-> Expr hash pos
-> Expr hash pos
OpenModule SourcePos
nmPos () ModuleName
nm) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ModuleName
-> Parser
([(Import SourcePos, Maybe SourcePos)], SourcePos,
Expr () SourcePos)
openModArgs ModuleName
nm) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\SourcePos
inPos Expr () SourcePos
e -> ([], SourcePos
inPos, Expr () SourcePos
e)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ModuleName -> Parser (Expr () SourcePos)
openAll ModuleName
nm)))
where
openAll :: ModuleName -> Parser (Expr () SourcePos)
openAll ModuleName
modNm = do
(OpsTable
opsTable, Map ModuleName OpsTable
modOpsTables) <- forall r (m :: * -> *). MonadReader r m => m r
ask
case forall a. [Char] -> a -> a
trace ([Char]
"modOpsTables: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Map ModuleName OpsTable
modOpsTables) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
modNm Map ModuleName OpsTable
modOpsTables of
Just OpsTable
opsTable' ->
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall a b. a -> b -> a
const (forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith forall a. Semigroup a => a -> a -> a
(<>) OpsTable
opsTable OpsTable
opsTable', Map ModuleName OpsTable
modOpsTables)) forall a b. (a -> b) -> a -> b
$
(forall r. Text -> SomeParser r ()
rword Text
"in" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"_the 'in' keyword") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr
Maybe OpsTable
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ ModuleName -> InfernoParsingError
ModuleNotFound ModuleName
modNm
letE :: Parser (Expr () SourcePos)
letE :: Parser (Expr () SourcePos)
letE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label ([Char]
"a 'let' expression" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
example (ExtIdent -> ImplExpl
Expl forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
"x")) forall a b. (a -> b) -> a -> b
$
do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall r. Text -> SomeParser r ()
rword Text
"let"
SourcePos
varPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
ImplExpl
x <- forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ (((ExtIdent -> ImplExpl
Expl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Int Text -> ExtIdent
ExtIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ExtIdent -> ImplExpl
Impl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Int Text -> ExtIdent
ExtIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
implicitVariable)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a variable")
SourcePos
eqPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
"=" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"'='"
Expr () SourcePos
e1 <- Parser (Expr () SourcePos)
expr forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> ([Char]
"an expression to bind to '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ImplExpl
x forall a. [a] -> [a] -> [a]
++ [Char]
"'" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
example ImplExpl
x)
SourcePos
inPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Expr () SourcePos
e2 <- (forall r. Text -> SomeParser r ()
rword Text
"in" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"_the 'in' keyword") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr
pure $ forall hash pos.
pos
-> pos
-> ImplExpl
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
Let SourcePos
startPos SourcePos
varPos ImplExpl
x SourcePos
eqPos Expr () SourcePos
e1 SourcePos
inPos Expr () SourcePos
e2
where
example :: a -> [Char]
example a
x = [Char]
"\nfor example: let " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
x forall a. [a] -> [a] -> [a]
++ [Char]
" = 2 * 5 in ..."
pat :: Parser (Pat () SourcePos)
pat :: Parser (Pat () SourcePos)
pat =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 forall hash pos.
pos -> TList (Pat hash pos, Maybe pos) -> pos -> Pat hash pos
PTuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a.
SomeParser r a
-> SomeParser r (SourcePos, TList (a, Maybe SourcePos), SourcePos)
tuple Parser (Pat () SourcePos)
pat)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall r a. SomeParser r a -> SomeParser r a
parens Parser (Pat () SourcePos)
pat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
hexadecimal forall hash pos. pos -> Lit -> Pat hash pos
PLit)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
signedDoubleE forall hash pos. pos -> Lit -> Pat hash pos
PLit)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
signedIntE forall hash pos. pos -> Lit -> Pat hash pos
PLit
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall f.
(SourcePos -> () -> Scoped ModuleName -> Ident -> f) -> Parser f
enumE forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Pat hash pos
PEnum
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall hash pos. pos -> Maybe Ident -> Pat hash pos
PVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SourcePos, Maybe Ident)
mIdent)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (SourcePos -> a) -> Parser a
noneE forall hash pos. pos -> Pat hash pos
PEmpty
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall t a. (SourcePos -> t -> a) -> Parser t -> Parser a
someE forall hash pos. pos -> Pat hash pos -> Pat hash pos
POne Parser (Pat () SourcePos)
pat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
stringE forall hash pos. pos -> Lit -> Pat hash pos
PLit
casePatts :: Parser [(SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos)]
casePatts :: Parser
[(SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos)]
casePatts = do
Maybe Text
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall r. Text -> SomeParser r Text
symbol Text
"|" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"'|'")
Parser (SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos)
onePat forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (forall r. Text -> SomeParser r Text
symbol Text
"|" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"'|'")
where
onePat :: Parser (SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos)
onePat :: Parser (SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos)
onePat = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"_a pattern match clause\nfor example: #true -> ..." forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Pat () SourcePos
p <- Parser (Pat () SourcePos)
pat
SourcePos
arrPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
"->" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"'->'"
Expr () SourcePos
e <- Parser (Expr () SourcePos)
expr
return (SourcePos
startPos, Pat () SourcePos
p, SourcePos
arrPos, Expr () SourcePos
e)
caseE :: Parser (Expr () SourcePos)
caseE :: Parser (Expr () SourcePos)
caseE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a pattern-match expression\nfor example: match x with { 1 -> #true | _ -> #false }" forall a b. (a -> b) -> a -> b
$
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r ()
rword Text
"match"
Expr () SourcePos
e <- Parser (Expr () SourcePos)
expr forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"an expression to pattern match on\nfor example: match (x, y) with { ... }"
forall r. Text -> SomeParser r ()
rword Text
"with"
SourcePos
brPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
"{"
[(SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos)]
cs <- Parser
[(SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos)]
casePatts
SourcePos
endPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'}'
return $ forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
-> pos
-> Expr hash pos
Case SourcePos
startPos Expr () SourcePos
e SourcePos
brPos (forall a. [a] -> NonEmpty a
NEList.fromList [(SourcePos, Pat () SourcePos, SourcePos, Expr () SourcePos)]
cs) SourcePos
endPos
tupleArgs :: SomeParser r a -> SomeParser r [(a, Maybe SourcePos)]
tupleArgs :: forall r a. SomeParser r a -> SomeParser r [(a, Maybe SourcePos)]
tupleArgs SomeParser r a
p =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
( do
a
e <- SomeParser r a
p
SourcePos
commaPos <- forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
[(a, Maybe SourcePos)]
es <- forall r a. SomeParser r a -> SomeParser r [(a, Maybe SourcePos)]
tupleArgs SomeParser r a
p
return ((a
e, forall a. a -> Maybe a
Just SourcePos
commaPos) forall a. a -> [a] -> [a]
: [(a, Maybe SourcePos)]
es)
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
a
e1 <- SomeParser r a
p
SourcePos
commaPos <- forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
a
e2 <- SomeParser r a
p
return [(a
e1, forall a. a -> Maybe a
Just SourcePos
commaPos), (a
e2, forall a. Maybe a
Nothing)]
isHSpace :: Char -> Bool
isHSpace :: Char -> Bool
isHSpace Char
x = Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\r'
tuple :: SomeParser r a -> SomeParser r (SourcePos, TList (a, Maybe SourcePos), SourcePos)
tuple :: forall r a.
SomeParser r a
-> SomeParser r (SourcePos, TList (a, Maybe SourcePos), SourcePos)
tuple SomeParser r a
p = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a tuple\nfor example: (2, #true, 4.4)" forall a b. (a -> b) -> a -> b
$
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
"("
TList (a, Maybe SourcePos)
r <- forall a. [a] -> TList a
tListFromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. SomeParser r a -> SomeParser r [(a, Maybe SourcePos)]
tupleArgs SomeParser r a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing Char -> Bool
isHSpace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. TList a
TNil)
SourcePos
endPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')'
return (SourcePos
startPos, TList (a, Maybe SourcePos)
r, SourcePos
endPos)
assertE :: Parser (Expr () SourcePos)
assertE :: Parser (Expr () SourcePos)
assertE = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"an assertion\nfor example: assert x > 10 in ..." forall a b. (a -> b) -> a -> b
$ do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall r. Text -> SomeParser r ()
rword Text
"assert"
Expr () SourcePos
e1 <- Parser (Expr () SourcePos)
expr forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a boolean expression\nfor example: x > 10 && x <= 25"
SourcePos
inPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Expr () SourcePos
e2 <- (forall r. Text -> SomeParser r ()
rword Text
"in" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"_the 'in' keyword") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr
return $ forall hash pos.
pos -> Expr hash pos -> pos -> Expr hash pos -> Expr hash pos
Assert SourcePos
startPos Expr () SourcePos
e1 SourcePos
inPos Expr () SourcePos
e2
ifE :: Parser (Expr () SourcePos)
ifE :: Parser (Expr () SourcePos)
ifE = do
SourcePos
ifPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall r. Text -> SomeParser r ()
rword Text
"if"
Expr () SourcePos
cond <- (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ Parser (Expr () SourcePos)
expr) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"_a conditional expression\nfor example: x > 2"
SourcePos
thenPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Expr () SourcePos
tr <- (forall r. Text -> SomeParser r ()
rword Text
"then" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"_the 'then' branch\nfor example: if x > 2 then 1 else 0"
SourcePos
elsePos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Expr () SourcePos
fl <- (forall r. Text -> SomeParser r ()
rword Text
"else" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr () SourcePos)
expr) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"_the 'else' branch\nfor example: if x > 2 then 1 else 0"
return $ forall hash pos.
pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
If SourcePos
ifPos Expr () SourcePos
cond SourcePos
thenPos Expr () SourcePos
tr SourcePos
elsePos Expr () SourcePos
fl
appE :: Parser (Expr () SourcePos)
appE :: Parser (Expr () SourcePos)
appE =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
hexadecimal forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> Lit -> Expr hash pos
Lit)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 forall hash pos.
pos -> TList (Expr hash pos, Maybe pos) -> pos -> Expr hash pos
Tuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a.
SomeParser r a
-> SomeParser r (SourcePos, TList (a, Maybe SourcePos), SourcePos)
tuple Parser (Expr () SourcePos)
expr)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden
( forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t a. (t -> Parser a) -> [t] -> Parser a
tryMany (Fixity, Scoped ModuleName, Text) -> Parser (Expr () SourcePos)
operatorAsFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol Text
"("
Expr () SourcePos
e <- Parser (Expr () SourcePos)
expr
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')'
SourcePos
endPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> Expr hash pos -> pos -> Expr hash pos
Bracketed SourcePos
startPos Expr () SourcePos
e SourcePos
endPos
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Expr () SourcePos)
doubleE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr () SourcePos)
intE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall f.
(SourcePos -> () -> Scoped ModuleName -> Ident -> f) -> Parser f
enumE forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Expr hash pos
Enum
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((\Text
nmspc Text
x -> forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var SourcePos
startPos () (forall a. a -> Scoped a
Scope forall a b. (a -> b) -> a -> b
$ Text -> ModuleName
ModuleName Text
nmspc) forall a b. (a -> b) -> a -> b
$ ExtIdent -> ImplExpl
Expl forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
variable))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ (forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var SourcePos
startPos () forall a. Scoped a
LocalScope forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtIdent -> ImplExpl
Expl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Int Text -> ExtIdent
ExtIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'.'))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (SourcePos -> a) -> Parser a
noneE forall hash pos. pos -> Expr hash pos
Empty
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall t a. (SourcePos -> t -> a) -> Parser t -> Parser a
someE forall hash pos. pos -> Expr hash pos -> Expr hash pos
One Parser (Expr () SourcePos)
expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr () SourcePos)
ifE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Expr () SourcePos)
renameModE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr () SourcePos)
letE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr () SourcePos)
openModE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr () SourcePos)
assertE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr () SourcePos)
funE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr () SourcePos)
caseE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Expr () SourcePos)
implVarE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *).
(SourcePos -> Lit -> f SourcePos) -> Parser (f SourcePos)
stringE forall hash pos. pos -> Lit -> Expr hash pos
Lit
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr () SourcePos)
interpolatedStringE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Expr () SourcePos)
arrayE
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr () SourcePos)
arrayComprE
term :: Parser (Expr () SourcePos)
term :: Parser (Expr () SourcePos)
term =
Parser (Expr () SourcePos)
appE forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Expr () SourcePos
x ->
(forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser (Expr () SourcePos)
appE forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Expr () SourcePos]
xs -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall hash pos. Expr hash pos -> Expr hash pos -> Expr hash pos
App Expr () SourcePos
x [Expr () SourcePos]
xs))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Expr () SourcePos
x
operatorAsFun :: (Fixity, Scoped ModuleName, Text) -> Parser (Expr () SourcePos)
operatorAsFun :: (Fixity, Scoped ModuleName, Text) -> Parser (Expr () SourcePos)
operatorAsFun (Fixity
_fix, Scoped ModuleName
modNm, Text
s) = do
SourcePos
startPos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall r. Text -> SomeParser r Text
symbol forall a b. (a -> b) -> a -> b
$ (forall a. a -> Scoped a -> a
fromScoped Text
"" forall a b. (a -> b) -> a -> b
$ ((forall a. Semigroup a => a -> a -> a
<> Text
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
modNm) forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
")"
return $ forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Expr hash pos
OpVar SourcePos
startPos () Scoped ModuleName
modNm forall a b. (a -> b) -> a -> b
$ Text -> Ident
Ident Text
s
tryMany :: (t -> Parser a) -> [t] -> Parser a
tryMany :: forall t a. (t -> Parser a) -> [t] -> Parser a
tryMany t -> Parser a
_ [] = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"none of the operators matched"
tryMany t -> Parser a
p [t
x] = t -> Parser a
p t
x
tryMany t -> Parser a
p (t
x : [t]
xs) = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (t -> Parser a
p t
x) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall t a. (t -> Parser a) -> [t] -> Parser a
tryMany t -> Parser a
p [t]
xs
expr :: Parser (Expr () SourcePos)
expr :: Parser (Expr () SourcePos)
expr = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(OpsTable
opsTable, Map ModuleName OpsTable
_) -> forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser Parser (Expr () SourcePos)
term forall a b. (a -> b) -> a -> b
$ OpsTable
-> [[Operator
(ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text)))
(Expr () SourcePos)]]
mkOperators OpsTable
opsTable
mkOperators :: OpsTable -> [[Operator Parser (Expr () SourcePos)]]
mkOperators :: OpsTable
-> [[Operator
(ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text)))
(Expr () SourcePos)]]
mkOperators OpsTable
opsTable =
[ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 forall a b. (a -> b) -> a -> b
$ Int
-> Fixity
-> Scoped ModuleName
-> Text
-> Operator
(ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text)))
(Expr () SourcePos)
mkOperatorP Int
prec) [(Fixity, Scoped ModuleName, Text)]
opGrp | (Int
prec, [(Fixity, Scoped ModuleName, Text)]
opGrp) <- forall a. IntMap a -> [(Int, a)]
IntMap.toDescList OpsTable
opsTable
]
where
infixLabel :: ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
-> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
infixLabel = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"an infix operator\nfor example: +, *, ==, >, <"
prefixLabel :: ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
-> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
prefixLabel = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a prefix operator\nfor example: -, !"
opString :: Scoped ModuleName -> Text -> Text
opString :: Scoped ModuleName -> Text -> Text
opString Scoped ModuleName
modNm Text
s = case Scoped ModuleName
modNm of
Scoped ModuleName
LocalScope -> Text
s
Scope (ModuleName Text
ns) -> Text
ns forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
s
mkOperatorP :: Int -> Fixity -> Scoped ModuleName -> Text -> Operator Parser (Expr () SourcePos)
mkOperatorP :: Int
-> Fixity
-> Scoped ModuleName
-> Text
-> Operator
(ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text)))
(Expr () SourcePos)
mkOperatorP Int
prec (InfixOp InfixFixity
NoFix) Scoped ModuleName
ns Text
o =
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN forall a b. (a -> b) -> a -> b
$
forall {a}.
ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
-> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
infixLabel forall a b. (a -> b) -> a -> b
$
(\SourcePos
pos Expr () SourcePos
e1 Expr () SourcePos
e2 -> forall hash pos.
Expr hash pos
-> pos
-> hash
-> (Int, InfixFixity)
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
Op Expr () SourcePos
e1 SourcePos
pos () (Int
prec, InfixFixity
NoFix) Scoped ModuleName
ns (Text -> Ident
Ident Text
o) Expr () SourcePos
e2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Scoped ModuleName -> Text -> Text
opString Scoped ModuleName
ns Text
o))
mkOperatorP Int
prec (InfixOp InfixFixity
LeftFix) Scoped ModuleName
ns Text
o =
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL forall a b. (a -> b) -> a -> b
$
forall {a}.
ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
-> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
infixLabel forall a b. (a -> b) -> a -> b
$
(\SourcePos
pos Expr () SourcePos
e1 Expr () SourcePos
e2 -> forall hash pos.
Expr hash pos
-> pos
-> hash
-> (Int, InfixFixity)
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
Op Expr () SourcePos
e1 SourcePos
pos () (Int
prec, InfixFixity
LeftFix) Scoped ModuleName
ns (Text -> Ident
Ident Text
o) Expr () SourcePos
e2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Scoped ModuleName -> Text -> Text
opString Scoped ModuleName
ns Text
o))
mkOperatorP Int
prec (InfixOp InfixFixity
RightFix) Scoped ModuleName
ns Text
o =
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR forall a b. (a -> b) -> a -> b
$
forall {a}.
ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
-> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
infixLabel forall a b. (a -> b) -> a -> b
$
(\SourcePos
pos Expr () SourcePos
e1 Expr () SourcePos
e2 -> forall hash pos.
Expr hash pos
-> pos
-> hash
-> (Int, InfixFixity)
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
Op Expr () SourcePos
e1 SourcePos
pos () (Int
prec, InfixFixity
RightFix) Scoped ModuleName
ns (Text -> Ident
Ident Text
o) Expr () SourcePos
e2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Scoped ModuleName -> Text -> Text
opString Scoped ModuleName
ns Text
o))
mkOperatorP Int
prec Fixity
PrefixOp Scoped ModuleName
ns Text
o =
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix forall a b. (a -> b) -> a -> b
$
forall {a}.
ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
-> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
a
prefixLabel forall a b. (a -> b) -> a -> b
$
(\SourcePos
pos Expr () SourcePos
e -> forall hash pos.
pos
-> hash
-> Int
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
PreOp SourcePos
pos () Int
prec Scoped ModuleName
ns (Text -> Ident
Ident Text
o) Expr () SourcePos
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Scoped ModuleName -> Text -> Text
opString Scoped ModuleName
ns Text
o))
parseExpr ::
OpsTable ->
Map.Map ModuleName OpsTable ->
Text ->
Either
(NonEmpty (ParseError Text InfernoParsingError, SourcePos))
(Expr () SourcePos, [Comment SourcePos])
parseExpr :: OpsTable
-> Map ModuleName OpsTable
-> Text
-> Either
(NonEmpty (ParseError Text InfernoParsingError, SourcePos))
(Expr () SourcePos, [Comment SourcePos])
parseExpr OpsTable
opsTable Map ModuleName OpsTable
modOpsTables Text
s =
case forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (OpsTable
opsTable, Map ModuleName OpsTable
modOpsTables) forall a b. (a -> b) -> a -> b
$ forall r a. SomeParser r a -> SomeParser r a
topLevel Parser (Expr () SourcePos)
expr) [Char]
"<stdin>" Text
s of
Left (ParseErrorBundle NonEmpty (ParseError Text InfernoParsingError)
errs PosState Text
pos) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a.
(Traversable t, TraversableStream s) =>
(a -> Int) -> t a -> PosState s -> (t (a, SourcePos), PosState s)
attachSourcePos forall s e. ParseError s e -> Int
errorOffset NonEmpty (ParseError Text InfernoParsingError)
errs PosState Text
pos
Right (Expr () SourcePos
e, Comments
comments) -> forall a b. b -> Either a b
Right (Expr () SourcePos
e, forall a. Endo a -> a -> a
appEndo Comments
comments [])
type TyParser = ReaderT (Map.Map Text Int, OpsTable, Map.Map ModuleName OpsTable) (WriterT Comments (Parsec InfernoParsingError Text))
rws_type :: [Text]
rws_type :: [Text]
rws_type = [Text
"define", Text
"on", Text
"forall"]
typeIdent :: TyParser Text
typeIdent :: TyParser Text
typeIdent = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (TyParser Text
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. MonadFail m => Text -> m Text
check)
where
p :: TyParser Text
p = [Char] -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a type")
check :: Text -> m Text
check Text
x =
if Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
rws_type
then forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Keyword " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Text
x forall a. Semigroup a => a -> a -> a
<> [Char]
" cannot be a variable/function name"
else forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
baseType :: TyParser InfernoType
baseType :: TyParser InfernoType
baseType =
BaseType -> InfernoType
TBase
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (forall r. Text -> SomeParser r Text
symbol Text
"int" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TInt)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall r. Text -> SomeParser r Text
symbol Text
"double" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TDouble)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall r. Text -> SomeParser r Text
symbol Text
"word16" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TWord16)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall r. Text -> SomeParser r Text
symbol Text
"word32" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TWord32)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall r. Text -> SomeParser r Text
symbol Text
"word64" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TWord64)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall r. Text -> SomeParser r Text
symbol Text
"text" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TText)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall r. Text -> SomeParser r Text
symbol Text
"timeDiff" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TTimeDiff)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall r. Text -> SomeParser r Text
symbol Text
"time" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TTime)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall r. Text -> SomeParser r Text
symbol Text
"resolution" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TResolution)
)
type_variable_raw :: TyParser Text
type_variable_raw :: TyParser Text
type_variable_raw = (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing Char -> Bool
isAlphaNum)
type_variable :: TyParser Int
type_variable :: TyParser Int
type_variable = do
Text
nm <- TyParser Text
type_variable_raw
(Map Text Int
tys, OpsTable
_, Map ModuleName OpsTable
_) <- forall r (m :: * -> *). MonadReader r m => m r
ask
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
nm Map Text Int
tys of
Just Int
i -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
Maybe Int
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Text -> InfernoParsingError
UnboundTyVar Text
nm
typeParserBase :: TyParser InfernoType
typeParserBase :: TyParser InfernoType
typeParserBase =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((\(SourcePos
_, TList (InfernoType, Maybe SourcePos)
tys, SourcePos
_) -> TList InfernoType -> InfernoType
TTuple forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst TList (InfernoType, Maybe SourcePos)
tys) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a.
SomeParser r a
-> SomeParser r (SourcePos, TList (a, Maybe SourcePos), SourcePos)
tuple TyParser InfernoType
typeParser)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall r a. SomeParser r a -> SomeParser r a
parens TyParser InfernoType
typeParser
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall r a. SomeParser r a -> SomeParser r a
lexeme TyParser InfernoType
baseType)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall r a. SomeParser r a -> SomeParser r a
lexeme (BaseType -> InfernoType
TBase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Set Ident -> BaseType
TEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyParser Text
typeIdent forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. Text -> SomeParser r Text
symbol Text
"{" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {r}.
ReaderT
r (WriterT Comments (Parsec InfernoParsingError Text)) [Ident]
enumList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
"}"))))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall r a. SomeParser r a -> SomeParser r a
lexeme (TV -> InfernoType
TVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TV
TV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyParser Int
type_variable)
where
enumList :: ReaderT
r (WriterT Comments (Parsec InfernoParsingError Text)) [Ident]
enumList =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r. SomeParser r Ident
enumConstructor forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
"," forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
r (WriterT Comments (Parsec InfernoParsingError Text)) [Ident]
enumList)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r. SomeParser r Ident
enumConstructor)
typeParser :: TyParser InfernoType
typeParser :: TyParser InfernoType
typeParser =
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser
TyParser InfernoType
typeParserBase
[ [ forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix (InfernoType -> InfernoType
TArray forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall r. Text -> SomeParser r ()
rword Text
"array" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r ()
rword Text
"of"),
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix (InfernoType -> InfernoType
TSeries forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall r. Text -> SomeParser r ()
rword Text
"series" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r ()
rword Text
"of"),
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix (InfernoType -> InfernoType
TOptional forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall r. Text -> SomeParser r ()
rword Text
"option" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r ()
rword Text
"of")
],
[ forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (InfernoType -> InfernoType -> InfernoType
TArr forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall r. Text -> SomeParser r Text
symbol Text
"->"),
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (InfernoType -> InfernoType -> InfernoType
TArr forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall r. Text -> SomeParser r Text
symbol Text
"→")
]
]
parseType ::
Text ->
Either
(NonEmpty (ParseError Text InfernoParsingError, SourcePos))
InfernoType
parseType :: Text
-> Either
(NonEmpty (ParseError Text InfernoParsingError, SourcePos))
InfernoType
parseType Text
s = case forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ forall r a. SomeParser r a -> SomeParser r a
topLevel TyParser InfernoType
typeParser) [Char]
"<stdin>" Text
s of
Left (ParseErrorBundle NonEmpty (ParseError Text InfernoParsingError)
errs PosState Text
pos) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a.
(Traversable t, TraversableStream s) =>
(a -> Int) -> t a -> PosState s -> (t (a, SourcePos), PosState s)
attachSourcePos forall s e. ParseError s e -> Int
errorOffset NonEmpty (ParseError Text InfernoParsingError)
errs PosState Text
pos
Right (InfernoType
e, Comments
_) -> forall a b. b -> Either a b
Right InfernoType
e
listParser :: TyParser a -> TyParser [a]
listParser :: forall a. TyParser a -> TyParser [a]
listParser TyParser a
p =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
( do
a
e <- TyParser a
p
forall r. Text -> SomeParser r Text
symbol Text
","
[a]
es <- forall a. TyParser a -> TyParser [a]
listParser TyParser a
p
return (a
e forall a. a -> [a] -> [a]
: [a]
es)
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
a
e1 <- TyParser a
p
return [a
e1]
tyContext :: TyParser [Either TypeClass (Text, InfernoType)]
tyContext :: TyParser [Either TypeClass (Text, InfernoType)]
tyContext = forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ do
Text
_ <- forall r. Text -> SomeParser r Text
symbol Text
"{"
[Either TypeClass (Text, InfernoType)]
res <- forall a. TyParser a -> TyParser [a]
listParser TyParser (Either TypeClass (Text, InfernoType))
tyContextSingle
Text
_ <- forall r. Text -> SomeParser r Text
symbol Text
"}"
Text
_ <- (forall r. Text -> SomeParser r Text
symbol Text
"=>" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall r. Text -> SomeParser r Text
symbol Text
"⇒")
return [Either TypeClass (Text, InfernoType)]
res
typeClass :: TyParser TypeClass
typeClass :: TyParser TypeClass
typeClass = Text -> [InfernoType] -> TypeClass
TypeClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r a. SomeParser r a -> SomeParser r a
lexeme TyParser Text
typeIdent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
"on") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many TyParser InfernoType
typeParser)
tyContextSingle :: TyParser (Either TypeClass (Text, InfernoType))
tyContextSingle :: TyParser (Either TypeClass (Text, InfernoType))
tyContextSingle = (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. Text -> SomeParser r Text
symbol Text
"requires" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TyParser TypeClass
typeClass)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. Text -> SomeParser r Text
symbol Text
"implicit" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall r a. SomeParser r a -> SomeParser r a
lexeme (forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\(Map Text Int
_, OpsTable
ops, Map ModuleName OpsTable
m) -> (OpsTable
ops, Map ModuleName OpsTable
m)) Parser Text
variable)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall r. Text -> SomeParser r Text
symbol Text
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TyParser InfernoType
typeParser)))
schemeParser :: TyParser TCScheme
schemeParser :: TyParser TCScheme
schemeParser = do
[Text]
vars <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall r. Text -> SomeParser r ()
rword Text
"forall" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ TyParser Text
type_variable_raw) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r ()
rword Text
".") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\(Map Text Int
_, OpsTable
ops, Map ModuleName OpsTable
m) -> (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
vars [Int
0 ..], OpsTable
ops, Map ModuleName OpsTable
m)) forall a b. (a -> b) -> a -> b
$
[Either TypeClass (Text, InfernoType)] -> InfernoType -> TCScheme
constructScheme forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try TyParser [Either TypeClass (Text, InfernoType)]
tyContext forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TyParser InfernoType
typeParser
where
constructScheme :: [Either TypeClass (Text, InfernoType)] -> InfernoType -> TCScheme
constructScheme :: [Either TypeClass (Text, InfernoType)] -> InfernoType -> TCScheme
constructScheme [Either TypeClass (Text, InfernoType)]
cs InfernoType
t =
let ([TypeClass]
tcs, [(Text, InfernoType)]
impls) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either TypeClass (Text, InfernoType)]
cs
in Set TypeClass -> ImplType -> TCScheme
closeOver (forall a. Ord a => [a] -> Set a
Set.fromList [TypeClass]
tcs) forall a b. (a -> b) -> a -> b
$ Map ExtIdent InfernoType -> InfernoType -> ImplType
ImplType (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Either Int Text -> ExtIdent
ExtIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall a. a -> a
id) [(Text, InfernoType)]
impls) InfernoType
t
doc :: Parser Text
doc :: Parser Text
doc = do
Text
_ <- forall r. Text -> SomeParser r Text
symbol Text
"@doc"
Text
txt <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
';')
Text
_ <- forall r. Text -> SomeParser r Text
symbol Text
";"
return Text
txt
data TopLevelDefn def
= Signature
{ forall def. TopLevelDefn def -> Maybe Text
documentation :: Maybe Text,
forall def. TopLevelDefn def -> SigVar
name :: SigVar,
forall def. TopLevelDefn def -> def
def :: def
}
| EnumDef (Maybe Text) Text [Ident]
| TypeClassInstance TypeClass
| Export ModuleName
deriving (TopLevelDefn def -> TopLevelDefn def -> Bool
forall def. Eq def => TopLevelDefn def -> TopLevelDefn def -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopLevelDefn def -> TopLevelDefn def -> Bool
$c/= :: forall def. Eq def => TopLevelDefn def -> TopLevelDefn def -> Bool
== :: TopLevelDefn def -> TopLevelDefn def -> Bool
$c== :: forall def. Eq def => TopLevelDefn def -> TopLevelDefn def -> Bool
Eq, Int -> TopLevelDefn def -> [Char] -> [Char]
forall def. Show def => Int -> TopLevelDefn def -> [Char] -> [Char]
forall def. Show def => [TopLevelDefn def] -> [Char] -> [Char]
forall def. Show def => TopLevelDefn def -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [TopLevelDefn def] -> [Char] -> [Char]
$cshowList :: forall def. Show def => [TopLevelDefn def] -> [Char] -> [Char]
show :: TopLevelDefn def -> [Char]
$cshow :: forall def. Show def => TopLevelDefn def -> [Char]
showsPrec :: Int -> TopLevelDefn def -> [Char] -> [Char]
$cshowsPrec :: forall def. Show def => Int -> TopLevelDefn def -> [Char] -> [Char]
Show, TopLevelDefn def -> DataType
TopLevelDefn def -> Constr
forall {def}. Data def => Typeable (TopLevelDefn def)
forall def. Data def => TopLevelDefn def -> DataType
forall def. Data def => TopLevelDefn def -> Constr
forall def.
Data def =>
(forall b. Data b => b -> b)
-> TopLevelDefn def -> TopLevelDefn def
forall def u.
Data def =>
Int -> (forall d. Data d => d -> u) -> TopLevelDefn def -> u
forall def u.
Data def =>
(forall d. Data d => d -> u) -> TopLevelDefn def -> [u]
forall def r r'.
Data def =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDefn def -> r
forall def r r'.
Data def =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDefn def -> r
forall def (m :: * -> *).
(Data def, Monad m) =>
(forall d. Data d => d -> m d)
-> TopLevelDefn def -> m (TopLevelDefn def)
forall def (m :: * -> *).
(Data def, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TopLevelDefn def -> m (TopLevelDefn def)
forall def (c :: * -> *).
Data def =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TopLevelDefn def)
forall def (c :: * -> *).
Data def =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TopLevelDefn def -> c (TopLevelDefn def)
forall def (t :: * -> *) (c :: * -> *).
(Data def, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TopLevelDefn def))
forall def (t :: * -> * -> *) (c :: * -> *).
(Data def, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TopLevelDefn def))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TopLevelDefn def)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TopLevelDefn def -> c (TopLevelDefn def)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TopLevelDefn def))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TopLevelDefn def -> m (TopLevelDefn def)
$cgmapMo :: forall def (m :: * -> *).
(Data def, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TopLevelDefn def -> m (TopLevelDefn def)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TopLevelDefn def -> m (TopLevelDefn def)
$cgmapMp :: forall def (m :: * -> *).
(Data def, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TopLevelDefn def -> m (TopLevelDefn def)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TopLevelDefn def -> m (TopLevelDefn def)
$cgmapM :: forall def (m :: * -> *).
(Data def, Monad m) =>
(forall d. Data d => d -> m d)
-> TopLevelDefn def -> m (TopLevelDefn def)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TopLevelDefn def -> u
$cgmapQi :: forall def u.
Data def =>
Int -> (forall d. Data d => d -> u) -> TopLevelDefn def -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TopLevelDefn def -> [u]
$cgmapQ :: forall def u.
Data def =>
(forall d. Data d => d -> u) -> TopLevelDefn def -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDefn def -> r
$cgmapQr :: forall def r r'.
Data def =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDefn def -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDefn def -> r
$cgmapQl :: forall def r r'.
Data def =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TopLevelDefn def -> r
gmapT :: (forall b. Data b => b -> b)
-> TopLevelDefn def -> TopLevelDefn def
$cgmapT :: forall def.
Data def =>
(forall b. Data b => b -> b)
-> TopLevelDefn def -> TopLevelDefn def
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TopLevelDefn def))
$cdataCast2 :: forall def (t :: * -> * -> *) (c :: * -> *).
(Data def, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TopLevelDefn def))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TopLevelDefn def))
$cdataCast1 :: forall def (t :: * -> *) (c :: * -> *).
(Data def, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TopLevelDefn def))
dataTypeOf :: TopLevelDefn def -> DataType
$cdataTypeOf :: forall def. Data def => TopLevelDefn def -> DataType
toConstr :: TopLevelDefn def -> Constr
$ctoConstr :: forall def. Data def => TopLevelDefn def -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TopLevelDefn def)
$cgunfold :: forall def (c :: * -> *).
Data def =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TopLevelDefn def)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TopLevelDefn def -> c (TopLevelDefn def)
$cgfoldl :: forall def (c :: * -> *).
Data def =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TopLevelDefn def -> c (TopLevelDefn def)
Data)
enumConstructors :: Parser [Ident]
enumConstructors :: Parser [Ident]
enumConstructors = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r a. SomeParser r a -> SomeParser r a
lexeme forall r. SomeParser r Ident
enumConstructor forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
"|") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Ident]
enumConstructors) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. SomeParser r a -> SomeParser r a
lexeme forall r. SomeParser r Ident
enumConstructor
sigVariable :: Parser SigVar
sigVariable :: Parser SigVar
sigVariable =
forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(IntMap [(Fixity, Scoped ModuleName, Tokens Text)]
opsTable, Map ModuleName OpsTable
_) ->
let opList :: [Tokens Text]
opList =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
( \case
(InfixOp InfixFixity
_, Scoped ModuleName
_ns, Tokens Text
i) -> [Tokens Text
i]
(Fixity, Scoped ModuleName, Tokens Text)
_ -> []
)
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [a]
IntMap.elems IntMap [(Fixity, Scoped ModuleName, Tokens Text)]
opsTable
preOpList :: [Tokens Text]
preOpList =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
( \case
(Fixity
PrefixOp, Scoped ModuleName
_ns, Tokens Text
i) -> [Tokens Text
i]
(Fixity, Scoped ModuleName, Tokens Text)
_ -> []
)
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [a]
IntMap.elems IntMap [(Fixity, Scoped ModuleName, Tokens Text)]
opsTable
in forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$
(forall t a. (t -> Parser a) -> [t] -> Parser a
tryMany (\Tokens Text
op -> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> SigVar
SigOpVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
op) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')') [Tokens Text]
opList)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall t a. (t -> Parser a) -> [t] -> Parser a
tryMany (\Tokens Text
op -> (Text -> SigVar
SigVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
op)) [Tokens Text]
preOpList)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> SigVar
SigVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
variable)
data QQDefinition = QQRawDef String | QQToValueDef String | InlineDef (Expr () SourcePos) deriving (Typeable QQDefinition
QQDefinition -> DataType
QQDefinition -> Constr
(forall b. Data b => b -> b) -> QQDefinition -> QQDefinition
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> QQDefinition -> u
forall u. (forall d. Data d => d -> u) -> QQDefinition -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QQDefinition -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QQDefinition -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QQDefinition -> m QQDefinition
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDefinition -> m QQDefinition
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QQDefinition
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QQDefinition -> c QQDefinition
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QQDefinition)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c QQDefinition)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDefinition -> m QQDefinition
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDefinition -> m QQDefinition
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDefinition -> m QQDefinition
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDefinition -> m QQDefinition
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QQDefinition -> m QQDefinition
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QQDefinition -> m QQDefinition
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QQDefinition -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QQDefinition -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> QQDefinition -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> QQDefinition -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QQDefinition -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QQDefinition -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QQDefinition -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QQDefinition -> r
gmapT :: (forall b. Data b => b -> b) -> QQDefinition -> QQDefinition
$cgmapT :: (forall b. Data b => b -> b) -> QQDefinition -> QQDefinition
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c QQDefinition)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c QQDefinition)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QQDefinition)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QQDefinition)
dataTypeOf :: QQDefinition -> DataType
$cdataTypeOf :: QQDefinition -> DataType
toConstr :: QQDefinition -> Constr
$ctoConstr :: QQDefinition -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QQDefinition
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QQDefinition
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QQDefinition -> c QQDefinition
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QQDefinition -> c QQDefinition
Data)
exprOrBuiltin :: Parser QQDefinition
exprOrBuiltin :: Parser QQDefinition
exprOrBuiltin =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (([Char] -> QQDefinition
QQToValueDef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. SomeParser r a -> SomeParser r a
lexeme (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"###" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall a b. a -> b -> a
const (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)) Parser Text
variable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"###"))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (([Char] -> QQDefinition
QQRawDef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. SomeParser r a -> SomeParser r a
lexeme (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"###!" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall a b. a -> b -> a
const (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)) Parser Text
variable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"###"))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Expr () SourcePos -> QQDefinition
InlineDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Expr () SourcePos)
expr)
sigParser :: Parser (TopLevelDefn (Maybe TCScheme, QQDefinition))
sigParser :: Parser (TopLevelDefn (Maybe TCScheme, QQDefinition))
sigParser =
( forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall def. Maybe Text -> SigVar -> def -> TopLevelDefn def
Signature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
doc) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SigVar
sigVariable forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. Text -> SomeParser r Text
symbol Text
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\(OpsTable
ops, Map ModuleName OpsTable
m) -> (forall a. Monoid a => a
mempty, OpsTable
ops, Map ModuleName OpsTable
m)) TyParser TCScheme
schemeParser))) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall r. Text -> SomeParser r Text
symbol Text
":=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser QQDefinition
exprOrBuiltin)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall def. Maybe Text -> Text -> [Ident] -> TopLevelDefn def
EnumDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
doc) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall r. Text -> SomeParser r Text
symbol Text
"enum" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall r a. SomeParser r a -> SomeParser r a
lexeme Parser Text
variable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
":=") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Ident]
enumConstructors)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall def. Maybe Text -> Text -> [Ident] -> TopLevelDefn def
EnumDef forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. Text -> SomeParser r Text
symbol Text
"enum" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall r a. SomeParser r a -> SomeParser r a
lexeme Parser Text
variable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
":=") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Ident]
enumConstructors)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall def. TypeClass -> TopLevelDefn def
TypeClassInstance forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. Text -> SomeParser r Text
symbol Text
"define" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\(OpsTable
ops, Map ModuleName OpsTable
m) -> (forall a. Monoid a => a
mempty, OpsTable
ops, Map ModuleName OpsTable
m)) TyParser TypeClass
typeClass))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall def. ModuleName -> TopLevelDefn def
Export forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. Text -> SomeParser r Text
symbol Text
"export" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ModuleName
ModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. SomeParser r a -> SomeParser r a
lexeme Parser Text
variable))
)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
";"
fixityP :: Parser Fixity
fixityP :: Parser Fixity
fixityP =
forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall r. Text -> SomeParser r ()
rword Text
"infixr" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (InfixFixity -> Fixity
InfixOp InfixFixity
RightFix))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall r. Text -> SomeParser r ()
rword Text
"infixl" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (InfixFixity -> Fixity
InfixOp InfixFixity
LeftFix))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall r. Text -> SomeParser r ()
rword Text
"infix" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (InfixFixity -> Fixity
InfixOp InfixFixity
NoFix))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall r. Text -> SomeParser r ()
rword Text
"prefix" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Fixity
PrefixOp)
type OpsTable = IntMap.IntMap [(Fixity, Scoped ModuleName, Text)]
fixityLvl :: Parser Int
fixityLvl :: Parser Int
fixityLvl = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall r a. SomeParser r a -> SomeParser r a
lexeme forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lexer.decimal forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {m :: * -> *}. (Ord a, Num a, MonadFail m) => a -> m a
check)
where
check :: a -> m a
check a
x =
if a
x forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
< a
20
then forall (m :: * -> *) a. Monad m => a -> m a
return a
x
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Fixity level annotation must be between 0 and 19 (inclusive)"
sigsParser :: Parser (OpsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)])
sigsParser :: Parser (OpsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)])
sigsParser =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
(OpsTable, Map ModuleName OpsTable)
opDeclP forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(OpsTable, Map ModuleName OpsTable)
opsTable' -> forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall a b. a -> b -> a
const (OpsTable, Map ModuleName OpsTable)
opsTable') Parser (OpsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)])
sigsParser)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
( do
TopLevelDefn (Maybe TCScheme, QQDefinition)
def <- Parser (TopLevelDefn (Maybe TCScheme, QQDefinition))
sigParser
(OpsTable
opsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)]
defs) <- Parser (OpsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)])
sigsParser
return (OpsTable
opsTable, TopLevelDefn (Maybe TCScheme, QQDefinition)
def forall a. a -> [a] -> [a]
: [TopLevelDefn (Maybe TCScheme, QQDefinition)]
defs)
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((,[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
(OpsTable, Map ModuleName OpsTable)
opDeclP)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser (TopLevelDefn (Maybe TCScheme, QQDefinition))
sigParser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TopLevelDefn (Maybe TCScheme, QQDefinition)
r -> forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(OpsTable
opsTable, Map ModuleName OpsTable
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (OpsTable
opsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)
r]))
where
opDeclP :: ReaderT
(OpsTable, Map ModuleName OpsTable)
(WriterT Comments (Parsec InfernoParsingError Text))
(OpsTable, Map ModuleName OpsTable)
opDeclP = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(OpsTable
opsTable, Map ModuleName OpsTable
modOpsTables) -> (\Fixity
f Int
l Text
o -> (OpsTable -> Fixity -> Int -> Text -> OpsTable
insertIntoOpsTable OpsTable
opsTable Fixity
f Int
l Text
o, Map ModuleName OpsTable
modOpsTables)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Fixity
fixityP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
fixityLvl forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall {r}.
ReaderT r (WriterT Comments (Parsec InfernoParsingError Text)) Text
operatorP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall r. Text -> SomeParser r Text
symbol Text
";")
operatorP :: SomeParser r (Tokens Text)
operatorP = forall r a. SomeParser r a -> SomeParser r a
lexeme forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just [Char]
"operator") (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
';' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Token Text
c))
insertIntoOpsTable :: OpsTable -> Fixity -> Int -> Text -> OpsTable
insertIntoOpsTable :: OpsTable -> Fixity -> Int -> Text -> OpsTable
insertIntoOpsTable OpsTable
opsTable Fixity
fixity Int
lvl Text
op =
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter
( \case
Maybe [(Fixity, Scoped ModuleName, Text)]
Nothing -> forall a. a -> Maybe a
Just [(Fixity
fixity, forall a. Scoped a
LocalScope, Text
op)]
Just [(Fixity, Scoped ModuleName, Text)]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [(Fixity, Scoped ModuleName, Text)]
xs forall a. [a] -> [a] -> [a]
++ [(Fixity
fixity, forall a. Scoped a
LocalScope, Text
op)]
)
Int
lvl
OpsTable
opsTable
modulesParser :: Parser [(ModuleName, OpsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)])]
modulesParser :: Parser
[(ModuleName, OpsTable,
[TopLevelDefn (Maybe TCScheme, QQDefinition)])]
modulesParser = do
forall r. Text -> SomeParser r Text
symbol Text
"module"
ModuleName
moduleNm <- Text -> ModuleName
ModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. SomeParser r a -> SomeParser r a
lexeme Parser Text
variable
(OpsTable
ops, [TopLevelDefn (Maybe TCScheme, QQDefinition)]
sigs) <- Parser (OpsTable, [TopLevelDefn (Maybe TCScheme, QQDefinition)])
sigsParser
let opsQualified :: OpsTable
opsQualified = forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (forall a b. (a -> b) -> [a] -> [b]
map (\(Fixity
fix, Scoped ModuleName
_, Text
t) -> (Fixity
fix, forall a. a -> Scoped a
Scope ModuleName
moduleNm, Text
t))) OpsTable
ops
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
( do
[(ModuleName, OpsTable,
[TopLevelDefn (Maybe TCScheme, QQDefinition)])]
ms <- forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\(OpsTable
prevOps, Map ModuleName OpsTable
modOpsTables) -> (forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith forall a. Semigroup a => a -> a -> a
(<>) OpsTable
prevOps OpsTable
opsQualified, forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ModuleName
moduleNm OpsTable
ops Map ModuleName OpsTable
modOpsTables)) Parser
[(ModuleName, OpsTable,
[TopLevelDefn (Maybe TCScheme, QQDefinition)])]
modulesParser
pure $ (ModuleName
moduleNm, OpsTable
ops, [TopLevelDefn (Maybe TCScheme, QQDefinition)]
sigs) forall a. a -> [a] -> [a]
: [(ModuleName, OpsTable,
[TopLevelDefn (Maybe TCScheme, QQDefinition)])]
ms
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure [(ModuleName
moduleNm, OpsTable
ops, [TopLevelDefn (Maybe TCScheme, QQDefinition)]
sigs)]
topLevel :: SomeParser r a -> SomeParser r a
topLevel :: forall r a. SomeParser r a -> SomeParser r a
topLevel SomeParser r a
p = forall r. SomeParser r ()
sc forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SomeParser r a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof