{-# LANGUAGE OverloadedStrings #-}

module Funcons.GLLParser where

import Funcons.Types
import GLL.Combinators hiding (many, some, Char, parse)

import Data.Char (isAlphaNum, isLower)
import Text.Regex.Applicative hiding ((<**>), optional)
import Data.Text (pack)
import Numeric

type Parser a = BNF Token a

fct_parse :: String -> Funcons
fct_parse :: String -> Funcons
fct_parse = Parser Funcons -> String -> Funcons
forall a. Parser a -> String -> a
parser_a Parser Funcons
pFuncons

fct_parse_either :: String -> Either String Funcons
fct_parse_either :: String -> Either String Funcons
fct_parse_either String
s = case Parser Funcons -> String -> Either String [Funcons]
forall a. Parser a -> String -> Either String [a]
parsesWithErrors Parser Funcons
pFuncons String
s of
  Left String
err  -> String -> Either String Funcons
forall a b. a -> Either a b
Left String
err
  Right []  -> String -> Either String Funcons
forall a b. a -> Either a b
Left String
"no parse result"
  Right [Funcons
f] -> Funcons -> Either String Funcons
forall a b. b -> Either a b
Right Funcons
f
  Right [Funcons]
fs  -> String -> Either String Funcons
forall a b. a -> Either a b
Left String
"ambiguous parse result"

fvalue_parse :: String -> Funcons
fvalue_parse :: String -> Funcons
fvalue_parse = Values -> Funcons
FValue (Values -> Funcons) -> (String -> Values) -> String -> Funcons
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Values
fvalue_parse_ 

fvalue_parse_either :: String -> Either String Funcons
fvalue_parse_either :: String -> Either String Funcons
fvalue_parse_either = (Values -> Funcons)
-> Either String Values -> Either String Funcons
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Values -> Funcons
FValue (Either String Values -> Either String Funcons)
-> (String -> Either String Values)
-> String
-> Either String Funcons
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Values
fvalue_parse_either_

fvalue_parse_ :: String -> Values
fvalue_parse_ :: String -> Values
fvalue_parse_ = Parser Values -> String -> Values
forall a. Parser a -> String -> a
parser_a Parser Values
pValues

fvalue_parse_either_ :: String -> Either String Values
fvalue_parse_either_ :: String -> Either String Values
fvalue_parse_either_ String
str = case Parser Values -> String -> Either String [Values]
forall a. Parser a -> String -> Either String [a]
parsesWithErrors Parser Values
pValues String
str of 
  Left String
err  -> String -> Either String Values
forall a b. a -> Either a b
Left String
err
  Right []  -> String -> Either String Values
forall a b. a -> Either a b
Left String
"no parse result"
  Right [Values
f] -> Values -> Either String Values
forall a b. b -> Either a b
Right Values
f
  Right [Values]
fs  -> String -> Either String Values
forall a b. a -> Either a b
Left String
"ambiguous parse result"

parse :: Parser a -> String -> a
parse :: Parser a -> String -> a
parse Parser a
p String
str = case Parser a -> String -> [a]
forall a. Parser a -> String -> [a]
allParses Parser a
p String
str of []    -> String -> a
forall a. HasCallStack => String -> a
error String
"no parse"
                                      (a
a:[a]
_) -> a
a

parser_a :: Parser a -> String -> a
parser_a :: Parser a -> String -> a
parser_a Parser a
p String
string = case Parser a -> String -> [a]
forall a. Parser a -> String -> [a]
allParses Parser a
p String
string of
  []    -> String -> a
forall a. HasCallStack => String -> a
error String
"no parse"
  (a
f:[a]
_) -> a
f

allParses :: Parser a -> String -> [a]
allParses :: Parser a -> String -> [a]
allParses Parser a
p String
string = CombinatorOptions -> Parser a -> [Token] -> [a]
forall t (s :: * -> * -> *) a.
(Show t, Parseable t, IsSymbExpr s) =>
CombinatorOptions -> s t a -> [t] -> [a]
GLL.Combinators.parseWithOptions [CombinatorOption
throwErrors] Parser a
p 
                        (String -> [Token]
Funcons.GLLParser.lexer String
string) 

parsesWithErrors :: Parser a -> String -> Either String [a]
parsesWithErrors :: Parser a -> String -> Either String [a]
parsesWithErrors Parser a
p String
string = case (String -> Either String [Token]
Funcons.GLLParser.lexerEither String
string) of
  Left String
err  -> String -> Either String [a]
forall a b. a -> Either a b
Left String
err
  Right [Token]
ts  -> CombinatorOptions -> Parser a -> [Token] -> Either String [a]
forall t (s :: * -> * -> *) a.
(Show t, Parseable t, IsSymbExpr s) =>
CombinatorOptions -> s t a -> [t] -> Either String [a]
GLL.Combinators.parseWithOptionsAndError [] Parser a
p [Token]
ts

fct_lexerSettings :: LexerSettings
fct_lexerSettings = LexerSettings
emptyLanguage {
    lineComment :: String
lineComment = String
"//"
  , identifiers :: RE Char String
identifiers = RE Char String
lName
  , keywords :: [String]
keywords    = [String]
fct_keywords
  , keychars :: String
keychars    = String
fct_keychars
  }

lexer :: String -> [Token]
lexer = LexerSettings -> String -> [Token]
forall t. SubsumesToken t => LexerSettings -> String -> [t]
GLL.Combinators.lexer LexerSettings
fct_lexerSettings
lexerEither :: String -> Either String [Token]
lexerEither = LexerSettings -> String -> Either String [Token]
forall t.
SubsumesToken t =>
LexerSettings -> String -> Either String [t]
GLL.Combinators.lexerEither LexerSettings
fct_lexerSettings

fct_keywords :: [String]
fct_keywords = [String
"void", String
"depends", String
"forall", String
"type_abs"
               ,String
"typevar", String
"?", String
"*", String
"+", String
"|->", String
"=>"]
fct_keychars :: String
fct_keychars = String
"{}(),'\"[]|^&~"

lName :: RE Char String
lName = (:) (Char -> String -> String)
-> RE Char Char -> RE Char (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
psym Char -> Bool
isLower RE Char (String -> String) -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char Char -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
psym (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'))

data FSuffix  = SuffixComputesFrom Funcons
              | SuffixSeq SeqSortOp
              | SuffixSortUnion Funcons
              | SuffixSortInter Funcons
              | SuffixPower Funcons

pFuncons :: Parser Funcons
pFuncons :: Parser Funcons
pFuncons = String
"FUNCONS" 
  String -> OO [] AltExpr Token Funcons -> Parser Funcons
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=  [Funcons] -> Funcons
FSet               ([Funcons] -> Funcons)
-> SymbExpr Token [Funcons] -> AltExpr Token Funcons
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token [Funcons] -> SymbExpr Token [Funcons]
forall t (s :: * -> * -> *) b.
(Show t, Ord t, IsSymbExpr s, SubsumesToken t) =>
s t b -> BNF t b
braces   (Parser Funcons -> SymbExpr Token Char -> SymbExpr Token [Funcons]
forall t (s :: * -> * -> *) (s2 :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s, IsSymbExpr s2, IsAltExpr s2) =>
s t a -> s2 t b -> SymbExpr t [a]
multipleSepBy Parser Funcons
pFuncons (Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
','))
--  <||> FTuple             <$$> parens   (multipleSepBy pFuncons (keychar ','))
  AltExpr Token Funcons
-> OO [] AltExpr Token Funcons -> OO [] AltExpr Token Funcons
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> Name -> [Funcons] -> Funcons
FApp Name
"list"        ([Funcons] -> Funcons)
-> SymbExpr Token [Funcons] -> AltExpr Token Funcons
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token [Funcons] -> SymbExpr Token [Funcons]
forall t (s :: * -> * -> *) b.
(Show t, Ord t, IsSymbExpr s, SubsumesToken t) =>
s t b -> BNF t b
brackets (Parser Funcons -> SymbExpr Token Char -> SymbExpr Token [Funcons]
forall t (s :: * -> * -> *) (s2 :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s, IsSymbExpr s2, IsAltExpr s2) =>
s t a -> s2 t b -> SymbExpr t [a]
multipleSepBy Parser Funcons
pFuncons (Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
','))
  AltExpr Token Funcons
-> OO [] AltExpr Token Funcons -> OO [] AltExpr Token Funcons
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> [Funcons] -> Funcons
FMap               ([Funcons] -> Funcons)
-> SymbExpr Token [Funcons] -> AltExpr Token Funcons
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token [Funcons] -> SymbExpr Token [Funcons]
forall t (s :: * -> * -> *) b.
(Show t, Ord t, IsSymbExpr s, SubsumesToken t) =>
s t b -> BNF t b
braces   (Parser Funcons -> SymbExpr Token Char -> SymbExpr Token [Funcons]
forall t (s :: * -> * -> *) (s2 :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s, IsSymbExpr s2, IsAltExpr s2) =>
s t a -> s2 t b -> SymbExpr t [a]
multipleSepBy1 Parser Funcons
pKeyPair (Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
','))
  AltExpr Token Funcons
-> OO [] AltExpr Token Funcons -> OO [] AltExpr Token Funcons
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> Funcons -> Funcons
FSortComputes      (Funcons -> Funcons)
-> SymbExpr Token String -> AltExpr Token (Funcons -> Funcons)
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$  String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"=>" AltExpr Token (Funcons -> Funcons)
-> Parser Funcons -> AltExpr Token Funcons
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> Parser Funcons
pFuncons
  AltExpr Token Funcons
-> OO [] AltExpr Token Funcons -> OO [] AltExpr Token Funcons
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> Funcons -> Funcons
FSortComplement    (Funcons -> Funcons)
-> SymbExpr Token Char -> AltExpr Token (Funcons -> Funcons)
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$  Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
'~' AltExpr Token (Funcons -> Funcons)
-> Parser Funcons -> AltExpr Token Funcons
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> Parser Funcons
pFuncons
  AltExpr Token Funcons
-> OO [] AltExpr Token Funcons -> OO [] AltExpr Token Funcons
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> Funcons -> FSuffix -> Funcons
suffix_select      (Funcons -> FSuffix -> Funcons)
-> Parser Funcons -> AltExpr Token (FSuffix -> Funcons)
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> Parser Funcons
pFuncons AltExpr Token (FSuffix -> Funcons)
-> SymbExpr Token FSuffix -> AltExpr Token Funcons
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token FSuffix
pFSuffix 
  AltExpr Token Funcons
-> OO [] AltExpr Token Funcons -> OO [] AltExpr Token Funcons
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> Funcons -> FSuffix -> Funcons
suffix_select      (Funcons -> FSuffix -> Funcons)
-> Parser Funcons -> AltExpr Token (FSuffix -> Funcons)
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> Parser Funcons -> Parser Funcons
forall t (s :: * -> * -> *) b.
(Show t, Ord t, IsSymbExpr s, SubsumesToken t) =>
s t b -> BNF t b
parens Parser Funcons
pFuncons AltExpr Token (FSuffix -> Funcons)
-> SymbExpr Token FSuffix -> AltExpr Token Funcons
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token FSuffix
pFSuffix 
  AltExpr Token Funcons
-> OO [] AltExpr Token Funcons -> OO [] AltExpr Token Funcons
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> Name -> Maybe (Either Funcons [Funcons]) -> Funcons
maybe_apply (Name -> Maybe (Either Funcons [Funcons]) -> Funcons)
-> (String -> Name)
-> String
-> Maybe (Either Funcons [Funcons])
-> Funcons
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
pack (String -> Maybe (Either Funcons [Funcons]) -> Funcons)
-> SymbExpr Token String
-> AltExpr Token (Maybe (Either Funcons [Funcons]) -> Funcons)
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token String
forall t. SubsumesToken t => SymbExpr t String
id_lit AltExpr Token (Maybe (Either Funcons [Funcons]) -> Funcons)
-> SymbExpr Token (Maybe (Either Funcons [Funcons]))
-> AltExpr Token Funcons
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token (Either Funcons [Funcons])
-> SymbExpr Token (Maybe (Either Funcons [Funcons]))
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t (Maybe a)
optional SymbExpr Token (Either Funcons [Funcons])
pFunconss
  AltExpr Token Funcons
-> AltExpr Token Funcons -> OO [] AltExpr Token Funcons
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> Values -> Funcons
FValue             (Values -> Funcons) -> Parser Values -> AltExpr Token Funcons
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> Parser Values
pValues
 where
    maybe_apply :: Name -> Maybe (Either Funcons [Funcons]) -> Funcons
maybe_apply Name
nm Maybe (Either Funcons [Funcons])
Nothing = Name -> Funcons
FName Name
nm
    maybe_apply Name
nm (Just (Right [Funcons]
args)) = Name -> [Funcons] -> Funcons
FApp Name
nm [Funcons]
args
    maybe_apply Name
nm (Just (Left Funcons
arg)) =  Name -> [Funcons] -> Funcons
FApp Name
nm [Funcons
arg]

    suffix_select :: Funcons -> FSuffix -> Funcons
suffix_select Funcons
f1 FSuffix
s = case FSuffix
s of 
      SuffixComputesFrom Funcons
f2 -> Funcons -> Funcons -> Funcons
FSortComputesFrom Funcons
f1 Funcons
f2
      SuffixSeq SeqSortOp
op          -> Funcons -> SeqSortOp -> Funcons
FSortSeq Funcons
f1 SeqSortOp
op
      SuffixSortUnion Funcons
f2    -> Funcons -> Funcons -> Funcons
FSortUnion Funcons
f1 Funcons
f2
      SuffixSortInter Funcons
f2    -> Funcons -> Funcons -> Funcons
FSortInter Funcons
f1 Funcons
f2
      SuffixPower Funcons
f2        -> Funcons -> Funcons -> Funcons
FSortPower Funcons
f1 Funcons
f2

    pFSuffix :: Parser FSuffix
    pFSuffix :: SymbExpr Token FSuffix
pFSuffix = String
"FSUFFIX" 
      String -> OO [] AltExpr Token FSuffix -> SymbExpr Token FSuffix
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=>  Funcons -> FSuffix
SuffixComputesFrom  (Funcons -> FSuffix)
-> SymbExpr Token String -> AltExpr Token (Funcons -> FSuffix)
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$   String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"=>" AltExpr Token (Funcons -> FSuffix)
-> Parser Funcons -> AltExpr Token FSuffix
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> Parser Funcons
pFuncons
      AltExpr Token FSuffix
-> OO [] AltExpr Token FSuffix -> OO [] AltExpr Token FSuffix
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||>  SeqSortOp -> FSuffix
SuffixSeq           (SeqSortOp -> FSuffix)
-> SymbExpr Token SeqSortOp -> AltExpr Token FSuffix
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$>  SymbExpr Token SeqSortOp
pOp
      AltExpr Token FSuffix
-> OO [] AltExpr Token FSuffix -> OO [] AltExpr Token FSuffix
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||>  Funcons -> FSuffix
SuffixSortUnion     (Funcons -> FSuffix)
-> SymbExpr Token Char -> AltExpr Token (Funcons -> FSuffix)
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$   Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
'|' AltExpr Token (Funcons -> FSuffix)
-> Parser Funcons -> AltExpr Token FSuffix
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> Parser Funcons
pFuncons
      AltExpr Token FSuffix
-> OO [] AltExpr Token FSuffix -> OO [] AltExpr Token FSuffix
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||>  Funcons -> FSuffix
SuffixSortInter     (Funcons -> FSuffix)
-> SymbExpr Token Char -> AltExpr Token (Funcons -> FSuffix)
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$   Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
'&' AltExpr Token (Funcons -> FSuffix)
-> Parser Funcons -> AltExpr Token FSuffix
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> Parser Funcons
pFuncons
      AltExpr Token FSuffix
-> AltExpr Token FSuffix -> OO [] AltExpr Token FSuffix
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||>  Funcons -> FSuffix
SuffixPower         (Funcons -> FSuffix)
-> SymbExpr Token Char -> AltExpr Token (Funcons -> FSuffix)
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$   Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
'^' AltExpr Token (Funcons -> FSuffix)
-> Parser Funcons -> AltExpr Token FSuffix
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> Parser Funcons
pFuncons
                          
pFunconss :: Parser (Either Funcons [Funcons])
pFunconss :: SymbExpr Token (Either Funcons [Funcons])
pFunconss = String
"FUNCONS-SEQUENCE" 
  String
-> OO [] AltExpr Token (Either Funcons [Funcons])
-> SymbExpr Token (Either Funcons [Funcons])
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<::=  Funcons -> Either Funcons [Funcons]
forall a b. a -> Either a b
Left  (Funcons -> Either Funcons [Funcons])
-> Parser Funcons -> AltExpr Token (Either Funcons [Funcons])
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> Parser Funcons
pFuncons
  AltExpr Token (Either Funcons [Funcons])
-> AltExpr Token (Either Funcons [Funcons])
-> OO [] AltExpr Token (Either Funcons [Funcons])
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||>  [Funcons] -> Either Funcons [Funcons]
forall a b. b -> Either a b
Right ([Funcons] -> Either Funcons [Funcons])
-> ([Either Funcons [Funcons]] -> [Funcons])
-> [Either Funcons [Funcons]]
-> Either Funcons [Funcons]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either Funcons [Funcons]] -> [Funcons]
forall a. [Either a [a]] -> [a]
merge ([Either Funcons [Funcons]] -> Either Funcons [Funcons])
-> SymbExpr Token [Either Funcons [Funcons]]
-> AltExpr Token (Either Funcons [Funcons])
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token [Either Funcons [Funcons]]
-> SymbExpr Token [Either Funcons [Funcons]]
forall t (s :: * -> * -> *) b.
(Show t, Ord t, IsSymbExpr s, SubsumesToken t) =>
s t b -> BNF t b
parens (SymbExpr Token (Either Funcons [Funcons])
-> SymbExpr Token Char -> SymbExpr Token [Either Funcons [Funcons]]
forall t (s :: * -> * -> *) (s2 :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s, IsSymbExpr s2, IsAltExpr s2) =>
s t a -> s2 t b -> SymbExpr t [a]
multipleSepBy SymbExpr Token (Either Funcons [Funcons])
pFunconss (Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
','))
  where merge :: [Either a [a]] -> [a]
merge = (Either a [a] -> [a] -> [a]) -> [a] -> [Either a [a]] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Either a [a] -> [a] -> [a]
forall a. Either a [a] -> [a] -> [a]
op [] 
          where op :: Either a [a] -> [a] -> [a]
op (Left a
f) [a]
acc = a
fa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc
                op (Right [a]
fs) [a]
acc = [a]
fs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
acc

pFunconsSeq :: Parser [Funcons]
pFunconsSeq :: SymbExpr Token [Funcons]
pFunconsSeq = String
"FUNCONS-SEQ" 
  String -> AltExpr Token [Funcons] -> SymbExpr Token [Funcons]
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=> (Funcons -> [Funcons])
-> ([Funcons] -> [Funcons])
-> Either Funcons [Funcons]
-> [Funcons]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Funcons -> [Funcons] -> [Funcons]
forall a. a -> [a] -> [a]
:[]) [Funcons] -> [Funcons]
forall a. a -> a
id (Either Funcons [Funcons] -> [Funcons])
-> SymbExpr Token (Either Funcons [Funcons])
-> AltExpr Token [Funcons]
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token (Either Funcons [Funcons])
pFunconss

pKeyPair :: Parser Funcons
pKeyPair :: Parser Funcons
pKeyPair = String
"KEYPAIR" String -> AltExpr Token Funcons -> Parser Funcons
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=> 
 Funcons -> Either Funcons [Funcons] -> Funcons
fBinding (Funcons -> Either Funcons [Funcons] -> Funcons)
-> Parser Funcons
-> AltExpr Token (Either Funcons [Funcons] -> Funcons)
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> Parser Funcons
pFuncons AltExpr Token (Either Funcons [Funcons] -> Funcons)
-> SymbExpr Token String
-> AltExpr Token (Either Funcons [Funcons] -> Funcons)
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"|->" AltExpr Token (Either Funcons [Funcons] -> Funcons)
-> SymbExpr Token (Either Funcons [Funcons])
-> AltExpr Token Funcons
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token (Either Funcons [Funcons])
pFunconss
  where fBinding :: Funcons -> Either Funcons [Funcons] -> Funcons
fBinding Funcons
k Either Funcons [Funcons]
ev = Funcons -> [Funcons] -> Funcons
FBinding Funcons
k ((Funcons -> [Funcons])
-> ([Funcons] -> [Funcons])
-> Either Funcons [Funcons]
-> [Funcons]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Funcons -> [Funcons] -> [Funcons]
forall a. a -> [a] -> [a]
:[]) [Funcons] -> [Funcons]
forall a. a -> a
id Either Funcons [Funcons]
ev)

