{- -----------------------------------------------------------------------------
Copyright 2019-2023 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

module Parser.Procedure (
  MarkType(..),
  PragmaExpr(..),
  PragmaStatement(..),
  pragmaExprLookup,
  pragmaHidden,
  pragmaNoTrace,
  pragmaReadOnly,
  pragmaSourceContext,
  pragmaTraceCreation,
) where

import Control.Monad (when)
import qualified Data.Set as Set

import Base.CompilerError
import Base.Positional
import Parser.Common
import Parser.Pragma
import Parser.TextParser
import Parser.TypeCategory ()
import Parser.TypeInstance ()
import Types.Procedure
import Types.TypeCategory


instance ParseFromSource (ExecutableProcedure SourceContext) where
  sourceParser :: TextParser (ExecutableProcedure SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"executable procedure" forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    FunctionName
n <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a. ParseFromSource a => TextParser a
sourceParser
    ArgValues SourceContext
as <- forall a. ParseFromSource a => TextParser a
sourceParser
    ReturnValues SourceContext
rs <- forall a. ParseFromSource a => TextParser a
sourceParser
    forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"{")
    [PragmaProcedure SourceContext]
pragmas <- forall a. [TextParser a] -> TextParser [a]
parsePragmas [TextParser (PragmaProcedure SourceContext)
pragmaNoTrace,TextParser (PragmaProcedure SourceContext)
pragmaTraceCreation]
    Procedure SourceContext
pp <- forall a. ParseFromSource a => TextParser a
sourceParser
    SourceContext
c2 <- TextParser SourceContext
getSourceContext
    forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"}")
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> [PragmaProcedure c]
-> [c]
-> FunctionName
-> ArgValues c
-> ReturnValues c
-> Procedure c
-> ExecutableProcedure c
ExecutableProcedure [SourceContext
c] [PragmaProcedure SourceContext]
pragmas [SourceContext
c2] FunctionName
n ArgValues SourceContext
as ReturnValues SourceContext
rs Procedure SourceContext
pp

instance ParseFromSource (TestProcedure SourceContext) where
  sourceParser :: TextParser (TestProcedure SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"test procedure" forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    TextParser ()
kwUnittest
    FunctionName
n <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a. ParseFromSource a => TextParser a
sourceParser
    forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"{")
    Bool
cov <- ParsecT CompilerMessage String Identity Bool
coveragePragma forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Procedure SourceContext
pp <- forall a. ParseFromSource a => TextParser a
sourceParser
    forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"}")
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> FunctionName -> Bool -> Procedure c -> TestProcedure c
TestProcedure [SourceContext
c] FunctionName
n Bool
cov Procedure SourceContext
pp where
      coveragePragma :: ParsecT CompilerMessage String Identity Bool
coveragePragma = forall a.
String
-> Either (SourceContext -> a) (SourceContext -> TextParser a)
-> TextParser a
autoPragma String
"DisableCoverage" forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a b. a -> b -> a
const Bool
True)

instance ParseFromSource (ArgValues SourceContext) where
  sourceParser :: TextParser (ArgValues SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"procedure arguments" forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    [InputValue SourceContext]
as <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"(")
                  (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
")")
                  (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
","))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Positional (InputValue c) -> ArgValues c
ArgValues [SourceContext
c] (forall a. [a] -> Positional a
Positional [InputValue SourceContext]
as)

instance ParseFromSource (ReturnValues SourceContext) where
  sourceParser :: TextParser (ReturnValues SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"procedure returns" forall a b. (a -> b) -> a -> b
$ TextParser (ReturnValues SourceContext)
namedReturns forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (ReturnValues SourceContext)
unnamedReturns where
    namedReturns :: TextParser (ReturnValues SourceContext)
namedReturns = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      [OutputValue SourceContext]
rs <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"(")
                    (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
")")
                    (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
","))
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Positional (OutputValue c) -> ReturnValues c
NamedReturns [SourceContext
c] (forall a. [a] -> Positional a
Positional [OutputValue SourceContext]
rs)
    unnamedReturns :: TextParser (ReturnValues SourceContext)
unnamedReturns = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (String -> TextParser ()
string_ String
"(")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> ReturnValues c
UnnamedReturns [SourceContext
c]

instance ParseFromSource VariableName where
  sourceParser :: TextParser VariableName
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"variable name" forall a b. (a -> b) -> a -> b
$ do
    TextParser ()
noKeywords
    Char
b <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
    String
e <- forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ 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 (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> VariableName
boxVariableName (Char
bforall a. a -> [a] -> [a]
:String
e)

boxVariableName :: String -> VariableName
boxVariableName :: String -> VariableName
boxVariableName String
n
  | String
n forall a. Eq a => a -> a -> Bool
== String
"self" = VariableName
VariableSelf
  | Bool
otherwise   = String -> VariableName
VariableName String
n

instance ParseFromSource (InputValue SourceContext) where
  sourceParser :: TextParser (InputValue SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"input variable" forall a b. (a -> b) -> a -> b
$ TextParser (InputValue SourceContext)
variable forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (InputValue SourceContext)
discard where
    variable :: TextParser (InputValue SourceContext)
variable = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      VariableName
v <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> VariableName -> InputValue c
InputValue [SourceContext
c] VariableName
v
    discard :: TextParser (InputValue SourceContext)
discard = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      forall a. TextParser a -> TextParser ()
sepAfter_ TextParser ()
kwIgnore
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> InputValue c
DiscardInput [SourceContext
c]

instance ParseFromSource (OutputValue SourceContext) where
  sourceParser :: TextParser (OutputValue SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"output variable" forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    VariableName
v <- forall a. ParseFromSource a => TextParser a
sourceParser
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> VariableName -> OutputValue c
OutputValue [SourceContext
c] VariableName
v

instance ParseFromSource (Procedure SourceContext) where
  sourceParser :: TextParser (Procedure SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"procedure" forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    [Statement SourceContext]
rs <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser TextParser ()
optionalSpace
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> [Statement c] -> Procedure c
Procedure [SourceContext
c] [Statement SourceContext]
rs

instance ParseFromSource (Statement SourceContext) where
  sourceParser :: TextParser (Statement SourceContext)
sourceParser = TextParser (Statement SourceContext)
parseReturn forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (Statement SourceContext)
parseBreak forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (Statement SourceContext)
parseContinue forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (Statement SourceContext)
parseFailCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (Statement SourceContext)
parseExitCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (Statement SourceContext)
parseVoid forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (Statement SourceContext)
parseSwap forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (Statement SourceContext)
parseAssign forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (Statement SourceContext)
parsePragma forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (Statement SourceContext)
parseIgnore where
    parseAssign :: TextParser (Statement SourceContext)
parseAssign = forall a. String -> TextParser a -> TextParser a
labeled String
"assignment" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      [Assignable SourceContext]
as <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
",")
      case [Assignable SourceContext]
as of
           [ExistingVariable (InputValue [SourceContext]
_ VariableName
n)] -> forall {c}.
ParseFromSource (Expression c) =>
c
-> VariableName
-> ParsecT CompilerMessage String Identity (Statement c)
parseAssignEmpty SourceContext
c VariableName
n forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {c}.
ParseFromSource (Expression c) =>
c
-> [Assignable c]
-> ParsecT CompilerMessage String Identity (Statement c)
parseAlwaysAssign SourceContext
c [Assignable SourceContext]
as
           [Assignable SourceContext]
_ -> forall {c}.
ParseFromSource (Expression c) =>
c
-> [Assignable c]
-> ParsecT CompilerMessage String Identity (Statement c)
parseAlwaysAssign SourceContext
c [Assignable SourceContext]
as
    parseAssignEmpty :: c
-> VariableName
-> ParsecT CompilerMessage String Identity (Statement c)
parseAssignEmpty c
c VariableName
n = do
      TextParser ()
assignEmptyOperator
      Expression c
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      TextParser ()
statementEnd
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> VariableName -> Expression c -> Statement c
AssignmentEmpty [c
c] VariableName
n Expression c
e
    parseAlwaysAssign :: c
-> [Assignable c]
-> ParsecT CompilerMessage String Identity (Statement c)
parseAlwaysAssign c
c [Assignable c]
as = do
      TextParser ()
assignOperator
      forall {c}.
ParseFromSource (Expression c) =>
c
-> [Assignable c]
-> ParsecT CompilerMessage String Identity (Statement c)
assignExpr c
c [Assignable c]
as forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {c}.
c
-> [Assignable c]
-> ParsecT CompilerMessage String Identity (Statement c)
assignDefer c
c [Assignable c]
as
    parseSwap :: TextParser (Statement SourceContext)
parseSwap = forall a. String -> TextParser a -> TextParser a
labeled String
"swap" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      OutputValue SourceContext
l <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
        OutputValue SourceContext
var <- forall a. ParseFromSource a => TextParser a
sourceParser
        TextParser ()
swapOperator
        forall (m :: * -> *) a. Monad m => a -> m a
return OutputValue SourceContext
var
      OutputValue SourceContext
r <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> OutputValue c -> OutputValue c -> Statement c
VariableSwap [SourceContext
c] OutputValue SourceContext
l OutputValue SourceContext
r
    assignExpr :: c
-> [Assignable c]
-> ParsecT CompilerMessage String Identity (Statement c)
assignExpr c
c [Assignable c]
as = do
      Expression c
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      TextParser ()
statementEnd
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> Positional (Assignable c) -> Expression c -> Statement c
Assignment [c
c] (forall a. [a] -> Positional a
Positional [Assignable c]
as) Expression c
e
    assignDefer :: c
-> [Assignable c]
-> ParsecT CompilerMessage String Identity (Statement c)
assignDefer c
c [Assignable c]
as = do
      TextParser ()
kwDefer
      TextParser ()
statementEnd
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> [Assignable c] -> Statement c
DeferredVariables [c
c] [Assignable c]
as
    parseBreak :: TextParser (Statement SourceContext)
parseBreak = forall a. String -> TextParser a -> TextParser a
labeled String
"break" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwBreak
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Statement c
LoopBreak [SourceContext
c]
    parseContinue :: TextParser (Statement SourceContext)
parseContinue = forall a. String -> TextParser a -> TextParser a
labeled String
"continue" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwContinue
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Statement c
LoopContinue [SourceContext
c]
    parseFailCall :: TextParser (Statement SourceContext)
parseFailCall = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwFail
      Expression SourceContext
e <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"(") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
")") forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Expression c -> Statement c
FailCall [SourceContext
c] Expression SourceContext
e
    parseExitCall :: TextParser (Statement SourceContext)
parseExitCall = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwExit
      Expression SourceContext
e <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"(") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
")") forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Expression c -> Statement c
ExitCall [SourceContext
c] Expression SourceContext
e
    parseIgnore :: TextParser (Statement SourceContext)
