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

module Parser.Common (
  ParseFromSource(..),
  anyComment,
  assignEmptyOperator,
  assignOperator,
  blockComment,
  builtinValues,
  categorySymbolGet,
  char_,
  endOfDoc,
  escapeStart,
  inferredParam,
  infixFuncEnd,
  infixFuncStart,
  keyword,
  kwAll,
  kwAllows,
  kwAny,
  kwBreak,
  kwCategory,
  kwCleanup,
  kwConcrete,
  kwContinue,
  kwDefer,
  kwDefine,
  kwDefines,
  kwDelegate,
  kwElif,
  kwElse,
  kwEmpty,
  kwExit,
  kwFail,
  kwFalse,
  kwIf,
  kwIgnore,
  kwImmutable,
  kwIn,
  kwIdentify,
  kwInterface,
  kwOptional,
  kwPresent,
  kwReduce,
  kwRefines,
  kwRequire,
  kwRequires,
  kwReturn,
  kwScoped,
  kwSelf,
  kwStrong,
  kwTestcase,
  kwTraverse,
  kwTrue,
  kwType,
  kwTypename,
  kwUnittest,
  kwUpdate,
  kwValue,
  kwVisibility,
  kwWeak,
  kwWhile,
  labeled,
  lineComment,
  lineEnd,
  merge2,
  merge3,
  noKeywords,
  noParamSelf,
  notAllowed,
  nullParse,
  operator,
  optionalSpace,
  paramSelf,
  parseAny2,
  parseAny3,
  parseBin,
  parseDec,
  parseHex,
  parseOct,
  pragmaArgsEnd,
  pragmaArgsStart,
  pragmaEnd,
  pragmaStart,
  put12,
  put13,
  put22,
  put23,
  put33,
  quotedString,
  regexChar,
  sepAfter,
  sepAfter_,
  statementEnd,
  statementStart,
  stringChar,
  string_,
  swapOperator,
  typeSymbolGet,
  valueSymbolGet,
  valueSymbolMaybeGet,
) where

import Data.Char
import Data.Foldable
import Data.Functor
import Data.Monoid
import Prelude hiding (foldl,foldr)
import qualified Data.Set as Set

import Base.CompilerError
import Parser.TextParser
import Types.TypeInstance (ParamName(ParamSelf))


class ParseFromSource a where
  -- Always prune whitespace and comments from back, but never from front!
  sourceParser :: TextParser a

labeled :: String -> TextParser a -> TextParser a
labeled :: forall a. String -> TextParser a -> TextParser a
labeled = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label

escapeStart :: TextParser ()
escapeStart :: TextParser ()
escapeStart = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"\\")

statementStart :: TextParser ()
statementStart :: TextParser ()
statementStart = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"\\")

statementEnd :: TextParser ()
statementEnd :: TextParser ()
statementEnd = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"")

valueSymbolGet :: TextParser ()
valueSymbolGet :: TextParser ()
valueSymbolGet = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
".")

valueSymbolMaybeGet :: TextParser ()
valueSymbolMaybeGet :: TextParser ()
valueSymbolMaybeGet = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"&.")

categorySymbolGet :: TextParser ()
categorySymbolGet :: TextParser ()
categorySymbolGet = forall a. String -> TextParser a -> TextParser a
labeled String
":" forall a b. (a -> b) -> a -> b
$ TextParser ()
useNewOperators forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
":")

typeSymbolGet :: TextParser ()
typeSymbolGet :: TextParser ()
typeSymbolGet = forall a. String -> TextParser a -> TextParser a
labeled String
"." forall a b. (a -> b) -> a -> b
$ TextParser ()
useNewOperators forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
".")

-- TODO: Remove this after a reasonable amount of time.
useNewOperators :: TextParser ()
useNewOperators :: TextParser ()
useNewOperators = forall {b}. ParsecT CompilerMessage String Identity b
newCategory forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {b}. ParsecT CompilerMessage String Identity b
newType where
  newCategory :: ParsecT CompilerMessage String Identity b
newCategory = do
    String -> TextParser ()
string_ String
"$$"
    forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"use \":\" instead of \"$$\" to call @category functions"
  newType :: ParsecT CompilerMessage String Identity b
newType = do
    String -> TextParser ()