pOp :: Parser SeqSortOp
pOp :: SymbExpr Token SeqSortOp
pOp = String
"OP" String -> OO [] AltExpr Token SeqSortOp -> SymbExpr Token SeqSortOp
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=> 
  SeqSortOp
StarOp  SeqSortOp -> SymbExpr Token String -> AltExpr Token SeqSortOp
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$  String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"*"
          AltExpr Token SeqSortOp
-> OO [] AltExpr Token SeqSortOp -> OO [] AltExpr Token SeqSortOp
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> SeqSortOp
PlusOp SeqSortOp -> SymbExpr Token String -> AltExpr Token SeqSortOp
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"+"
          AltExpr Token SeqSortOp
-> AltExpr Token SeqSortOp -> OO [] AltExpr Token SeqSortOp
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> SeqSortOp
QuestionMarkOp SeqSortOp -> SymbExpr Token String -> AltExpr Token SeqSortOp
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"?"

pValues :: Parser Values
pValues :: Parser Values
pValues = String
"VALUES" 
  String -> OO [] AltExpr Token Values -> Parser Values
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=> Char -> Values
forall t. HasValues t => Char -> Values t
mk_unicode_characters (Char -> Values) -> SymbExpr Token Char -> AltExpr Token Values
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token Char
forall t. SubsumesToken t => SymbExpr t Char
char_lit
  AltExpr Token Values
