{-# 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

-- | Converts a curried function to a function on a triple.
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 Comments = 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 ()
skipLineComment :: forall r. SomeParser r ()
skipLineComment = 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 ()
skipBlockComment :: forall r. SomeParser r ()
skipBlockComment = 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' parses something between parenthesis.
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' for parsing reserved words.
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' parses an integer with an optional sign (with no space)
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

-- | 'signedInteger' parses a float/double with an optional sign (with no space)
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' and 'doubleE' parse unsigned numbers
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
  -- The | is optional before the first match clause:
  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 [])

-- parsing types

type TyParser = ReaderT (Map.Map Text Int, OpsTable, Map.Map ModuleName OpsTable) (WriterT Comments (Parsec InfernoParsingError Text))

rws_type :: [Text] -- list of reserved type sig words
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