string_ String
"$"
    forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"use \".\" instead of \"$\" to call @type functions"

assignOperator :: TextParser ()
assignOperator :: TextParser ()
assignOperator = String -> TextParser String
operator String
"<-" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

assignEmptyOperator :: TextParser ()
assignEmptyOperator :: TextParser ()
assignEmptyOperator = String -> TextParser String
operator String
"<-|" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

swapOperator :: TextParser ()
swapOperator :: TextParser ()
swapOperator = String -> TextParser String
operator String
"<->" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

infixFuncStart :: TextParser ()
infixFuncStart :: TextParser ()
infixFuncStart = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"`")

infixFuncEnd :: TextParser ()
infixFuncEnd :: TextParser ()
infixFuncEnd = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"`")

-- TODO: Maybe this should not use strings.
builtinValues :: TextParser String
builtinValues :: TextParser String
builtinValues = 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 ()
kwSelf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
"self"
  ]

kwAll :: TextParser ()
kwAll :: TextParser ()
kwAll = String -> TextParser ()
keyword String
"all"

kwAllows :: TextParser ()
kwAllows :: TextParser ()
kwAllows = String -> TextParser ()
keyword String
"allows"

kwAny :: TextParser ()
kwAny :: TextParser ()
kwAny = String -> TextParser ()
keyword String
"any"

kwBreak :: TextParser ()
kwBreak :: TextParser ()
kwBreak = String -> TextParser ()
keyword String
"break"

kwCategory :: TextParser ()
kwCategory :: TextParser ()
kwCategory = String -> TextParser ()
keyword String
"@category"

kwCleanup :: TextParser ()
kwCleanup :: TextParser ()
kwCleanup = String -> TextParser ()
keyword String
"cleanup"

kwConcrete :: TextParser ()
kwConcrete :: TextParser ()
kwConcrete = String -> TextParser ()
keyword String
"concrete"

kwContinue :: TextParser ()
kwContinue :: TextParser ()
kwContinue = String -> TextParser ()
keyword String
"continue"

kwDefer :: TextParser ()
kwDefer :: TextParser ()
kwDefer = String -> TextParser ()
keyword String
"defer"

kwDefine :: TextParser ()
kwDefine :: TextParser ()
kwDefine = String -> TextParser ()
keyword String
"define"

kwDefines :: TextParser ()
kwDefines :: TextParser ()
kwDefines = String -> TextParser ()
keyword String
"defines"

kwDelegate :: TextParser ()
kwDelegate :: TextParser ()
kwDelegate = String -> TextParser ()
keyword String
"delegate"

kwElif :: TextParser ()
kwElif :: TextParser ()
kwElif = String -> TextParser ()
keyword String
"elif"

kwElse :: TextParser ()
kwElse :: TextParser ()
kwElse = String -> TextParser ()
keyword String
"else"

kwEmpty :: TextParser ()
kwEmpty :: TextParser ()
kwEmpty = String -> TextParser ()
keyword String
"empty"

kwExit :: TextParser ()
kwExit :: TextParser ()
kwExit = String -> TextParser ()
keyword String
"exit"

kwFail :: TextParser ()
kwFail :: TextParser ()
kwFail = String -> TextParser ()
keyword String
"fail"

kwFalse :: TextParser ()
kwFalse :: TextParser ()
kwFalse = String -> TextParser ()
keyword String
"false"

kwIf :: TextParser ()
kwIf :: TextParser ()
kwIf = String -> TextParser ()
keyword String
"if"

kwIgnore :: TextParser ()
kwIgnore :: TextParser ()
kwIgnore = String -> TextParser ()
keyword String
"_"

kwImmutable :: TextParser ()
kwImmutable :: TextParser ()
kwImmutable = String -> TextParser ()
keyword String
"immutable"

kwIn :: TextParser ()
kwIn :: TextParser ()
kwIn = String -> TextParser ()
keyword String
"in"

kwIdentify :: TextParser ()
kwIdentify :: TextParser ()
kwIdentify = String -> TextParser ()
keyword String
"identify"

kwInterface :: TextParser ()
kwInterface :: TextParser ()
kwInterface = String -> TextParser ()
keyword String
"interface"

kwOptional :: TextParser ()
kwOptional :: TextParser ()
kwOptional = String -> TextParser ()
keyword String
"optional"