parseIgnore = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
statementStart
      Expression SourceContext
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      TextParser ()
statementEnd
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Expression c -> Statement c
IgnoreValues [SourceContext
c] Expression SourceContext
e
    parseReturn :: TextParser (Statement SourceContext)
parseReturn = forall a. String -> TextParser a -> TextParser a
labeled String
"return" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwReturn
      SourceContext -> TextParser (Statement SourceContext)
emptyReturn SourceContext
c forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SourceContext -> TextParser (Statement SourceContext)
multiReturn SourceContext
c
    multiReturn :: SourceContext -> TextParser (Statement SourceContext)
    multiReturn :: SourceContext -> TextParser (Statement SourceContext)
multiReturn SourceContext
c = do
      [Expression SourceContext]
rs <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
",")
      TextParser ()
statementEnd
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Positional (Expression c) -> Statement c
ExplicitReturn [SourceContext
c] (forall a. [a] -> Positional a
Positional [Expression SourceContext]
rs)
    emptyReturn :: SourceContext -> TextParser (Statement SourceContext)
    emptyReturn :: SourceContext -> TextParser (Statement SourceContext)
emptyReturn SourceContext
c = do
      TextParser ()
kwIgnore
      TextParser ()
statementEnd
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Statement c
EmptyReturn [SourceContext
c]
    parseVoid :: TextParser (Statement SourceContext)
parseVoid = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      VoidExpression SourceContext
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> VoidExpression c -> Statement c
NoValueExpression [SourceContext
c] VoidExpression SourceContext
e
    parsePragma :: TextParser (Statement SourceContext)
parsePragma = ((ParsecT
  CompilerMessage String Identity (PragmaStatement SourceContext)
pragmaReadOnly forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  CompilerMessage String Identity (PragmaStatement SourceContext)
pragmaHidden) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {c}.
Monad m =>
PragmaStatement c -> m (Statement c)
markPragma) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                  TextParser (Statement SourceContext)
pragmaValidateRefs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. TextParser a
unknownPragma
    markPragma :: PragmaStatement c -> m (Statement c)
markPragma PragmaStatement c
p =
      case PragmaStatement c
p of
           PragmaMarkVars [c]
c MarkType
ReadOnly [VariableName]
vs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> [VariableName] -> Statement c
MarkReadOnly [c]
c [VariableName]
vs
           PragmaMarkVars [c]
c MarkType
Hidden   [VariableName]
vs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> [VariableName] -> Statement c
MarkHidden   [c]
c [VariableName]
vs

instance ParseFromSource (Assignable SourceContext) where
  sourceParser :: TextParser (Assignable SourceContext)
sourceParser = TextParser (Assignable SourceContext)
existing forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (Assignable SourceContext)
create where
    create :: TextParser (Assignable SourceContext)
create = forall a. String -> TextParser a -> TextParser a
labeled String
"variable creation" forall a b. (a -> b) -> a -> b
$ do
      ValueType
t <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall a. TextParser a
strayFuncCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      SourceContext
c <- TextParser SourceContext
getSourceContext
      VariableName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> ValueType -> VariableName -> Assignable c
CreateVariable [SourceContext
c] ValueType
t VariableName
n
    existing :: TextParser (Assignable SourceContext)
existing = forall a. String -> TextParser a -> TextParser a
labeled String
"variable name" forall a b. (a -> b) -> a -> b
$ do
      InputValue SourceContext
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall a. TextParser a
strayFuncCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. InputValue c -> Assignable c
ExistingVariable InputValue SourceContext
n
    strayFuncCall :: ParsecT CompilerMessage String Identity b
strayFuncCall = do
      TextParser ()
valueSymbolGet forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ()
typeSymbolGet forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ()
categorySymbolGet
      forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"function returns must be explicitly handled"

instance ParseFromSource (VoidExpression SourceContext) where
  sourceParser :: TextParser (VoidExpression SourceContext)
sourceParser = TextParser (VoidExpression SourceContext)
conditional forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (VoidExpression SourceContext)
loop forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (VoidExpression SourceContext)
scoped where
    conditional :: TextParser (VoidExpression SourceContext)
conditional = do
      IfElifElse SourceContext
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. IfElifElse c -> VoidExpression c
Conditional IfElifElse SourceContext
e
    loop :: TextParser (VoidExpression SourceContext)
loop = do
      IteratedLoop SourceContext
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. IteratedLoop c -> VoidExpression c
Loop IteratedLoop SourceContext
e
    scoped :: TextParser (VoidExpression SourceContext)
scoped = do
      ScopedBlock SourceContext
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. ScopedBlock c -> VoidExpression c
WithScope ScopedBlock SourceContext
e

instance ParseFromSource (IfElifElse SourceContext) where
  sourceParser :: TextParser (IfElifElse SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"if-elif-else" forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    TextParser ()
kwIf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SourceContext -> TextParser (IfElifElse SourceContext)
parseIf SourceContext
c
    where
      parseIf :: SourceContext -> TextParser (IfElifElse SourceContext)
parseIf SourceContext
c = do
        Expression SourceContext
i <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"(") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
")") forall a. ParseFromSource a => TextParser a
sourceParser
        Procedure SourceContext
p <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"{") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"}") forall a. ParseFromSource a => TextParser a
sourceParser
        IfElifElse SourceContext
next <- TextParser (IfElifElse SourceContext)
parseElif forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (IfElifElse SourceContext)
parseElse forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall c. IfElifElse c
TerminateConditional
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> Expression c -> Procedure c -> IfElifElse c -> IfElifElse c
IfStatement [SourceContext
c] Expression SourceContext
i Procedure SourceContext
p IfElifElse SourceContext
next
      parseElif :: TextParser (IfElifElse SourceContext)
parseElif = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        TextParser ()
kwElif forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SourceContext -> TextParser (IfElifElse SourceContext)
parseIf SourceContext
c
      parseElse :: TextParser (IfElifElse SourceContext)
parseElse = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        TextParser ()
kwElse
        Procedure SourceContext
p <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"{") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"}") forall a. ParseFromSource a => TextParser a
sourceParser
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Procedure c -> IfElifElse c
ElseStatement [SourceContext
c] Procedure SourceContext
p

instance ParseFromSource (IteratedLoop SourceContext) where
  sourceParser :: TextParser (IteratedLoop SourceContext)
