module Examples.Lang.SExp 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 t. ToIter a t => t -> 𝐿 a
list [𝕊
"KEY"]) ([𝕊] -> 𝐿 𝕊
forall a t. ToIter a t => t -> 𝐿 a
list [𝕊
"PRIM"]) ([𝕊] -> 𝐿 𝕊
forall a t. ToIter a t => t -> 𝐿 a
list [𝕊
"+"])

testSExpTokenizerSuccess ∷ IO ()
testSExpTokenizerSuccess :: IO ()
testSExpTokenizerSuccess = 
  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-1.42(\"astringwith\\\\stuff\\n\" ( "

testSExpTokenizerFailure1 ∷ IO ()
testSExpTokenizerFailure1 :: IO ()
testSExpTokenizerFailure1 =
  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 𝕊
"((foo-1and0.01+bar"

testSExpTokenizerFailure2 ∷ IO ()
testSExpTokenizerFailure2 :: IO ()
testSExpTokenizerFailure2 =
  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 𝕊
"()foo-1\"astring\\badescape\""

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

data Atom =
    LitA Lit
  | NameA 𝕊
  | KeyA
  | PrimA
  | PlusA
makePrettySum ''Atom

type Exp = 𝐴 SrcCxt ExpPre
data ExpPre =
    AtomE Atom
  | ListE (𝐿 Exp)
makePrettySum ''ExpPre

------------
-- Parser --
------------

cpLit ∷ CParser TokenBasic Lit
cpLit :: CParser TokenBasic Lit
cpLit = [CParser TokenBasic Lit] -> CParser TokenBasic Lit
forall a t. (Monoid a, ToIter a t) => t -> a
concat
  [ ℤ -> Lit
IntegerL (ℤ -> Lit) -> CParser TokenBasic ℤ -> CParser TokenBasic Lit
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 ⌲ ℤ
integerTBasicL
  , 𝔻 -> Lit
DoubleL (𝔻 -> Lit) -> CParser TokenBasic 𝔻 -> CParser TokenBasic Lit
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 ⌲ 𝔻
doubleTBasicL
  , 𝕊 -> Lit
StringL (𝕊 -> Lit) -> CParser TokenBasic 𝕊 -> CParser TokenBasic Lit
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 ⌲ 𝕊
stringTBasicL
  ]

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 a t. (Monoid a, ToIter a t) => t -> a
concat
  [ 𝕊 -> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpErr 𝕊
"literal" (CParser TokenBasic Atom -> CParser TokenBasic Atom)
-> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall a b. (a -> b) -> a -> b
$ 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
  , 𝕊 -> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpErr 𝕊
"name" (CParser TokenBasic Atom -> CParser TokenBasic Atom)
-> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall a b. (a -> b) -> a -> b
$ 𝕊 -> 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
  , 𝕊 -> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpErr 𝕊
"keyword" (CParser TokenBasic Atom -> CParser TokenBasic Atom)
-> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall a b. (a -> b) -> a -> b
$ Atom -> TokenBasic -> Atom
forall a b. a -> b -> a
const Atom
KeyA (TokenBasic -> Atom)
-> CParser TokenBasic TokenBasic -> CParser TokenBasic Atom
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"KEY"
  , 𝕊 -> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpErr 𝕊
"primitive" (CParser TokenBasic Atom -> CParser TokenBasic Atom)
-> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall a b. (a -> b) -> a -> b
$ Atom -> TokenBasic -> Atom
forall a b. a -> b -> a
const Atom
PrimA (TokenBasic -> Atom)
-> CParser TokenBasic TokenBasic -> CParser TokenBasic Atom
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"PRIM"
  , 𝕊 -> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpErr 𝕊
"“+”" (CParser TokenBasic Atom -> CParser TokenBasic Atom)
-> CParser TokenBasic Atom -> CParser TokenBasic Atom
forall a b. (a -> b) -> a -> b
$ Atom -> TokenBasic -> Atom
forall a b. a -> b -> a
const Atom
PlusA (TokenBasic -> Atom)
-> CParser TokenBasic TokenBasic -> CParser TokenBasic Atom
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"+"
  ]

cpExp ∷ CParser TokenBasic Exp
cpExp :: CParser TokenBasic Exp
cpExp = 𝕊 -> CParser TokenBasic Exp -> CParser TokenBasic Exp
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpNewContext 𝕊
"expression" (CParser TokenBasic Exp -> CParser TokenBasic Exp)
-> CParser TokenBasic Exp -> CParser TokenBasic Exp
forall a b. (a -> b) -> a -> b
$ CParser TokenBasic ExpPre -> CParser TokenBasic Exp
forall t a. Ord t => CParser t a -> CParser t (𝐴 SrcCxt a)
cpWithContextRendered (CParser TokenBasic ExpPre -> CParser TokenBasic Exp)
-> CParser TokenBasic ExpPre -> CParser TokenBasic Exp
forall a b. (a -> b) -> a -> b
$ [CParser TokenBasic ExpPre] -> CParser TokenBasic ExpPre
forall a t. (Monoid a, ToIter a t) => t -> a
concat
  [ 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
  , 𝐿 Exp -> ExpPre
ListE (𝐿 Exp -> ExpPre)
-> CParser TokenBasic (𝐿 Exp) -> CParser TokenBasic ExpPre
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ CParser TokenBasic (𝐿 Exp)
cpList
  ]

cpList ∷ CParser TokenBasic (𝐿 Exp)
cpList :: CParser TokenBasic (𝐿 Exp)
cpList = 𝕊 -> CParser TokenBasic (𝐿 Exp) -> CParser TokenBasic (𝐿 Exp)
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpNewContext 𝕊
"list" (CParser TokenBasic (𝐿 Exp) -> CParser TokenBasic (𝐿 Exp))
-> CParser TokenBasic (𝐿 Exp) -> CParser TokenBasic (𝐿 Exp)
forall a b. (a -> b) -> a -> b
$ do
  𝕊 -> CParser TokenBasic () -> CParser TokenBasic ()
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpErr 𝕊
"“(”" (CParser TokenBasic () -> CParser TokenBasic ())
-> CParser TokenBasic () -> CParser TokenBasic ()
forall a b. (a -> b) -> a -> b
$ 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
$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
"("
  𝐿 Exp
es ← CParser TokenBasic Exp -> CParser TokenBasic (𝐿 Exp)
forall t a. Ord t => CParser t a -> CParser t (𝐿 a)
cpMany CParser TokenBasic Exp
cpExp
  𝕊 -> CParser TokenBasic () -> CParser TokenBasic ()
forall t a. Ord t => 𝕊 -> CParser t a -> CParser t a
cpErr 𝕊
"“)”" (CParser TokenBasic () -> CParser TokenBasic ())
-> CParser TokenBasic () -> CParser TokenBasic ()
forall a b. (a -> b) -> a -> b
$ 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
$ 𝕊 -> CParser TokenBasic TokenBasic
cpSyntax 𝕊
")"
  𝐿 Exp -> CParser TokenBasic (𝐿 Exp)
forall a. a -> CParser TokenBasic a
forall (m :: * -> *) a. Return m => a -> m a
return 𝐿 Exp
es

testSExpParserSuccess ∷ IO ()
testSExpParserSuccess :: IO ()
testSExpParserSuccess = do
  𝕍 (ParserToken TokenBasic)
toks ← 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 𝕊
"<raw input>" 𝕍 (ParserToken ℂ)
input
  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 𝕊
"<tokens input>" 𝕍 (ParserToken TokenBasic)
toks
  where
    input ∷ 𝕍 (ParserToken ℂ)
    input :: 𝕍 (ParserToken ℂ)
input = 𝕊 -> 𝕍 (ParserToken ℂ)
tokens 𝕊
" ( PRIM KEY x + y  {- yo -} ( -1-2)  0.0 \n x   y   z \n abc -12  )  "

testSExpParserFailure1 ∷ IO ()
testSExpParserFailure1 :: IO ()
testSExpParserFailure1 = do
  𝕍 (ParserToken TokenBasic)
toks ← 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 𝕊
"<raw input>" 𝕍 (ParserToken ℂ)
input
  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 𝕊
"<tokens input>" 𝕍 (ParserToken TokenBasic)
toks
  where
    input ∷ 𝕍 (ParserToken ℂ)
    input :: 𝕍 (ParserToken ℂ)
input = 𝕊 -> 𝕍 (ParserToken ℂ)
tokens 𝕊
" (( PRIM KEY x + y  {- yo -} ( -1-2)  0.0 \n x   y   z \n abc -12 )  "

testSExpParserFailure2 ∷ IO ()
testSExpParserFailure2 :: IO ()
testSExpParserFailure2 = do
  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 ℂ)
input
  𝕍 (ParserToken TokenBasic)
toks ← 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 ℂ)
input
  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)
toks
  where
    input ∷ 𝕍 (ParserToken ℂ)
    input :: 𝕍 (ParserToken ℂ)
input = 𝕊 -> 𝕍 (ParserToken ℂ)
tokens 𝕊
" )( PRIM KEY x + y  {- yo -} ( -1-2)  0.0 \n x   y   z \n abc -12 )  "

testSExpParserFailure3 ∷ IO ()
testSExpParserFailure3 :: IO ()
testSExpParserFailure3 = do
  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 ℂ)
input
  𝕍 (ParserToken TokenBasic)
toks ← 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 ℂ)
input
  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)
toks
  where
    input ∷ 𝕍 (ParserToken ℂ)
    input :: 𝕍 (ParserToken ℂ)
input = 𝕊 -> 𝕍 (ParserToken ℂ)
tokens 𝕊
" ( PRIM KEY x + y  {- yo -} ( -1-2)  0.0 \n x   y   z \n abc -12 )(  "