kwPresent :: TextParser ()
kwPresent :: TextParser ()
kwPresent = String -> TextParser ()
keyword String
"present"

kwReduce :: TextParser ()
kwReduce :: TextParser ()
kwReduce = String -> TextParser ()
keyword String
"reduce"

kwRefines :: TextParser ()
kwRefines :: TextParser ()
kwRefines = String -> TextParser ()
keyword String
"refines"

kwRequire :: TextParser ()
kwRequire :: TextParser ()
kwRequire = String -> TextParser ()
keyword String
"require"

kwRequires :: TextParser ()
kwRequires :: TextParser ()
kwRequires = String -> TextParser ()
keyword String
"requires"

kwReturn :: TextParser ()
kwReturn :: TextParser ()
kwReturn = String -> TextParser ()
keyword String
"return"

kwSelf :: TextParser ()
kwSelf :: TextParser ()
kwSelf = String -> TextParser ()
keyword String
"self"

kwScoped :: TextParser ()
kwScoped :: TextParser ()
kwScoped = String -> TextParser ()
keyword String
"scoped"

kwStrong :: TextParser ()
kwStrong :: TextParser ()
kwStrong = String -> TextParser ()
keyword String
"strong"

kwTestcase :: TextParser ()
kwTestcase :: TextParser ()
kwTestcase = String -> TextParser ()
keyword String
"testcase"

kwTraverse :: TextParser ()
kwTraverse :: TextParser ()
kwTraverse = String -> TextParser ()
keyword String
"traverse"

kwTrue :: TextParser ()
kwTrue :: TextParser ()
kwTrue = String -> TextParser ()
keyword String
"true"

kwType :: TextParser ()
kwType :: TextParser ()
kwType = String -> TextParser ()
keyword String
"@type"

kwTypename :: TextParser ()
kwTypename :: TextParser ()
kwTypename = String -> TextParser ()
keyword String
"typename"

kwUnittest :: TextParser ()
kwUnittest :: TextParser ()
kwUnittest = String -> TextParser ()
keyword String
"unittest"

kwUpdate :: TextParser ()
kwUpdate :: TextParser ()
kwUpdate = String -> TextParser ()
keyword String
"update"

kwValue :: TextParser ()
kwValue :: TextParser ()
kwValue = String -> TextParser ()
keyword String
"@value"

kwVisibility :: TextParser ()
kwVisibility :: TextParser ()
kwVisibility = String -> TextParser ()
keyword String
"visibility"

kwWeak :: TextParser ()
kwWeak :: TextParser ()
kwWeak = String -> TextParser ()
keyword String
"weak"

kwWhile :: TextParser ()
kwWhile :: TextParser ()
kwWhile = String -> TextParser ()
keyword String
"while"

paramSelf :: TextParser ()
paramSelf :: TextParser ()
paramSelf = String -> TextParser ()
keyword (forall a. Show a => a -> String
show ParamName
ParamSelf)

noParamSelf :: TextParser ()
noParamSelf :: TextParser ()
noParamSelf = (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall a b. (a -> b) -> a -> b
$ do
  -- NOTE: This preserves the trailing whitespace so that the error context
  -- doesn't skip over whitespace or comments.
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
    String -> TextParser ()
string_ (forall a. Show a => a -> String
show ParamName
ParamSelf)
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_')
  forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"#self is not allowed here"

operatorSymbol :: TextParser Char
operatorSymbol :: TextParser Char
operatorSymbol = forall a. String -> TextParser a -> TextParser a
labeled String
"operator symbol" forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall a. Ord a => a -> Set a -> Bool
`Set.member` forall a. Ord a => [a] -> Set a
Set.fromList String
"+-*/%=!<>&|")

isKeyword :: TextParser ()
isKeyword :: TextParser ()
isKeyword = 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 ()
kwAll,
    TextParser ()
kwAllows,
    TextParser ()
kwAny,
    TextParser ()
kwBreak,
    TextParser ()
kwCategory,
    TextParser ()
kwCleanup,
    TextParser ()
kwConcrete,
    TextParser ()
kwContinue,
    TextParser ()
kwDefer,
    TextParser ()
kwDefine,
    TextParser ()
kwDefines,
    TextParser ()