sourceParser = TextParser (IteratedLoop SourceContext)
while forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (IteratedLoop SourceContext)
trav where
    while :: TextParser (IteratedLoop SourceContext)
while = forall a. String -> TextParser a -> TextParser a
labeled String
"while" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwWhile
      Expression SourceContext
i <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"(") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
")") forall a. ParseFromSource a => TextParser a
sourceParser
      Procedure SourceContext
p <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"{") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"}") forall a. ParseFromSource a => TextParser a
sourceParser
      Maybe (Procedure SourceContext)
u <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just TextParser (Procedure SourceContext)
parseUpdate forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Expression c
-> Procedure c
-> Maybe (Procedure c)
-> IteratedLoop c
WhileLoop [SourceContext
c] Expression SourceContext
i Procedure SourceContext
p Maybe (Procedure SourceContext)
u
    trav :: TextParser (IteratedLoop SourceContext)
trav = forall a. String -> TextParser a -> TextParser a
labeled String
"traverse" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c1 <- TextParser SourceContext
getSourceContext
      TextParser ()
kwTraverse
      forall a. TextParser a -> TextParser ()
sepAfter_ forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"("
      Expression SourceContext
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall a. TextParser a -> TextParser ()
sepAfter_ forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"->"
      SourceContext
c2 <- TextParser SourceContext
getSourceContext
      Assignable SourceContext
a <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall a. TextParser a -> TextParser ()
sepAfter_ forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
")"
      Procedure SourceContext
p <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"{") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"}") forall a. ParseFromSource a => TextParser a
sourceParser
      Maybe (Procedure SourceContext)
u <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just TextParser (Procedure SourceContext)
parseUpdate forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Expression c
-> [c]
-> Assignable c
-> Procedure c
-> Maybe (Procedure c)
-> IteratedLoop c
TraverseLoop [SourceContext
c1] Expression SourceContext
e [SourceContext
c2] Assignable SourceContext
a Procedure SourceContext
p Maybe (Procedure SourceContext)
u
    parseUpdate :: TextParser (Procedure SourceContext)
parseUpdate = do
      TextParser ()
kwUpdate
      forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"{") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"}") forall a. ParseFromSource a => TextParser a
sourceParser

instance ParseFromSource (ScopedBlock SourceContext) where
  sourceParser :: TextParser (ScopedBlock SourceContext)
sourceParser = TextParser (ScopedBlock SourceContext)
scoped forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (ScopedBlock SourceContext)
justCleanup where
    scoped :: TextParser (ScopedBlock SourceContext)
scoped = forall a. String -> TextParser a -> TextParser a
labeled String
"scoped" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwScoped
      Procedure SourceContext
p <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"{") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"}") forall a. ParseFromSource a => TextParser a
sourceParser
      Maybe (Procedure SourceContext)
cl <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just TextParser (Procedure SourceContext)
parseCleanup forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      TextParser ()
kwIn
      SourceContext
c2 <- TextParser SourceContext
getSourceContext
      -- TODO: If there's a parse error in an otherwise-valid {} then the actual
      -- error might look like a multi-assignment issue.
      Statement SourceContext
s <- TextParser (Statement SourceContext)
unconditional forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Procedure c
-> Maybe (Procedure c)
-> [c]
-> Statement c
-> ScopedBlock c
ScopedBlock [SourceContext
c] Procedure SourceContext
p Maybe (Procedure SourceContext)
cl [SourceContext
c2] Statement SourceContext
s
    justCleanup :: TextParser (ScopedBlock SourceContext)
justCleanup = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      Procedure SourceContext
cl <- TextParser (Procedure SourceContext)
parseCleanup
      TextParser ()
kwIn
      SourceContext
c2 <- TextParser SourceContext
getSourceContext
      Statement SourceContext
s <- forall a. ParseFromSource a => TextParser a
sourceParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (Statement SourceContext)
unconditional
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Procedure c
-> Maybe (Procedure c)
-> [c]
-> Statement c
-> ScopedBlock c
ScopedBlock [SourceContext
c] (forall c. [c] -> [Statement c] -> Procedure c
Procedure [] []) (forall a. a -> Maybe a
Just Procedure SourceContext
cl) [SourceContext
c2] Statement SourceContext
s
    parseCleanup :: TextParser (Procedure SourceContext)
parseCleanup = do
      TextParser ()
kwCleanup
      forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"{") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"}") forall a. ParseFromSource a => TextParser a
sourceParser
    unconditional :: TextParser (Statement SourceContext)
unconditional = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      Procedure SourceContext
p <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"{") (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"}") forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> VoidExpression c -> Statement c
NoValueExpression [SourceContext
c] (forall c. Procedure c -> VoidExpression c
Unconditional Procedure SourceContext
p)

unaryOperator :: TextParser (Operator SourceContext)
unaryOperator :: TextParser (Operator SourceContext)
unaryOperator = do
  SourceContext
c <- TextParser SourceContext
getSourceContext
  String
o <- TextParser String
op
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> String -> Operator c
NamedOperator [SourceContext
c] String
o where
    op :: TextParser String
op = forall a. String -> TextParser a -> TextParser a
labeled String
"unary operator" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a. Alternative f => f a
empty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TextParser String
operator) [String]
ops
    ops :: [String]
ops = [String]
logicalUnary forall a. [a] -> [a] -> [a]
++ [String]
arithUnary forall a. [a] -> [a] -> [a]
++ [String]
bitwiseUnary

logicalUnary :: [String]
logicalUnary :: [String]
logicalUnary = [String
"!"]

arithUnary :: [String]
arithUnary :: [String]
arithUnary = [String
"-"]

bitwiseUnary :: [String]
bitwiseUnary :: [String]
bitwiseUnary = [String
"~"]

infixOperator :: TextParser (Operator SourceContext)
infixOperator :: TextParser (Operator SourceContext)
infixOperator =  do
  SourceContext
c <- TextParser SourceContext
getSourceContext
  String
o <- TextParser String
op
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> String -> Operator c
NamedOperator [SourceContext
c] String
o where
    op :: TextParser String
op = forall a. String -> TextParser a -> TextParser a
labeled String
"binary operator" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a. Alternative f => f a
empty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TextParser String
operator) [String]
ops
    ops :: [String]
ops = [String]
compareInfix forall a. [a] -> [a] -> [a]
++ [String]
logicalInfix forall a. [a] -> [a] -> [a]
++ [String]
addInfix forall a. [a] -> [a] -> [a]
++ [String]
subInfix forall a. [a] -> [a] -> [a]
++ [String]
multInfix forall a. [a] -> [a] -> [a]
++ [String]
divInfix forall a. [a] -> [a] -> [a]
++ [String]
bitwiseInfix forall a. [a] -> [a] -> [a]
++ [String]
bitshiftInfix

compareInfix :: [String]
compareInfix :: [String]
compareInfix = [String
"==",String
"!=",String
"<",String
"<=",String
">",String
">="]

logicalInfix :: [String]
logicalInfix :: [String]
logicalInfix = [String
"&&",String
"||"]

addInfix :: [String]
addInfix :: [String]
addInfix = [String
"+"]

subInfix :: [String]
subInfix :: [String]
subInfix = [String
"-"]

multInfix :: [String]
multInfix :: [String]
multInfix = [String
"*"]

divInfix :: [String]
divInfix :: [String]
divInfix = [String
"/",String
"%"]

bitwiseInfix :: [String]
bitwiseInfix :: [String]
bitwiseInfix = [String
"&",String
"|",String
"^"]

bitshiftInfix :: [String]
bitshiftInfix :: [String]
bitshiftInfix = [String
">>",String
"<<"]

leftAssocInfix :: [String]
leftAssocInfix :: [String]
leftAssocInfix = [String]
addInfix forall a. [a] -> [a] -> [a]
++ [String]
subInfix forall a. [a] -> [a] -> [a]
++ [String]
multInfix forall a. [a] -> [a] -> [a]
++ [String]
divInfix forall a. [a] -> [a] -> [a]
++ [String]
bitwiseInfix forall a. [a] -> [a] -> [a]
++ [String]
bitshiftInfix

rightAssocInfix :: [String]
rightAssocInfix :: [String]
rightAssocInfix = [String]
logicalInfix

nonAssocInfix :: [String]
nonAssocInfix :: [String]
nonAssocInfix = [String]
compareInfix

functionOperator :: TextParser (Operator SourceContext)
functionOperator :: TextParser (Operator SourceContext)
functionOperator = do
  SourceContext
c <- TextParser SourceContext
getSourceContext
  TextParser ()
infixFuncStart
  FunctionSpec SourceContext
q <- forall a. ParseFromSource a => TextParser a
sourceParser
  TextParser ()
