module Examples.Lang.Arith where

import UVMHS

lexer ∷ Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
lexer :: Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
lexer = 𝐿 𝕊
-> 𝐿 𝕊
-> 𝐿 𝕊
-> 𝐿 𝕊
-> Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
lexerBasic ([𝕊] -> 𝐿 𝕊
forall a t. ToIter a t => t -> 𝐿 a
list [𝕊
"(",𝕊
")"]) 𝐿 𝕊
forall a. Null a => a
null 𝐿 𝕊
forall a. Null a => a
null ([𝕊] -> 𝐿 𝕊
forall a t. ToIter a t => t -> 𝐿 a
list [𝕊
"==",𝕊
"+",𝕊
"*",𝕊
"-",𝕊
"^",𝕊
"!"])

testTokenizerSuccess ∷ IO ()
testTokenizerSuccess :: IO ()
testTokenizerSuccess = 
  Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
-> 𝕊 -> 𝕍 (ParserToken ℂ) -> IO ()
forall c t o u w.
(Show u, Ord c, Ord t, Pretty t, Classified c t, Eq o, Eq u,
 Plus u, Pretty w) =>
Lexer c t o u w -> 𝕊 -> 𝕍 (ParserToken t) -> IO ()
tokenizeIOMain Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
lexer 𝕊
"" (𝕍 (ParserToken ℂ) -> IO ()) -> 𝕍 (ParserToken ℂ) -> IO ()
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝕍 (ParserToken ℂ)
tokens 𝕊
"1 + 2 - 3 * 4 ^ 5 ! == 1 \n -- blah blah \n {- ml {{- ml --}-} -- blah\nb" 

data Lit =
    IntegerL ℤ
  | DoubleL 𝔻
  | StringL 𝕊
makePrettySum ''Lit

data Atom =
    LitA Lit
  | NameA 𝕊
makePrettySum ''Atom

type Exp = 𝐴 SrcCxt ExpPre
data ExpPre =
    AtomE Atom
  | PlusE Exp Exp
  | TimesE Exp Exp
  | ExpoE Exp Exp
  | FactE Exp
  | NegateE Exp
  | EqualE Exp Exp
makePrisms ''ExpPre
makePrettySum ''ExpPre

cpLit ∷ CParser TokenBasic Lit
cpLit :: CParser TokenBasic Lit
cpLit = [CParser TokenBasic Lit] -> CParser TokenBasic Lit
forall (m :: * -> *) a t.
(Monad m, MonadFail m, ToIter (m a) t) =>
t -> m a
tries
  [ ℤ -> Lit
IntegerL (ℤ -> Lit) -> CParser TokenBasic ℤ -> CParser TokenBasic Lit
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ CParser TokenBasic ℤ
cpInteger
  , 𝔻 -> Lit
DoubleL (𝔻 -> Lit) -> CParser TokenBasic 𝔻 -> CParser TokenBasic Lit
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ CParser TokenBasic 𝔻
cpDouble
  , 𝕊 -> Lit
StringL (𝕊 -> Lit) -> CParser TokenBasic 𝕊 -> CParser TokenBasic Lit
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ CParser TokenBasic 𝕊
cpString
  ]

cpAtom ∷ CParser TokenBasic Atom
cpAtom :: CParser TokenBasic Atom
cpAtom = 𝕊 -> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpNewContext 𝕊
"atom" (CParser TokenBasic Atom -> CParser TokenBasic Atom)
-> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall a b. (a -> b) -> a -> b
$ [CParser TokenBasic Atom] -> CParser TokenBasic Atom
forall (m :: * -> *) a t.
(Monad m, MonadFail m, ToIter (m a) t) =>
t -> m a
tries
  [ Lit -> Atom
LitA (Lit -> Atom) -> CParser TokenBasic Lit -> CParser TokenBasic Atom
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ CParser TokenBasic Lit
cpLit
  , 𝕊 -> Atom
NameA (𝕊 -> Atom) -> CParser TokenBasic 𝕊 -> CParser TokenBasic Atom
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ (TokenBasic -> 𝑂 𝕊) -> CParser TokenBasic 𝕊
forall t a. (t -> 𝑂 a) -> CParser t a
cpShaped ((TokenBasic -> 𝑂 𝕊) -> CParser TokenBasic 𝕊)
-> (TokenBasic -> 𝑂 𝕊) -> CParser TokenBasic 𝕊
forall a b. (a -> b) -> a -> b
$ (TokenBasic ⌲ 𝕊) -> TokenBasic -> 𝑂 𝕊
forall a b. (a ⌲ b) -> a -> 𝑂 b
view TokenBasic ⌲ 𝕊
nameTBasicL
  ]