kwDelegate,
    TextParser ()
kwElif,
    TextParser ()
kwElse,
    TextParser ()
kwEmpty,
    TextParser ()
kwExit,
    TextParser ()
kwFail,
    TextParser ()
kwFalse,
    TextParser ()
kwIf,
    TextParser ()
kwIgnore,
    TextParser ()
kwImmutable,
    TextParser ()
kwIn,
    TextParser ()
kwIdentify,
    TextParser ()
kwInterface,
    TextParser ()
kwOptional,
    TextParser ()
kwPresent,
    TextParser ()
kwReduce,
    TextParser ()
kwRefines,
    TextParser ()
kwRequire,
    TextParser ()
kwRequires,
    TextParser ()
kwReturn,
    TextParser ()
kwSelf,
    TextParser ()
kwScoped,
    TextParser ()
kwStrong,
    TextParser ()
kwTestcase,
    TextParser ()
kwTraverse,
    TextParser ()
kwTrue,
    TextParser ()
kwType,
    TextParser ()
kwTypename,
    TextParser ()
kwUnittest,
    TextParser ()
kwUpdate,
    TextParser ()
kwValue,
    TextParser ()
kwVisibility,
    TextParser ()
kwWeak,
    TextParser ()
kwWhile
  ]

nullParse :: TextParser ()
nullParse :: TextParser ()
nullParse = forall (m :: * -> *) a. Monad m => a -> m a
return ()

char_ :: Char -> TextParser ()
char_ :: Char -> TextParser ()
char_ = (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char

string_ :: String -> TextParser ()
string_ :: String -> TextParser ()
string_ = (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string

lineEnd :: TextParser ()
lineEnd :: TextParser ()
lineEnd = (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

lineComment :: TextParser String
lineComment :: TextParser String
lineComment = forall a. String -> TextParser a -> TextParser a
labeled String
"line comment" forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> TextParser ()
string_ String
"//")
          TextParser ()
lineEnd
          (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token String
c -> Token String
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Token String
c forall a. Eq a => a -> a -> Bool
/= Char
'\r'))

blockComment :: TextParser String
blockComment :: TextParser String
blockComment = forall a. String -> TextParser a -> TextParser a
labeled String
"block comment" forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> TextParser ()
string_ String
"/*")
          (String -> TextParser ()
string_ String
"*/")
          (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (String -> TextParser ()
string_ String
"*/") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
asciiChar)

anyComment :: TextParser ()
anyComment :: TextParser ()
anyComment = forall a. String -> TextParser a -> TextParser a
labeled String
"comment" forall a b. (a -> b) -> a -> b
$ (TextParser String
blockComment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser String
lineComment) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