infixFuncEnd
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> FunctionSpec c -> Operator c
FunctionOperator [SourceContext
c] FunctionSpec SourceContext
q

inOperatorSet :: Operator c -> [String] -> Bool
inOperatorSet :: forall c. Operator c -> [String] -> Bool
inOperatorSet (NamedOperator [c]
_ String
o) [String]
ss = String
o forall a. Ord a => a -> Set a -> Bool
`Set.member` forall a. Ord a => [a] -> Set a
Set.fromList [String]
ss
inOperatorSet Operator c
_                   [String]
_  = Bool
False

bothInOperatorSet :: Operator c -> Operator c -> [String] -> Bool
bothInOperatorSet :: forall c. Operator c -> Operator c -> [String] -> Bool
bothInOperatorSet Operator c
o1 Operator c
o2 [String]
ss = Operator c
o1 forall c. Operator c -> [String] -> Bool
`inOperatorSet` [String]
ss Bool -> Bool -> Bool
&& Operator c
o2 forall c. Operator c -> [String] -> Bool
`inOperatorSet` [String]
ss

infixPrecedence :: Operator c -> Int
infixPrecedence :: forall c. Operator c -> Int
infixPrecedence Operator c
o
  -- TODO: Don't hard-code this.
  | Operator c
o forall c. Operator c -> [String] -> Bool
`inOperatorSet` ([String]
multInfix forall a. [a] -> [a] -> [a]
++ [String]
divInfix forall a. [a] -> [a] -> [a]
++ [String]
bitshiftInfix) = Int
1
  | Operator c
o forall c. Operator c -> [String] -> Bool
`inOperatorSet` ([String]
addInfix forall a. [a] -> [a] -> [a]
++ [String]
subInfix forall a. [a] -> [a] -> [a]
++ [String]
bitwiseInfix) = Int
2
  | Operator c
o forall c. Operator c -> [String] -> Bool
`inOperatorSet` [String]
compareInfix = Int
4
  | Operator c
o forall c. Operator c -> [String] -> Bool
`inOperatorSet` [String]
logicalInfix = Int
5
infixPrecedence Operator c
_ = Int
3

infixBefore :: (Show c, ErrorContextM m) => Operator c -> Operator c -> m Bool
infixBefore :: forall c (m :: * -> *).
(Show c, ErrorContextM m) =>
Operator c -> Operator c -> m Bool
infixBefore Operator c
o1 Operator c
o2 = do
  let prec1 :: Int
prec1 = forall c. Operator c -> Int
infixPrecedence Operator c
o1
  let prec2 :: Int
prec2 = forall c. Operator c -> Int
infixPrecedence Operator c
o2
  if Int
prec1 forall a. Eq a => a -> a -> Bool
/= Int
prec2
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
prec1 forall a. Ord a => a -> a -> Bool
< Int
prec2
     -- NOTE: Ambiguity is checked separately so that the error occurs where the
     -- second operator is parsed, rather than at the end of the expression.
     else if forall c. Operator c -> Operator c -> [String] -> Bool
bothInOperatorSet Operator c
o1 Operator c
o2 [String]
rightAssocInfix
             then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False  -- Logical operators are right-associative.
             else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True   -- Default is left-associative.

checkAmbiguous :: (Show c, ErrorContextM m) => Operator c -> Operator c -> m ()
checkAmbiguous :: forall c (m :: * -> *).
(Show c, ErrorContextM m) =>
Operator c -> Operator c -> m ()
checkAmbiguous Operator c
o1 Operator c
o2 = m ()
checked where
  formatOperator :: Operator a -> String
formatOperator Operator a
o = forall a. Show a => a -> String
show (forall c. Operator c -> FunctionName
getOperatorName Operator a
o) forall a. [a] -> [a] -> [a]
++
                     String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContext (forall c. Operator c -> [c]
getOperatorContext Operator a
o) forall a. [a] -> [a] -> [a]
++ String
")"
  checked :: m ()
checked
    | forall c. Operator c -> Int
infixPrecedence Operator c
o1 forall a. Eq a => a -> a -> Bool
/= forall c. Operator c -> Int
infixPrecedence Operator c
o2 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | forall c. Operator c -> Operator c -> [String] -> Bool
bothInOperatorSet Operator c
o1 Operator c
o2 [String]
leftAssocInfix  = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | forall c. Operator c -> Operator c -> [String] -> Bool
bothInOperatorSet Operator c
o1 Operator c
o2 [String]
rightAssocInfix = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | forall c. Operator c -> Bool
isFunctionOperator Operator c
o1 Bool -> Bool -> Bool
&& forall c. Operator c -> Bool
isFunctionOperator Operator c
o2 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"the order of operators " forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => Operator a -> String
formatOperator Operator c
o1 forall a. [a] -> [a] -> [a]
++
                         String
" and " forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => Operator a -> String
formatOperator Operator c
o2 forall a. [a] -> [a] -> [a]
++ String
" is ambiguous"

instance ParseFromSource (Expression SourceContext) where
  sourceParser :: TextParser (Expression SourceContext)
sourceParser = do
    Expression SourceContext
e <- TextParser (Expression SourceContext)
notInfix
    [Expression SourceContext]
-> [([SourceContext], Operator SourceContext)]
-> TextParser (Expression SourceContext)
asInfix [Expression SourceContext
e] [] forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Expression SourceContext
e
    where
      -- NOTE: InitializeValue is parsed as ExpressionStart.
      notInfix :: TextParser (Expression SourceContext)
notInfix = TextParser (Expression SourceContext)
literal 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 TextParser (Expression SourceContext)
unaryBuiltin forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (Expression SourceContext)
unary forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (Expression SourceContext)
delegatedCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (Expression SourceContext)
expression
      asInfix :: [Expression SourceContext]
-> [([SourceContext], Operator SourceContext)]
-> TextParser (Expression SourceContext)
asInfix [Expression SourceContext]
es [([SourceContext], Operator SourceContext)]
os = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        Operator SourceContext
o <- TextParser (Operator SourceContext)
infixOperator forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (Operator SourceContext)
functionOperator
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([SourceContext], Operator SourceContext)]
os) forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *).
(Show c, ErrorContextM m) =>
Operator c -> Operator c -> m ()
checkAmbiguous (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [([SourceContext], Operator SourceContext)]
os) Operator SourceContext
o
        Expression SourceContext
e2 <- TextParser (Expression SourceContext)
notInfix
        let es' :: [Expression SourceContext]
es' = [Expression SourceContext]
es forall a. [a] -> [a] -> [a]
++ [Expression SourceContext
e2]
        let os' :: [([SourceContext], Operator SourceContext)]
os' = [([SourceContext], Operator SourceContext)]
os forall a. [a] -> [a] -> [a]
++ [([SourceContext
c],Operator SourceContext
o)]
        [Expression SourceContext]
-> [([SourceContext], Operator SourceContext)]
-> TextParser (Expression SourceContext)
asInfix [Expression SourceContext]
es' [([SourceContext], Operator SourceContext)]
os' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall {m :: * -> *} {c}.
(Show c, ErrorContextM m) =>
[(Expression c, [c], Operator c)]
-> [Expression c] -> [([c], Operator c)] -> m (Expression c)
infixToTree [] [Expression SourceContext]
es' [([SourceContext], Operator SourceContext)]
os')
      infixToTree :: [(Expression c, [c], Operator c)]