-> OO [] AltExpr Token Values -> OO [] AltExpr Token Values
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> String -> Values
string__  (String -> Values) -> SymbExpr Token String -> AltExpr Token Values
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token String
forall t. SubsumesToken t => SymbExpr t String
string_lit
  AltExpr Token Values
-> OO [] AltExpr Token Values -> OO [] AltExpr Token Values
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> Integer -> Values
forall t. Integer -> Values t
mk_integers (Integer -> Values) -> (Int -> Integer) -> Int -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Values) -> SymbExpr Token Int -> AltExpr Token Values
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token Int
forall t. SubsumesToken t => SymbExpr t Int
int_lit 
  AltExpr Token Values
-> AltExpr Token Values -> OO [] AltExpr Token Values
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> Double -> Values
forall t. Double -> Values t
IEEE_Float_64 (Double -> Values) -> (String -> Double) -> String -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, String) -> Double
forall a b. (a, b) -> a
fst ((Double, String) -> Double)
-> (String -> (Double, String)) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Double, String)] -> (Double, String)
forall a. [a] -> a
head ([(Double, String)] -> (Double, String))
-> (String -> [(Double, String)]) -> String -> (Double, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Double, String)]
forall a. RealFrac a => ReadS a
readFloat (String -> Values) -> SymbExpr Token String -> AltExpr Token Values
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token String
pRatioAsString
 where  pRatioAsString :: SymbExpr Token String
pRatioAsString = String
"RATIOasSTRING" -- NOT OK, would parse "-2.-3"
          String -> AltExpr Token String -> SymbExpr Token String
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=> (\Int
m Int
l -> Int -> String
forall a. Show a => a -> String
show Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l) (Int -> Int -> String)
-> SymbExpr Token Int -> AltExpr Token (Int -> String)
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token Int
forall t. SubsumesToken t => SymbExpr t Int
int_lit AltExpr Token (Int -> String)
-> SymbExpr Token Char -> AltExpr Token (Int -> String)
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
'.'
                                                 AltExpr Token (Int -> String)
-> SymbExpr Token Int -> AltExpr Token String
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token Int
forall t. SubsumesToken t => SymbExpr t Int
int_lit