optionalSpace :: TextParser ()
optionalSpace :: TextParser ()
optionalSpace = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (TextParser ()
anyComment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

sepAfter :: TextParser a -> TextParser a
sepAfter :: forall a. TextParser a -> TextParser a
sepAfter = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between TextParser ()
nullParse TextParser ()
optionalSpace

sepAfter_ :: TextParser a -> TextParser ()
sepAfter_ :: forall a. TextParser a -> TextParser ()
sepAfter_ = (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between TextParser ()
nullParse TextParser ()
optionalSpace

keyword :: String -> TextParser ()
keyword :: String -> TextParser ()
keyword String
s = forall a. String -> TextParser a -> TextParser a
labeled String
s forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  String -> TextParser ()
string_ String
s
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar 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

noKeywords :: TextParser ()
noKeywords :: TextParser ()
noKeywords = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy TextParser ()
isKeyword

endOfDoc :: TextParser ()
endOfDoc :: TextParser ()
endOfDoc = forall a. String -> TextParser a -> TextParser a
labeled String
"end of input" forall a b. (a -> b) -> a -> b
$ TextParser ()
optionalSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

notAllowed :: TextParser a -> String -> TextParser ()
-- Based on implementation of notFollowedBy.
notAllowed :: forall a. TextParser a -> String -> TextParser ()
notAllowed TextParser a
p String
s = (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try TextParser a
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()

pragmaStart :: TextParser ()
pragmaStart :: TextParser ()
pragmaStart = String -> TextParser ()
string_ String
"$"

pragmaEnd :: TextParser ()
pragmaEnd :: TextParser ()
pragmaEnd = String -> TextParser ()
string_ String
"$"

pragmaArgsStart :: TextParser ()
pragmaArgsStart :: TextParser ()
pragmaArgsStart = String -> TextParser ()
string_ String
"["

pragmaArgsEnd :: TextParser ()
pragmaArgsEnd :: TextParser ()
pragmaArgsEnd = String -> TextParser ()
string_ String
"]"

inferredParam :: TextParser ()
inferredParam :: TextParser ()
inferredParam = String -> TextParser ()
string_ String
"?"

operator :: String -> TextParser String
operator :: String -> TextParser String
operator String
o = forall a. String -> TextParser a -> TextParser a
labeled String
o forall a b. (a -> b) -> a -> b
$ do
  String -> TextParser ()
string_ String
o
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try TextParser ()
anyComment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy TextParser Char
operatorSymbol
  TextParser ()
optionalSpace
  forall (m :: * -> *) a. Monad m => a -> m a
return String
o

stringChar :: TextParser Char
stringChar :: TextParser Char
stringChar = TextParser Char
escaped forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CompilerMessage String Identity (Token String)
notEscaped where
  escaped :: TextParser Char
escaped = forall a. String -> TextParser a -> TextParser a
labeled String
"escaped char sequence" forall a b. (a -> b) -> a -> b
$ do
    Char -> TextParser ()
char_ Char
'\\'
    TextParser Char
octChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser Char
otherEscape where
      otherEscape :: TextParser Char
otherEscape = do
        Char
v <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
asciiChar
        case Char
v of
            Char
'\'' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\''
            Char
'"' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'"'
            Char
'?' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'?'
            Char
'\\' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'
            Char
'a' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
7
            Char
'b' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
8
            Char
'f' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
12
            Char
'n' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
10
            Char
'r' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
13
            Char
't' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
9
            Char
'v' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
11
            Char
'x' -> TextParser Char
hexChar
            Char
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show Char
v)
      octChar :: TextParser Char
octChar = forall a. String -> TextParser a -> TextParser a
labeled String
"3 octal chars" forall a b. (a -> b) -> a -> b
$ do
        Int
o1 <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        Int
o2 <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        Int
o3 <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr forall a b. (a -> b) -> a -> b
$ Int
8forall a. Num a => a -> a -> a
*Int
8forall a. Num a => a -> a -> a
*Int
o1 forall a. Num a => a -> a -> a
+ Int
8forall a. Num a => a -> a -> a
*Int
o2 forall a. Num a => a -> a -> a
+ Int
o3
      hexChar :: TextParser Char
hexChar = forall a. String -> TextParser a -> TextParser a
labeled String
"2 hex chars" forall a b. (a -> b) -> a -> b
$ do
        Int
h1 <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        Int
h2 <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitCharVal
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr forall a b. (a -> b) -> a -> b
$ Int
16forall a. Num a => a -> a -> a
*Int
h1 forall a. Num a => a -> a -> a
+ Int
h2
  notEscaped :: ParsecT CompilerMessage String Identity (Token String)
notEscaped = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
"\""

quotedString :: TextParser String
quotedString :: TextParser String
quotedString = do
  String -> TextParser ()
string_ String
"\""
  forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill TextParser Char
stringChar (String -> TextParser ()
string_ String
"\"")

digitCharVal :: Char -> Int
digitCharVal :: Char -> Int
digitCharVal Char
c
  | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' = Char -> Int
ord(Char
c) forall a. Num a => a -> a -> a
- Char -> Int
ord(Char
'0')
  | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'F' = Int
10 forall a. Num a => a -> a -> a
+ Char -> Int
ord(Char
c) forall a. Num a => a -> a -> a
- Char -> Int
ord(Char
'A')
  | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'f' = Int
10 forall a. Num a => a -> a -> a
+ Char -> Int
ord(Char
c) forall a. Num a => a -> a -> a
- Char -> Int
ord(Char
'a')
  | Bool
otherwise = forall a. HasCallStack => a
undefined

parseDec :: TextParser (Integer,Integer)
parseDec :: TextParser (Integer, Integer)
parseDec = forall a. String -> TextParser a -> TextParser a
labeled String
"base-10" forall a b. (a -> b) -> a -> b
$ Integer -> TextParser Char -> TextParser (Integer, Integer)
parseIntCommon Integer
10 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

parseHex :: TextParser (Integer,Integer)
parseHex :: TextParser (Integer, Integer)
parseHex = forall a. String -> TextParser a -> TextParser a
labeled String
"base-16" forall a b. (a -> b) -> a -> b
$ Integer -> TextParser Char -> TextParser (Integer, Integer)
parseIntCommon Integer
16 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar

parseOct :: TextParser (Integer,Integer)
parseOct :: TextParser (Integer, Integer)
parseOct = forall a. String -> TextParser a -> TextParser a
labeled String
"base-8" forall a b. (a -> b) -> a -> b
$ Integer -> TextParser Char -> TextParser (Integer, Integer)
parseIntCommon Integer
8 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar

parseBin :: TextParser (Integer,Integer)
parseBin :: TextParser (Integer, Integer)
parseBin = forall a. String -> TextParser a -> TextParser a
labeled String
"base-2" forall a b. (a -> b) -> a -> b
$ Integer -> TextParser Char -> TextParser (Integer, Integer)
parseIntCommon Integer
2 (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
"01")

parseIntCommon :: Integer -> TextParser Char -> TextParser (Integer,Integer)
parseIntCommon :: Integer -> TextParser Char -> TextParser (Integer, Integer)
parseIntCommon Integer
b TextParser Char
p = do
  String
ds <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some TextParser Char
p
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\(Integer
n,Integer
x) Char
y -> (Integer
nforall a. Num a => a -> a -> a
+Integer
1,Integer
bforall a. Num a => a -> a -> a
*Integer
x forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Char -> Int
digitCharVal Char
y :: Integer))) (Integer
0,Integer
0) String
ds