-> [Expression c] -> [([c], Operator c)] -> m (Expression c)
infixToTree [(Expression c
e1,[c]
c1,Operator c
o1)] [Expression c
e2] [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> Expression c -> Operator c -> Expression c -> Expression c
InfixExpression [c]
c1 Expression c
e1 Operator c
o1 Expression c
e2
      infixToTree [] (Expression c
e1:[Expression c]
es) (([c]
c1,Operator c
o1):[([c], Operator c)]
os) = [(Expression c, [c], Operator c)]
-> [Expression c] -> [([c], Operator c)] -> m (Expression c)
infixToTree [(Expression c
e1,[c]
c1,Operator c
o1)] [Expression c]
es [([c], Operator c)]
os
      infixToTree ((Expression c
e1,[c]
c1,Operator c
o1):[(Expression c, [c], Operator c)]
ss) [Expression c
e2] [] = let e2' :: Expression c
e2' = forall c.
[c] -> Expression c -> Operator c -> Expression c -> Expression c
InfixExpression [c]
c1 Expression c
e1 Operator c
o1 Expression c
e2 in
                                                [(Expression c, [c], Operator c)]
-> [Expression c] -> [([c], Operator c)] -> m (Expression c)
infixToTree [(Expression c, [c], Operator c)]
ss [Expression c
e2'] []
      infixToTree ((Expression c
e1,[c]
c1,Operator c
o1):[(Expression c, [c], Operator c)]
ss) (Expression c
e2:[Expression c]
es) (([c]
c2,Operator c
o2):[([c], Operator c)]
os) = do
        Bool
before <- Operator c
o1 forall c (m :: * -> *).
(Show c, ErrorContextM m) =>
Operator c -> Operator c -> m Bool
`infixBefore` Operator c
o2
        if Bool
before
           then let e1' :: Expression c
e1' = forall c.
[c] -> Expression c -> Operator c -> Expression c -> Expression c
InfixExpression [c]
c1 Expression c
e1 Operator c
o1 Expression c
e2 in
                          [(Expression c, [c], Operator c)]
-> [Expression c] -> [([c], Operator c)] -> m (Expression c)
infixToTree [(Expression c, [c], Operator c)]
ss (Expression c
e1'forall a. a -> [a] -> [a]
:[Expression c]
es) (([c]
c2,Operator c
o2)forall a. a -> [a] -> [a]
:[([c], Operator c)]
os)
           else [(Expression c, [c], Operator c)]
-> [Expression c] -> [([c], Operator c)] -> m (Expression c)
infixToTree ((Expression c
e2,[c]
c2,Operator c
o2)forall a. a -> [a] -> [a]
:(Expression c
e1,[c]
c1,Operator c
o1)forall a. a -> [a] -> [a]
:[(Expression c, [c], Operator c)]
ss) [Expression c]
es [([c], Operator c)]
os
      infixToTree [(Expression c, [c], Operator c)]
_ [Expression c]
_ [([c], Operator c)]
_ = forall a. HasCallStack => a
undefined
      literal :: TextParser (Expression SourceContext)
literal = do
        ValueLiteral SourceContext
l <- forall a. ParseFromSource a => TextParser a
sourceParser
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. ValueLiteral c -> Expression c
Literal ValueLiteral SourceContext
l
      unaryBuiltin :: TextParser (Expression SourceContext)
unaryBuiltin = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        TextParser ()
infixFuncStart
        FunctionName
n <- TextParser FunctionName
builtinUnary
        [InstanceOrInferred SourceContext]
ps <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"<")
                            (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
">")
                            (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
",")) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
        TextParser ()
infixFuncEnd
        Expression SourceContext
e <- TextParser (Expression SourceContext)
notInfix
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [SourceContext
c] (forall c. [c] -> FunctionCall c -> ExpressionStart c
BuiltinCall [SourceContext
c] forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [SourceContext
c] FunctionName
n (forall a. [a] -> Positional a
Positional [InstanceOrInferred SourceContext]
ps) (forall a. [a] -> Positional a
Positional [(forall a. Maybe a
Nothing,Expression SourceContext
e)])) []
      unary :: TextParser (Expression SourceContext)
unary = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        Operator SourceContext
o <- TextParser (Operator SourceContext)
unaryOperator forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (Operator SourceContext)
functionOperator
        Expression SourceContext
e <- TextParser (Expression SourceContext)
notInfix
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Operator c -> Expression c -> Expression c
UnaryExpression [SourceContext
c] Operator SourceContext
o Expression SourceContext
e
      delegatedCall :: TextParser (Expression SourceContext)
delegatedCall = do
        TextParser ()
kwDelegate
        forall a. TextParser a -> TextParser ()
sepAfter_ forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"->"
        forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try TextParser (Expression SourceContext)
delegateCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (Expression SourceContext)
delegateInit
      delegateInit :: TextParser (Expression SourceContext)
delegateInit = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        Maybe TypeInstance
t <- (TextParser ()
paramSelf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a. ParseFromSource a => TextParser a
sourceParser
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Maybe TypeInstance -> Expression c
DelegatedInitializeValue [SourceContext
c] Maybe TypeInstance
t
      delegateCall :: TextParser (Expression SourceContext)
delegateCall = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        TextParser ()
infixFuncStart
        FunctionSpec SourceContext
f <- forall a. ParseFromSource a => TextParser a
sourceParser
        TextParser ()
infixFuncEnd
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> FunctionSpec c -> Expression c
DelegatedFunctionCall [SourceContext
c] FunctionSpec SourceContext
f
      expression :: TextParser (Expression SourceContext)
expression = forall a. String -> TextParser a -> TextParser a
labeled String
"expression" forall a b. (a -> b) -> a -> b
$ do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        ExpressionStart SourceContext
s <- forall a. ParseFromSource a => TextParser a
sourceParser
        [ValueOperation SourceContext]
vs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a. ParseFromSource a => TextParser a
sourceParser)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [SourceContext
c] ExpressionStart SourceContext
s [ValueOperation SourceContext]
vs

instance ParseFromSource (FunctionQualifier SourceContext) where
  -- TODO: This is probably better done iteratively.
  sourceParser :: TextParser (FunctionQualifier SourceContext)
sourceParser = TextParser (FunctionQualifier SourceContext)
valueFunc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (FunctionQualifier SourceContext)
categoryFunc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (FunctionQualifier SourceContext)
typeFunc where
    valueFunc :: TextParser (FunctionQualifier SourceContext)
valueFunc = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      Expression SourceContext
q <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a. ParseFromSource a => TextParser a
sourceParser
      TextParser ()
valueSymbolGet
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Expression c -> FunctionQualifier c
ValueFunction [SourceContext
c] Expression SourceContext
q
    categoryFunc :: TextParser (FunctionQualifier SourceContext)
categoryFunc = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      CategoryName
q <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do  -- Avoids consuming the type name if : isn't present.
        CategoryName
q2 <- forall a. ParseFromSource a => TextParser a
sourceParser
        TextParser ()
categorySymbolGet
        forall (m :: * -> *) a. Monad m => a -> m a
return CategoryName
q2
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> CategoryName -> FunctionQualifier c
CategoryFunction [SourceContext
c] CategoryName
q
    typeFunc :: TextParser (FunctionQualifier SourceContext)
typeFunc = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TypeInstanceOrParam
q <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a. ParseFromSource a => TextParser a
sourceParser
      TextParser ()
typeSymbolGet
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> TypeInstanceOrParam -> FunctionQualifier c
TypeFunction [SourceContext
c] TypeInstanceOrParam
q

instance ParseFromSource (FunctionSpec SourceContext) where
  sourceParser :: TextParser (FunctionSpec SourceContext)
sourceParser = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try TextParser (FunctionSpec SourceContext)
qualified forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (FunctionSpec SourceContext)
unqualified where
    qualified :: TextParser (FunctionSpec SourceContext)
qualified = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      FunctionQualifier SourceContext
q <- forall a. ParseFromSource a => TextParser a
sourceParser
      FunctionName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      [InstanceOrInferred SourceContext]
ps <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"<")
                          (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
">")
                          (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
",")) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> FunctionQualifier c
-> FunctionName
-> Positional (InstanceOrInferred c)
-> FunctionSpec c
FunctionSpec [SourceContext
c] FunctionQualifier SourceContext
q FunctionName
n (forall a. [a] -> Positional a
Positional [InstanceOrInferred SourceContext]
ps)
    unqualified :: TextParser (FunctionSpec SourceContext)
unqualified = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      FunctionName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      [InstanceOrInferred SourceContext]
ps <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"<")
                          (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
">")
                          (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
",")) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> FunctionQualifier c
-> FunctionName
-> Positional (InstanceOrInferred c)
-> FunctionSpec c
FunctionSpec [SourceContext
c] forall c. FunctionQualifier c
UnqualifiedFunction FunctionName
n (forall a. [a] -> Positional a
Positional [InstanceOrInferred SourceContext]
ps)

instance ParseFromSource (InstanceOrInferred SourceContext) where
  sourceParser :: TextParser (InstanceOrInferred SourceContext)
sourceParser = TextParser (InstanceOrInferred SourceContext)
assigned forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (InstanceOrInferred SourceContext)
inferred where
    assigned :: TextParser (InstanceOrInferred SourceContext)
assigned = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      GeneralInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> GeneralInstance -> InstanceOrInferred c
AssignedInstance [SourceContext
c] GeneralInstance
t
    inferred :: TextParser (InstanceOrInferred SourceContext)
inferred = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      forall a. TextParser a -> TextParser ()
sepAfter_ TextParser ()
inferredParam
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> InstanceOrInferred c
InferredInstance [SourceContext
c]