cpExp ∷ CParser TokenBasic Exp 
cpExp :: CParser TokenBasic Exp
cpExp = 𝕊 -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre -> CParser TokenBasic Exp
forall t a.
Ord t =>
𝕊 -> MixfixF t (𝐴 SrcCxt) a -> CParser t (𝐴 SrcCxt a)
fmixfixWithContext 𝕊
"exp" (MixfixF TokenBasic (𝐴 SrcCxt) ExpPre -> CParser TokenBasic Exp)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre -> CParser TokenBasic Exp
forall a b. (a -> b) -> a -> b
$ [MixfixF TokenBasic (𝐴 SrcCxt) ExpPre]
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall a t. (Monoid a, ToIter a t) => t -> a
concat
  [ CParser TokenBasic ExpPre -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall t a (f :: * -> *). CParser t a -> MixfixF t f a
fmixTerminal (CParser TokenBasic ExpPre -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre)
-> CParser TokenBasic ExpPre
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall a b. (a -> b) -> a -> b
$ do
      CParser TokenBasic TokenBasic -> CParser TokenBasic ()
forall (m :: * -> *) a. Functor m => m a -> m ()
void (CParser TokenBasic TokenBasic -> CParser TokenBasic ())
-> CParser TokenBasic TokenBasic -> CParser TokenBasic ()
forall a b. (a -> b) -> a -> b
$ TokenBasic -> CParser TokenBasic TokenBasic
forall t. Ord t => t -> CParser t t
cpToken (TokenBasic -> CParser TokenBasic TokenBasic)
-> TokenBasic -> CParser TokenBasic TokenBasic
forall a b. (a -> b) -> a -> b
$ 𝕊 -> TokenBasic
SyntaxTBasic 𝕊
"("
      Exp
e ← CParser TokenBasic Exp
cpExp
      CParser TokenBasic TokenBasic -> CParser TokenBasic ()
forall (m :: * -> *) a. Functor m => m a -> m ()
void (CParser TokenBasic TokenBasic -> CParser TokenBasic ())
-> CParser TokenBasic TokenBasic -> CParser TokenBasic ()
forall a b. (a -> b) -> a -> b
$ TokenBasic -> CParser TokenBasic TokenBasic
forall t. Ord t => t -> CParser t t
cpToken (TokenBasic -> CParser TokenBasic TokenBasic)
-> TokenBasic -> CParser TokenBasic TokenBasic
forall a b. (a -> b) -> a -> b
$ 𝕊 -> TokenBasic
SyntaxTBasic 𝕊
")"
      ExpPre -> CParser TokenBasic ExpPre
forall a. a -> CParser TokenBasic a
forall (m :: * -> *) a. Return m => a -> m a
return (ExpPre -> CParser TokenBasic ExpPre)
-> ExpPre -> CParser TokenBasic ExpPre
forall a b. (a -> b) -> a -> b
$ Exp -> ExpPre
forall a. 𝐴 SrcCxt a -> a
forall (w :: * -> *) a. Extract w => w a -> a
extract Exp
e
  , CParser TokenBasic ExpPre -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall t a (f :: * -> *). CParser t a -> MixfixF t f a
fmixTerminal       (CParser TokenBasic ExpPre -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre)
-> CParser TokenBasic ExpPre
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall a b. (a -> b) -> a -> b
$ Atom -> ExpPre
AtomE         (Atom -> ExpPre)
-> CParser TokenBasic Atom -> CParser TokenBasic ExpPre
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ CParser TokenBasic Atom
cpAtom
  , ℕ64
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall t (f :: * -> *) a.
ℕ64 -> CParser t (f a -> f a -> a) -> MixfixF t f a
fmixInfix   ℕ64
pCMP   (CParser TokenBasic (Exp -> Exp -> ExpPre)
 -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre)
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall a b. (a -> b) -> a -> b
$ (Exp -> Exp -> ExpPre) -> TokenBasic -> Exp -> Exp -> ExpPre
forall a b. a -> b -> a
const Exp -> Exp -> ExpPre
EqualE  (TokenBasic -> Exp -> Exp -> ExpPre)
-> CParser TokenBasic TokenBasic
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"=="
  , ℕ64
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall t (f :: * -> *) a.
ℕ64 -> CParser t (f a -> f a -> a) -> MixfixF t f a
fmixInfixR  ℕ64
pPLUS  (CParser TokenBasic (Exp -> Exp -> ExpPre)
 -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre)
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall a b. (a -> b) -> a -> b
$ (Exp -> Exp -> ExpPre) -> TokenBasic -> Exp -> Exp -> ExpPre
forall a b. a -> b -> a
const Exp -> Exp -> ExpPre
PlusE   (TokenBasic -> Exp -> Exp -> ExpPre)
-> CParser TokenBasic TokenBasic
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"+"
  , ℕ64
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall t (f :: * -> *) a.
ℕ64 -> CParser t (f a -> f a -> a) -> MixfixF t f a
fmixInfixR  ℕ64
pTIMES (CParser TokenBasic (Exp -> Exp -> ExpPre)
 -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre)
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall a b. (a -> b) -> a -> b
$ (Exp -> Exp -> ExpPre) -> TokenBasic -> Exp -> Exp -> ExpPre
forall a b. a -> b -> a
const Exp -> Exp -> ExpPre
TimesE  (TokenBasic -> Exp -> Exp -> ExpPre)
-> CParser TokenBasic TokenBasic
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"*"
  , ℕ64
-> CParser TokenBasic (Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall t (f :: * -> *) a.
ℕ64 -> CParser t (f a -> a) -> MixfixF t f a
fmixPrefix  ℕ64
pNEG   (CParser TokenBasic (Exp -> ExpPre)
 -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre)
-> CParser TokenBasic (Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall a b. (a -> b) -> a -> b
$ (Exp -> ExpPre) -> TokenBasic -> Exp -> ExpPre
forall a b. a -> b -> a
const Exp -> ExpPre
NegateE (TokenBasic -> Exp -> ExpPre)
-> CParser TokenBasic TokenBasic
-> CParser TokenBasic (Exp -> ExpPre)
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"-"
  , ℕ64
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall t (f :: * -> *) a.
ℕ64 -> CParser t (f a -> f a -> a) -> MixfixF t f a
fmixInfixL  ℕ64
pPOW   (CParser TokenBasic (Exp -> Exp -> ExpPre)
 -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre)
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall a b. (a -> b) -> a -> b
$ (Exp -> Exp -> ExpPre) -> TokenBasic -> Exp -> Exp -> ExpPre
forall a b. a -> b -> a
const Exp -> Exp -> ExpPre
ExpoE   (TokenBasic -> Exp -> Exp -> ExpPre)
-> CParser TokenBasic TokenBasic
-> CParser TokenBasic (Exp -> Exp -> ExpPre)
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"^"
  , ℕ64
-> CParser TokenBasic (Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall t (f :: * -> *) a.
ℕ64 -> CParser t (f a -> a) -> MixfixF t f a
fmixPostfix ℕ64
pFAC   (CParser TokenBasic (Exp -> ExpPre)
 -> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre)
-> CParser TokenBasic (Exp -> ExpPre)
-> MixfixF TokenBasic (𝐴 SrcCxt) ExpPre
forall a b. (a -> b) -> a -> b
$ (Exp -> ExpPre) -> TokenBasic -> Exp -> ExpPre
forall a b. a -> b -> a
const Exp -> ExpPre
FactE   (TokenBasic -> Exp -> ExpPre)
-> CParser TokenBasic TokenBasic
-> CParser TokenBasic (Exp -> ExpPre)
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"!"
  ]

testParserSuccess ∷ IO ()
testParserSuccess :: IO ()
testParserSuccess = do
  CParser TokenBasic Exp -> 𝕊 -> 𝕍 (ParserToken TokenBasic) -> IO ()
forall a t ts.
(Pretty a, ToIter (ParserToken t) ts, Ord t) =>
CParser t a -> 𝕊 -> ts -> IO ()
parseIOMain CParser TokenBasic Exp
cpExp 𝕊
"" (𝕍 (ParserToken TokenBasic) -> IO ())
-> IO (𝕍 (ParserToken TokenBasic)) -> IO ()
forall (m :: * -> *) a b. Bind m => (a -> m b) -> m a -> m b
*$ Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
-> 𝕊 -> 𝕍 (ParserToken ℂ) -> IO (𝕍 (ParserToken TokenBasic))
forall c t o u w.
(Show u, Ord c, Ord t, Pretty t, Classified c t, Eq o, Eq u,
 Plus u) =>
Lexer c t o u w -> 𝕊 -> 𝕍 (ParserToken t) -> IO (𝕍 (ParserToken w))
tokenizeIO Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
lexer 𝕊
"" (𝕍 (ParserToken ℂ) -> IO (𝕍 (ParserToken TokenBasic)))
-> 𝕍 (ParserToken ℂ) -> IO (𝕍 (ParserToken TokenBasic))
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝕍 (ParserToken ℂ)
tokens 𝕊
"(- 1) + - 2 + 3 * 4 ^ 5 ^ 6 !"

testParserFailure1 ∷ IO ()
testParserFailure1 :: IO ()
testParserFailure1 = CParser TokenBasic Exp -> 𝕊 -> 𝕍 (ParserToken TokenBasic) -> IO ()
forall a t ts.
(Pretty a, ToIter (ParserToken t) ts, Ord t) =>
CParser t a -> 𝕊 -> ts -> IO ()
parseIOMain CParser TokenBasic Exp
cpExp 𝕊
"" (𝕍 (ParserToken TokenBasic) -> IO ())
-> IO (𝕍 (ParserToken TokenBasic)) -> IO ()
forall (m :: * -> *) a b. Bind m => (a -> m b) -> m a -> m b
*$ Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
-> 𝕊 -> 𝕍 (ParserToken ℂ) -> IO (𝕍 (ParserToken TokenBasic))
forall c t o u w.
(Show u, Ord c, Ord t, Pretty t, Classified c t, Eq o, Eq u,
 Plus u) =>
Lexer c t o u w -> 𝕊 -> 𝕍 (ParserToken t) -> IO (𝕍 (ParserToken w))
tokenizeIO Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
lexer 𝕊
"" (𝕍 (ParserToken ℂ) -> IO (𝕍 (ParserToken TokenBasic)))
-> 𝕍 (ParserToken ℂ) -> IO (𝕍 (ParserToken TokenBasic))
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝕍 (ParserToken ℂ)
tokens 𝕊
"((9 == ((- 1))) + 2 + 3 * 4 ^ 5 ^ 6 !))"

testParserFailure2 ∷ IO ()
testParserFailure2 :: IO ()
testParserFailure2 = CParser TokenBasic Exp -> 𝕊 -> 𝕍 (ParserToken TokenBasic) -> IO ()
forall a t ts.
(Pretty a, ToIter (ParserToken t) ts, Ord t) =>
CParser t a -> 𝕊 -> ts -> IO ()
parseIOMain CParser TokenBasic Exp
cpExp 𝕊
"" (𝕍 (ParserToken TokenBasic) -> IO ())
-> IO (𝕍 (ParserToken TokenBasic)) -> IO ()
forall (m :: * -> *) a b. Bind m => (a -> m b) -> m a -> m b
*$ Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
-> 𝕊 -> 𝕍 (ParserToken ℂ) -> IO (𝕍 (ParserToken TokenBasic))
forall c t o u w.
(Show u, Ord c, Ord t, Pretty t, Classified c t, Eq o, Eq u,
 Plus u) =>
Lexer c t o u w -> 𝕊 -> 𝕍 (ParserToken t) -> IO (𝕍 (ParserToken w))
tokenizeIO Lexer CharClass ℂ TokenClassBasic ℕ64 TokenBasic
lexer 𝕊
"" (𝕍 (ParserToken ℂ) -> IO (𝕍 (ParserToken TokenBasic)))
-> 𝕍 (ParserToken ℂ) -> IO (𝕍 (ParserToken TokenBasic))
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 𝕍 (ParserToken ℂ)
tokens 𝕊
"(((((- 1))) + 2 + 3 * 4 ^ 5 ^ ! == 0))"