regexChar :: TextParser String
regexChar :: TextParser String
regexChar = TextParser String
escaped forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CompilerMessage String Identity [Token String]
notEscaped where
  escaped :: TextParser String
escaped = do
    Char -> TextParser ()
char_ Char
'\\'
    Char
v <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
asciiChar
    case Char
v of
         Char
'"' -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"\""
         Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char
'\\',Char
v]
  notEscaped :: ParsecT CompilerMessage String Identity [Token String]
notEscaped = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
"\""

put12 :: (Functor m, Monad m) => m a -> m ([a],[b])
put12 :: forall (m :: * -> *) a b.
(Functor m, Monad m) =>
m a -> m ([a], [b])
put12 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {a}. a -> ([a], [a])
put where put :: a -> ([a], [a])
put a
x = ([a
x],[])

put22 :: (Functor m, Monad m) => m b -> m ([a],[b])
put22 :: forall (m :: * -> *) b a.
(Functor m, Monad m) =>
m b -> m ([a], [b])
put22 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {a}. a -> ([a], [a])
put where put :: a -> ([a], [a])
put a
x = ([],[a
x])

merge2 :: (Foldable f, Monoid a, Monoid b) => f (a,b) -> (a,b)
merge2 :: forall (f :: * -> *) a b.
(Foldable f, Monoid a, Monoid b) =>
f (a, b) -> (a, b)
merge2 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b}.
(Semigroup a, Semigroup b) =>
(a, b) -> (a, b) -> (a, b)
merge (forall a. Monoid a => a
mempty,forall a. Monoid a => a
mempty) where
  merge :: (a, b) -> (a, b) -> (a, b)
merge (a
xs1,b
ys1) (a
xs2,b
ys2) = (a
xs1forall a. Semigroup a => a -> a -> a
<>a
xs2,b
ys1forall a. Semigroup a => a -> a -> a
<>b
ys2)

put13 :: (Functor m, Monad m) => m a -> m ([a],[b],[c])
put13 :: forall (m :: * -> *) a b c.
(Functor m, Monad m) =>
m a -> m ([a], [b], [c])
put13 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {a} {a}. a -> ([a], [a], [a])
put where put :: a -> ([a], [a], [a])
put a
x = ([a
x],[],[])

put23 :: (Functor m, Monad m) => m b -> m ([a],[b],[c])
put23 :: forall (m :: * -> *) b a c.
(Functor m, Monad m) =>
m b -> m ([a], [b], [c])
put23 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {a} {a}. a -> ([a], [a], [a])
put where put :: a -> ([a], [a], [a])
put a
x = ([],[a
x],[])