parseFunctionCall :: SourceContext -> FunctionName -> TextParser (FunctionCall SourceContext)
parseFunctionCall :: SourceContext
-> FunctionName -> TextParser (FunctionCall SourceContext)
parseFunctionCall SourceContext
c FunctionName
n = do
  -- NOTE: try is needed here so that < operators work when the left side is
  -- just a variable name, e.g., x < y.
  [InstanceOrInferred SourceContext]
ps <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"<")
                      (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
">")
                      (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
",")) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
  [(Maybe (CallArgLabel SourceContext), Expression SourceContext)]
es <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"(")
                (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
")")
                (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT
  CompilerMessage
  String
  Identity
  (Maybe (CallArgLabel SourceContext), Expression SourceContext)
parseArg (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
","))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [SourceContext
c] FunctionName
n (forall a. [a] -> Positional a
Positional [InstanceOrInferred SourceContext]
ps) (forall a. [a] -> Positional a
Positional [(Maybe (CallArgLabel SourceContext), Expression SourceContext)]
es) where
    parseArg :: ParsecT
  CompilerMessage
  String
  Identity
  (Maybe (CallArgLabel SourceContext), Expression SourceContext)
parseArg = do
      Maybe (CallArgLabel SourceContext)
l <- 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
fmap forall a. a -> Maybe a
Just forall a. ParseFromSource a => TextParser a
sourceParser) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Expression SourceContext
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CallArgLabel SourceContext)
l,Expression SourceContext
e)

builtinFunction :: TextParser FunctionName
builtinFunction :: TextParser FunctionName
builtinFunction = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a. Alternative f => f a
empty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try [
    TextParser ()
kwPresent  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinPresent,
    TextParser ()
kwReduce   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinReduce,
    TextParser ()
kwRequire  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinRequire,
    TextParser ()
kwStrong   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinStrong,
    TextParser ()
kwIdentify forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinIdentify,
    TextParser ()
kwTypename forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinTypename
  ]

builtinUnary :: TextParser FunctionName
builtinUnary :: TextParser FunctionName
builtinUnary = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a. Alternative f => f a
empty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try [
    TextParser ()
kwPresent  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinPresent,
    TextParser ()
kwReduce   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinReduce,
    TextParser ()
kwRequire  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinRequire,
    TextParser ()
kwStrong   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinStrong,
    TextParser ()
kwIdentify forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FunctionName
BuiltinIdentify
  ]

instance ParseFromSource (ExpressionStart SourceContext) where
  sourceParser :: TextParser (ExpressionStart SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"expression start" forall a b. (a -> b) -> a -> b
$
                 TextParser (ExpressionStart SourceContext)
parens forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
variableOrUnqualified forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
builtinCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
builtinValue forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
sourceContext forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
exprLookup forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
exprMacro forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
categoryCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 -- Keep this before typeCall, since it does a look-ahead for {.
                 TextParser (ExpressionStart SourceContext)
initalize forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
typeCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
stringLiteral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
charLiteral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
boolLiteral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ExpressionStart SourceContext)
emptyLiteral where
    parens :: TextParser (ExpressionStart SourceContext)
parens = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"(")
      ExpressionStart SourceContext
e <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (SourceContext -> TextParser (ExpressionStart SourceContext)
assign SourceContext
c) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SourceContext -> TextParser (ExpressionStart SourceContext)
expr SourceContext
c
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
")")
      forall (m :: * -> *) a. Monad m => a -> m a
return ExpressionStart SourceContext
e
    assign :: SourceContext -> TextParser (ExpressionStart SourceContext)
    assign :: SourceContext -> TextParser (ExpressionStart SourceContext)
assign SourceContext
c = do
      VariableName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      AssignmentType
o <- (TextParser ()
assignEmptyOperator forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return AssignmentType
AssignIfEmpty) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TextParser ()
assignOperator forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return AssignmentType
AlwaysAssign)
      Expression SourceContext
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> VariableName
-> AssignmentType
-> Expression c
-> ExpressionStart c
InlineAssignment [SourceContext
c] VariableName
n AssignmentType
o Expression SourceContext
e
    expr :: SourceContext -> TextParser (ExpressionStart SourceContext)
    expr :: SourceContext -> TextParser (ExpressionStart SourceContext)
expr SourceContext
c = do
      Expression SourceContext
e <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Expression c -> ExpressionStart c
ParensExpression [SourceContext
c] Expression SourceContext
e
    builtinCall :: TextParser (ExpressionStart SourceContext)
builtinCall = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      FunctionName
n <- TextParser FunctionName
builtinFunction
      FunctionCall SourceContext
f <- SourceContext
-> FunctionName -> TextParser (FunctionCall SourceContext)
parseFunctionCall SourceContext
c FunctionName
n
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> FunctionCall c -> ExpressionStart c
BuiltinCall [SourceContext
c] FunctionCall SourceContext
f
    builtinValue :: TextParser (ExpressionStart SourceContext)
builtinValue = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      String
n <- TextParser String
builtinValues
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. OutputValue c -> ExpressionStart c
NamedVariable (forall c. [c] -> VariableName -> OutputValue c
OutputValue [SourceContext
c] (String -> VariableName
boxVariableName String
n))
    sourceContext :: TextParser (ExpressionStart SourceContext)
sourceContext = do
      PragmaExpr SourceContext
pragma <- TextParser (PragmaExpr SourceContext)
pragmaSourceContext
      case PragmaExpr SourceContext
pragma of
           (PragmaSourceContext SourceContext
c) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. ValueLiteral c -> ExpressionStart c
UnambiguousLiteral (forall c. [c] -> String -> ValueLiteral c
StringLiteral [SourceContext
c] (forall a. Show a => a -> String
show SourceContext
c))
           PragmaExpr SourceContext
_ -> forall a. HasCallStack => a
undefined  -- Should be caught above.
    exprLookup :: TextParser (ExpressionStart SourceContext)
exprLookup = do
      PragmaExpr SourceContext
pragma <- TextParser (PragmaExpr SourceContext)
pragmaExprLookup
      case PragmaExpr SourceContext
pragma of
           (PragmaExprLookup [SourceContext]
c MacroName
name) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> MacroName -> ExpressionStart c
NamedMacro [SourceContext]
c MacroName
name
           PragmaExpr SourceContext
_ -> forall a. HasCallStack => a
undefined  -- Should be caught above.
    exprMacro :: TextParser (ExpressionStart SourceContext)
exprMacro = do
      (SourceContext
c,MacroExpression
macro) <- TextParser (SourceContext, MacroExpression)
macroExpression
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> MacroExpression -> ExpressionStart c
ExpressionMacro [SourceContext
c] MacroExpression
macro
    variableOrUnqualified :: TextParser (ExpressionStart SourceContext)
variableOrUnqualified = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      VariableName
n <- forall a. ParseFromSource a => TextParser a
sourceParser :: TextParser VariableName
      SourceContext
-> VariableName -> TextParser (ExpressionStart SourceContext)
asUnqualifiedCall SourceContext
c VariableName
n forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {m :: * -> *} {c}.
Monad m =>
c -> VariableName -> m (ExpressionStart c)
asVariable SourceContext
c VariableName
n
    asVariable :: c -> VariableName -> m (ExpressionStart c)
asVariable c
c VariableName
n = do
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. OutputValue c -> ExpressionStart c
NamedVariable (forall c. [c] -> VariableName -> OutputValue c
OutputValue [c
c] VariableName
n)
    asUnqualifiedCall :: SourceContext
-> VariableName -> TextParser (ExpressionStart SourceContext)
asUnqualifiedCall SourceContext
c VariableName
n = do
      FunctionCall SourceContext
f <- SourceContext
-> FunctionName -> TextParser (FunctionCall SourceContext)
parseFunctionCall SourceContext
c (String -> FunctionName
FunctionName (VariableName -> String
vnName VariableName
n))
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> FunctionCall c -> ExpressionStart c
UnqualifiedCall [SourceContext
c] FunctionCall SourceContext
f
    categoryCall :: TextParser (ExpressionStart SourceContext)
categoryCall = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      CategoryName
t <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do  -- Avoids consuming the type name if : isn't present.
        CategoryName
t2 <- forall a. ParseFromSource a => TextParser a
sourceParser
        TextParser ()
categorySymbolGet
        forall (m :: * -> *) a. Monad m => a -> m a
return CategoryName
t2
      FunctionName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      FunctionCall SourceContext
f <- SourceContext
-> FunctionName -> TextParser (FunctionCall SourceContext)
parseFunctionCall SourceContext
c FunctionName
n
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> CategoryName -> FunctionCall c -> ExpressionStart c
CategoryCall [SourceContext
c] CategoryName
t FunctionCall SourceContext
f
    typeCall :: TextParser (ExpressionStart SourceContext)
typeCall = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TypeInstanceOrParam
t <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a. ParseFromSource a => TextParser a
sourceParser
      TextParser ()
typeSymbolGet
      FunctionName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      FunctionCall SourceContext
f <- SourceContext
-> FunctionName -> TextParser (FunctionCall SourceContext)
parseFunctionCall SourceContext
c FunctionName
n
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> TypeInstanceOrParam -> FunctionCall c -> ExpressionStart c
TypeCall [SourceContext
c] TypeInstanceOrParam
t FunctionCall SourceContext
f
    initalize :: TextParser (ExpressionStart SourceContext)
initalize = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      Maybe TypeInstance
t <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do  -- Avoids consuming the type name if { isn't present.
        Maybe TypeInstance
t2 <- (TextParser ()
paramSelf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a. ParseFromSource a => TextParser a
sourceParser
        forall a. TextParser a -> TextParser a
sepAfter (forall a. String -> TextParser a -> TextParser a
labeled String
"@value initializer" forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"{")
        forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeInstance
t2
      [Expression SourceContext]
as <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
",")
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"}")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Maybe TypeInstance
-> Positional (Expression c)
-> ExpressionStart c
InitializeValue [SourceContext
c] Maybe TypeInstance
t (forall a. [a] -> Positional a
Positional [Expression SourceContext]
as)
    stringLiteral :: TextParser (ExpressionStart SourceContext)
stringLiteral = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      String
ss <- TextParser String
quotedString
      TextParser ()
optionalSpace
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. ValueLiteral c -> ExpressionStart c
UnambiguousLiteral forall a b. (a -> b) -> a -> b
$ forall c. [c] -> String -> ValueLiteral c
StringLiteral [SourceContext
c] String
ss
    charLiteral :: TextParser (ExpressionStart SourceContext)
charLiteral = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      String -> TextParser ()
string_ String
"'"
      Char
ch <- ParsecT CompilerMessage String Identity Char
stringChar 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
'"'
      String -> TextParser ()
string_ String
"'"
      TextParser ()
optionalSpace
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. ValueLiteral c -> ExpressionStart c
UnambiguousLiteral forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Char -> ValueLiteral c
CharLiteral [SourceContext
c] Char
ch
    boolLiteral :: TextParser (ExpressionStart SourceContext)
boolLiteral = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      Bool
b <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ (TextParser ()
kwTrue forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TextParser ()
kwFalse forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. ValueLiteral c -> ExpressionStart c
UnambiguousLiteral forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Bool -> ValueLiteral c
BoolLiteral [SourceContext
c] Bool
b
    emptyLiteral :: TextParser (ExpressionStart SourceContext)
emptyLiteral = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwEmpty
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. ValueLiteral c -> ExpressionStart c
UnambiguousLiteral forall a b. (a -> b) -> a -> b
$ forall c. [c] -> ValueLiteral c
EmptyLiteral [SourceContext
c]

instance ParseFromSource (ValueLiteral SourceContext) where
  sourceParser :: TextParser (ValueLiteral SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"literal" forall a b. (a -> b) -> a -> b
$
                 -- NOTE: StringLiteral, CharLiteral, BoolLiteral , and
                 -- EmptyLiteral are parsed as ExpressionStart.
                 TextParser (ValueLiteral SourceContext)
escapedIntegerOrDecimal forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 TextParser (ValueLiteral SourceContext)
integerOrDecimal where
    escapedIntegerOrDecimal :: TextParser (ValueLiteral SourceContext)
escapedIntegerOrDecimal = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
escapeStart
      Char
b <- forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
"bBoOdDxX"
      let (TextParser (Integer, Integer)
digitParser,Integer
base) = case Char
b of
                                    Char
'b' -> (TextParser (Integer, Integer)
parseBin,Integer
2)
                                    Char
'B' -> (TextParser (Integer, Integer)
parseBin,Integer
2)
                                    Char
'o' -> (TextParser (Integer, Integer)
parseOct,Integer
8)
                                    Char
'O' -> (TextParser (Integer, Integer)
parseOct,Integer
8)
                                    Char
'd' -> (TextParser (Integer, Integer)
parseDec,Integer
10)
                                    Char
'D' -> (TextParser (Integer, Integer)
parseDec,Integer
10)
                                    Char
'x' -> (TextParser (Integer, Integer)
parseHex,Integer
16)
                                    Char
'X' -> (TextParser (Integer, Integer)
parseHex,Integer
16)
                                    Char
_ -> forall a. HasCallStack => a
undefined
      Integer
d <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd TextParser (Integer, Integer)
digitParser
      forall {c}.
c
-> Integer
-> Bool
-> Integer
-> TextParser (Integer, Integer)
-> ParsecT CompilerMessage String Identity (ValueLiteral c)
decimal SourceContext
c Integer
d Bool
False Integer
base TextParser (Integer, Integer)
digitParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {c}.
c
-> Integer
-> Bool
-> ParsecT CompilerMessage String Identity (ValueLiteral c)
integer SourceContext
c Integer
d Bool
True
    integerOrDecimal :: TextParser (ValueLiteral SourceContext)
integerOrDecimal = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      Integer
d <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd TextParser (Integer, Integer)
parseDec
      forall {c}.
c
-> Integer
-> Bool
-> Integer
-> TextParser (Integer, Integer)
-> ParsecT CompilerMessage String Identity (ValueLiteral c)
decimal SourceContext
c Integer
d Bool
True Integer
10 TextParser (Integer, Integer)
parseDec forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {c}.
c
-> Integer
-> Bool
-> ParsecT CompilerMessage String Identity (ValueLiteral c)
integer SourceContext
c Integer
d Bool
False
    decimal :: c
-> Integer
-> Bool
-> Integer
-> TextParser (Integer, Integer)
-> ParsecT CompilerMessage String Identity (ValueLiteral c)
decimal c
c Integer
d Bool
allowExp Integer
base TextParser (Integer, Integer)
digitParser = do
      Char -> TextParser ()
char_ Char
'.'
      (Integer
n,Integer
d2) <- TextParser (Integer, Integer)
digitParser
      Integer
e <- if Bool
allowExp
              then ParsecT CompilerMessage String Identity Integer
decExponent forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
              else forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
      TextParser ()
optionalSpace
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Integer -> Integer -> Integer -> ValueLiteral c
DecimalLiteral [c
c] (Integer
dforall a. Num a => a -> a -> a
*Integer
baseforall a b. (Num a, Integral b) => a -> b -> a
^Integer
n forall a. Num a => a -> a -> a
+ Integer
d2) (Integer
e forall a. Num a => a -> a -> a
- Integer
n) Integer
base
    decExponent :: ParsecT CompilerMessage String Identity Integer
decExponent = do
      String -> TextParser ()
string_ String
"e" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> TextParser ()
string_ String
"E"
      Integer
s <- (String -> TextParser ()
string_ String
"+" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> TextParser ()
string_ String
"-" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1
      Integer
e <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd TextParser (Integer, Integer)
parseDec
      forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
sforall a. Num a => a -> a -> a
*Integer
e)
    integer :: c
-> Integer
-> Bool
-> ParsecT CompilerMessage String Identity (ValueLiteral c)
integer c
c Integer
d Bool
unsigned = do
      TextParser ()
optionalSpace
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Bool -> Integer -> ValueLiteral c
IntegerLiteral [c
c] Bool
unsigned Integer
d

instance ParseFromSource (ValueOperation SourceContext) where
  sourceParser :: TextParser (ValueOperation SourceContext)
sourceParser = TextParser (ValueOperation SourceContext)
valueCall forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (ValueOperation SourceContext)
conversion forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (ValueOperation SourceContext)
selectReturn where
    valueCall :: TextParser (ValueOperation SourceContext)
valueCall = forall a. String -> TextParser a -> TextParser a
labeled String
"function call" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      ValueCallType
o <- (TextParser ()
valueSymbolGet forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ValueCallType
AlwaysCall) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TextParser ()
valueSymbolMaybeGet forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ValueCallType
CallUnlessEmpty)
      FunctionName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      FunctionCall SourceContext
f <- SourceContext
-> FunctionName -> TextParser (FunctionCall SourceContext)
parseFunctionCall SourceContext
c FunctionName
n
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> ValueCallType -> FunctionCall c -> ValueOperation c
ValueCall [SourceContext
c] ValueCallType
o FunctionCall SourceContext
f
    conversion :: TextParser (ValueOperation SourceContext)
conversion = forall a. String -> TextParser a -> TextParser a
labeled String
"type conversion" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
inferredParam
      GeneralInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser -- NOTE: Should not need try here.
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> GeneralInstance -> ValueOperation c
TypeConversion [SourceContext
c] GeneralInstance
t
    selectReturn :: TextParser (ValueOperation SourceContext)
selectReturn = forall a. String -> TextParser a -> TextParser a
labeled String
"return selection" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      forall a. TextParser a -> TextParser ()
sepAfter_ (String -> TextParser ()
string_ String
"{")
      Integer
pos <- forall a. String -> TextParser a -> TextParser a
labeled String
"return position" 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) -> b
snd TextParser (Integer, Integer)
parseDec
      forall a. TextParser a -> TextParser ()