put33 :: (Functor m, Monad m) => m c -> m ([a],[b],[c])
put33 :: forall (m :: * -> *) c a b.
(Functor m, Monad m) =>
m c -> m ([a], [b], [c])
put33 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {a} {a}. a -> ([a], [a], [a])
put where put :: a -> ([a], [a], [a])
put a
x = ([],[],[a
x])

merge3 :: (Foldable f, Monoid a, Monoid b, Monoid c) => f (a,b,c) -> (a,b,c)
merge3 :: forall (f :: * -> *) a b c.
(Foldable f, Monoid a, Monoid b, Monoid c) =>
f (a, b, c) -> (a, b, c)
merge3 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b} {c}.
(Semigroup a, Semigroup b, Semigroup c) =>
(a, b, c) -> (a, b, c) -> (a, b, c)
merge (forall a. Monoid a => a
mempty,forall a. Monoid a => a
mempty,forall a. Monoid a => a
mempty) where
  merge :: (a, b, c) -> (a, b, c) -> (a, b, c)
merge (a
xs1,b
ys1,c
zs1) (a
xs2,b
ys2,c
zs2) = (a
xs1forall a. Semigroup a => a -> a -> a
<>a
xs2,b
ys1forall a. Semigroup a => a -> a -> a
<>b
ys2,c
zs1forall a. Semigroup a => a -> a -> a
<>c
zs2)

parseAny2 :: TextParser a -> TextParser b -> TextParser ([a],[b])
parseAny2 :: forall a b. TextParser a -> TextParser b -> TextParser ([a], [b])
parseAny2 TextParser a
p1 TextParser b
p2 = forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy ParsecT CompilerMessage String Identity ([a], [b])
anyType TextParser ()
optionalSpace forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
(Foldable f, Monoid a, Monoid b) =>
f (a, b) -> (a, b)
merge2 where
  anyType :: ParsecT CompilerMessage String Identity ([a], [b])
anyType = forall {a}. ParsecT CompilerMessage String Identity ([a], [a])
p1' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. ParsecT CompilerMessage String Identity ([a], [b])
p2'
  p1' :: ParsecT CompilerMessage String Identity ([a], [a])
p1' = do
    a
x <- TextParser a
p1
    forall (m :: * -> *) a. Monad m => a -> m a
return ([a
x],[])
  p2' :: ParsecT CompilerMessage String Identity ([a], [b])
p2' = do
    b
y <- TextParser b
p2
    forall (m :: * -> *) a. Monad m => a -> m a
return ([],[b
y])

parseAny3 :: TextParser a -> TextParser b -> TextParser c -> TextParser ([a],[b],[c])
parseAny3 :: forall a b c.
TextParser a
-> TextParser b -> TextParser c -> TextParser ([a], [b], [c])
parseAny3 TextParser a
p1 TextParser b
p2 TextParser c
p3 = forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy ParsecT CompilerMessage String Identity ([a], [b], [c])
anyType TextParser ()
optionalSpace forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b c.
(Foldable f, Monoid a, Monoid b, Monoid c) =>
f (a, b, c) -> (a, b, c)
merge3 where
  anyType :: ParsecT CompilerMessage String Identity ([a], [b], [c])
anyType = forall {a} {a}.
ParsecT CompilerMessage String Identity ([a], [a], [a])
p1' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a} {a}.
ParsecT CompilerMessage String Identity ([a], [b], [a])
p2' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a} {a}.
ParsecT CompilerMessage String Identity ([a], [a], [c])
p3'
  p1' :: ParsecT CompilerMessage String Identity ([a], [a], [a])
p1' = do
    a
x <- TextParser a
p1
    forall (m :: * -> *) a. Monad m => a -> m a
return ([a
x],[],[])
  p2' :: ParsecT CompilerMessage String Identity ([a], [b], [a])
p2' = do
    b
y <- TextParser b
p2
    forall (m :: * -> *) a. Monad m => a -> m a
return ([],[b
y],[])
  p3' :: ParsecT CompilerMessage String Identity ([a], [a], [c])
p3' = do
    c
z <- TextParser c
p3
    forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],[c
z])