sepAfter_ (String -> TextParser ()
string_ String
"}")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> Int -> ValueOperation c
SelectReturn [SourceContext
c] (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pos)

instance ParseFromSource MacroName where
  sourceParser :: TextParser MacroName
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"macro name" forall a b. (a -> b) -> a -> b
$ do
    Char
h <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar 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
'_'
    String
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar 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
'_')
    TextParser ()
optionalSpace
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> MacroName
MacroName (Char
hforall a. a -> [a] -> [a]
:String
t)

pragmaNoTrace :: TextParser (PragmaProcedure SourceContext)
pragmaNoTrace :: TextParser (PragmaProcedure SourceContext)
pragmaNoTrace = forall a.
String
-> Either (SourceContext -> a) (SourceContext -> TextParser a)
-> TextParser a
autoPragma String
"NoTrace" forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall {c}. c -> PragmaProcedure c
parseAt where
  parseAt :: c -> PragmaProcedure c
parseAt c
c = forall c. [c] -> TraceType -> PragmaProcedure c
PragmaTracing [c
c] TraceType
NoTrace

pragmaTraceCreation :: TextParser (PragmaProcedure SourceContext)
pragmaTraceCreation :: TextParser (PragmaProcedure SourceContext)
pragmaTraceCreation = forall a.
String
-> Either (SourceContext -> a) (SourceContext -> TextParser a)
-> TextParser a
autoPragma String
"TraceCreation" forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall {c}. c -> PragmaProcedure c
parseAt where
  parseAt :: c -> PragmaProcedure c
parseAt c
c = forall c. [c] -> TraceType -> PragmaProcedure c
PragmaTracing [c
c] TraceType
TraceCreation

data PragmaExpr c =
  PragmaExprLookup {
    forall c. PragmaExpr c -> [c]
pelContext :: [c],
    forall c. PragmaExpr c -> MacroName
pelName :: MacroName
  } |
  PragmaSourceContext {
    forall c. PragmaExpr c -> c
pscContext :: c
  }
  deriving (Int -> PragmaExpr c -> ShowS
forall c. Show c => Int -> PragmaExpr c -> ShowS
forall c. Show c => [PragmaExpr c] -> ShowS
forall c. Show c => PragmaExpr c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PragmaExpr c] -> ShowS
$cshowList :: forall c. Show c => [PragmaExpr c] -> ShowS
show :: PragmaExpr c -> String
$cshow :: forall c. Show c => PragmaExpr c -> String
showsPrec :: Int -> PragmaExpr c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> PragmaExpr c -> ShowS
Show)

pragmaExprLookup :: TextParser (PragmaExpr SourceContext)
pragmaExprLookup :: TextParser (PragmaExpr SourceContext)
pragmaExprLookup = forall a.
String
-> Either (SourceContext -> a) (SourceContext -> TextParser a)
-> TextParser a
autoPragma String
"ExprLookup" forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall {c}.
c -> ParsecT CompilerMessage String Identity (PragmaExpr c)
parseAt where
  parseAt :: c -> ParsecT CompilerMessage String Identity (PragmaExpr c)
parseAt c
c = do
    MacroName
name <- forall a. ParseFromSource a => TextParser a
sourceParser
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> MacroName -> PragmaExpr c
PragmaExprLookup [c
c] MacroName
name

pragmaSourceContext :: TextParser (PragmaExpr SourceContext)
pragmaSourceContext :: TextParser (PragmaExpr SourceContext)
pragmaSourceContext = forall a.
String
-> Either (SourceContext -> a) (SourceContext -> TextParser a)
-> TextParser a
autoPragma String
"SourceContext" forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall {c}. c -> PragmaExpr c
parseAt where
  parseAt :: c -> PragmaExpr c
parseAt c
c = forall {c}. c -> PragmaExpr c
PragmaSourceContext c
c

macroExpression :: TextParser (SourceContext,MacroExpression)
macroExpression :: TextParser (SourceContext, MacroExpression)
macroExpression = TextParser (SourceContext, MacroExpression)
callTrace where
  callTrace :: TextParser (SourceContext, MacroExpression)
callTrace = forall a.
String
-> Either (SourceContext -> a) (SourceContext -> TextParser a)
-> TextParser a
autoPragma String
"CallTrace" forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) MacroExpression
MacroCallTrace)

data MarkType = ReadOnly | Hidden deriving (Int -> MarkType -> ShowS
[MarkType] -> ShowS
MarkType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkType] -> ShowS
$cshowList :: [MarkType] -> ShowS
show :: MarkType -> String
$cshow :: MarkType -> String
showsPrec :: Int -> MarkType -> ShowS
$cshowsPrec :: Int -> MarkType -> ShowS
Show)

data PragmaStatement c =
  PragmaMarkVars {
    forall c. PragmaStatement c -> [c]
pmvContext :: [c],
    forall c. PragmaStatement c -> MarkType
pmvType :: MarkType,
    forall c. PragmaStatement c -> [VariableName]
pmvVars :: [VariableName]
  }
  deriving (Int -> PragmaStatement c -> ShowS
forall c. Show c => Int -> PragmaStatement c -> ShowS
forall c. Show c => [PragmaStatement c] -> ShowS
forall c. Show c => PragmaStatement c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PragmaStatement c] -> ShowS
$cshowList :: forall c. Show c => [PragmaStatement c] -> ShowS
show :: PragmaStatement c -> String
$cshow :: forall c. Show c => PragmaStatement c -> String
showsPrec :: Int -> PragmaStatement c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> PragmaStatement c -> ShowS
Show)

pragmaReadOnly :: TextParser (PragmaStatement SourceContext)
pragmaReadOnly :: ParsecT
  CompilerMessage String Identity (PragmaStatement SourceContext)
pragmaReadOnly = forall a.
String
-> Either (SourceContext -> a) (SourceContext -> TextParser a)
-> TextParser a
autoPragma String
"ReadOnly" forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall {c}.
c -> ParsecT CompilerMessage String Identity (PragmaStatement c)
parseAt where
  parseAt :: c -> ParsecT CompilerMessage String Identity (PragmaStatement c)
parseAt c
c = do
    [VariableName]
vs <- forall a. String -> TextParser a -> TextParser a
labeled String
"variable names" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
",")
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> MarkType -> [VariableName] -> PragmaStatement c
PragmaMarkVars [c
c] MarkType
ReadOnly [VariableName]
vs

pragmaHidden :: TextParser (PragmaStatement SourceContext)
pragmaHidden :: ParsecT
  CompilerMessage String Identity (PragmaStatement SourceContext)
pragmaHidden = forall a.
String
-> Either (SourceContext -> a) (SourceContext -> TextParser a)
-> TextParser a
autoPragma String
"Hidden" forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall {c}.
c -> ParsecT CompilerMessage String Identity (PragmaStatement c)
parseAt where
  parseAt :: c -> ParsecT CompilerMessage String Identity (PragmaStatement c)
parseAt c
c = do
    [VariableName]
vs <- forall a. String -> TextParser a -> TextParser a
labeled String
"variable names" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
",")
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> MarkType -> [VariableName] -> PragmaStatement c
PragmaMarkVars [c
c] MarkType
Hidden [VariableName]
vs

pragmaValidateRefs :: TextParser (Statement SourceContext)
pragmaValidateRefs :: TextParser (Statement SourceContext)
pragmaValidateRefs = forall a.
String
-> Either (SourceContext -> a) (SourceContext -> TextParser a)
-> TextParser a
autoPragma String
"ValidateRefs" forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall {c}.
c -> ParsecT CompilerMessage String Identity (Statement c)
parseAt where
  parseAt :: c -> ParsecT CompilerMessage String Identity (Statement c)
parseAt c
c = do
    [VariableName]
vs <- forall a. String -> TextParser a -> TextParser a
labeled String
"variable names" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
",")
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> [VariableName] -> Statement c
ValidateRefs [c
c] [VariableName]
vs