{-# LANGUAGE UndecidableInstances #-}
module Symantic.Parser.Machine.View where
import Data.Bool (Bool(..))
import Data.Function (($), (.), id)
import Data.Functor ((<$>))
import Data.Kind (Type)
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Text.Show (Show(..))
import qualified Data.Tree as Tree
import qualified Data.List as List
import qualified Language.Haskell.TH.Syntax as TH
import Symantic.Parser.Grammar.ObserveSharing (ShowLetName(..))
import Symantic.Parser.Machine.Instructions
newtype ViewMachine (showName::Bool) inp (vs:: [Type]) (es::Peano) a
= ViewMachine { forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ::
Tree.Forest String -> Tree.Forest String }
viewMachine ::
ViewMachine sN inp vs es a ->
ViewMachine sN inp vs es a
viewMachine :: forall (sN :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine sN inp vs es a -> ViewMachine sN inp vs es a
viewMachine = ViewMachine sN inp vs es a -> ViewMachine sN inp vs es a
forall a. a -> a
id
viewInstrCmd :: String -> Tree.Forest String -> Tree.Tree String
viewInstrCmd :: String -> Forest String -> Tree String
viewInstrCmd String
n = String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
n
viewInstrArg :: String -> Tree.Forest String -> Tree.Tree String
viewInstrArg :: String -> Forest String -> Tree String
viewInstrArg String
n = String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node (String
"<"String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
nString -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
">")
instance Show (ViewMachine sN inp vs es a) where
show :: ViewMachine sN inp vs es a -> String
show = Tree String -> String
drawTree (Tree String -> String)
-> (ViewMachine sN inp vs es a -> Tree String)
-> ViewMachine sN inp vs es a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node String
"" (Forest String -> Tree String)
-> (ViewMachine sN inp vs es a -> Forest String)
-> ViewMachine sN inp vs es a
-> Tree String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Forest String -> Forest String) -> Forest String -> Forest String
forall a b. (a -> b) -> a -> b
$ []) ((Forest String -> Forest String) -> Forest String)
-> (ViewMachine sN inp vs es a -> Forest String -> Forest String)
-> ViewMachine sN inp vs es a
-> Forest String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewMachine sN inp vs es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine
where
drawTree :: Tree.Tree String -> String
drawTree :: Tree String -> String
drawTree = [String] -> String
List.unlines ([String] -> String)
-> (Tree String -> [String]) -> Tree String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> [String]
draw
draw :: Tree.Tree String -> [String]
draw :: Tree String -> [String]
draw (Tree.Node String
x Forest String
ts0) = String -> [String]
List.lines String
x [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Forest String -> [String]
drawSubTrees Forest String
ts0
where
drawSubTrees :: Forest String -> [String]
drawSubTrees [] = []
drawSubTrees [Tree String
t] = String -> String -> [String] -> [String]
forall {c}. Semigroup c => c -> c -> [c] -> [c]
shift String
"" String
" " (Tree String -> [String]
draw Tree String
t)
drawSubTrees (Tree String
t:Forest String
ts) = String -> String -> [String] -> [String]
forall {c}. Semigroup c => c -> c -> [c] -> [c]
shift String
"" String
"| " (Tree String -> [String]
draw Tree String
t) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Forest String -> [String]
drawSubTrees Forest String
ts
shift :: c -> c -> [c] -> [c]
shift c
first c
other = (c -> c -> c) -> [c] -> [c] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith c -> c -> c
forall a. Semigroup a => a -> a -> a
(<>) (c
first c -> [c] -> [c]
forall a. a -> [a] -> [a]
: c -> [c]
forall a. a -> [a]
List.repeat c
other)
instance IsString (ViewMachine sN inp vs es a) where
fromString :: String -> ViewMachine sN inp vs es a
fromString String
s = (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String) -> ViewMachine sN inp vs es a)
-> (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node (String -> String
forall a. IsString a => String -> a
fromString String
s) [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: Forest String
is
instance Stackable (ViewMachine sN) where
push :: forall v inp (vs :: [*]) (es :: Peano) a.
TermInstr v
-> ViewMachine sN inp (v : vs) es a -> ViewMachine sN inp vs es a
push TermInstr v
a ViewMachine sN inp (v : vs) es a
k = (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String) -> ViewMachine sN inp vs es a)
-> (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd (String
"push "String -> String -> String
forall a. Semigroup a => a -> a -> a
<>Int -> TermInstr v -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
10 TermInstr v
a String
"") [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp (v : vs) es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (v : vs) es a
k Forest String
is
pop :: forall inp (vs :: [*]) (es :: Peano) a v.
ViewMachine sN inp vs es a -> ViewMachine sN inp (v : vs) es a
pop ViewMachine sN inp vs es a
k = (Forest String -> Forest String)
-> ViewMachine sN inp (v : vs) es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp (v : vs) es a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp (v : vs) es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd String
"pop" [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp vs es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp vs es a
k Forest String
is
liftI2 :: forall x y z inp (vs :: [*]) (es :: Peano) a.
TermInstr (x -> y -> z)
-> ViewMachine sN inp (z : vs) es a
-> ViewMachine sN inp (y : x : vs) es a
liftI2 TermInstr (x -> y -> z)
f ViewMachine sN inp (z : vs) es a
k = (Forest String -> Forest String)
-> ViewMachine sN inp (y : x : vs) es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp (y : x : vs) es a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp (y : x : vs) es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd (String
"lift "String -> String -> String
forall a. Semigroup a => a -> a -> a
<>Int -> TermInstr (x -> y -> z) -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
10 TermInstr (x -> y -> z)
f String
"") [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp (z : vs) es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (z : vs) es a
k Forest String
is
swap :: forall inp x y (vs :: [*]) (es :: Peano) a.
ViewMachine sN inp (x : y : vs) es a
-> ViewMachine sN inp (y : x : vs) es a
swap ViewMachine sN inp (x : y : vs) es a
k = (Forest String -> Forest String)
-> ViewMachine sN inp (y : x : vs) es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp (y : x : vs) es a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp (y : x : vs) es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd String
"swap" [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp (x : y : vs) es a
-> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (x : y : vs) es a
k Forest String
is
instance Branchable (ViewMachine sN) where
caseI :: forall inp x (vs :: [*]) (es :: Peano) r y.
ViewMachine sN inp (x : vs) es r
-> ViewMachine sN inp (y : vs) es r
-> ViewMachine sN inp (Either x y : vs) es r
caseI ViewMachine sN inp (x : vs) es r
l ViewMachine sN inp (y : vs) es r
r = (Forest String -> Forest String)
-> ViewMachine sN inp (Either x y : vs) es r
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp (Either x y : vs) es r)
-> (Forest String -> Forest String)
-> ViewMachine sN inp (Either x y : vs) es r
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd String
"case"
[ String -> Forest String -> Tree String
viewInstrArg String
"left" (ViewMachine sN inp (x : vs) es r -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (x : vs) es r
l [])
, String -> Forest String -> Tree String
viewInstrArg String
"right" (ViewMachine sN inp (y : vs) es r -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (y : vs) es r
r [])
] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: Forest String
is
choices :: forall v inp (vs :: [*]) (es :: Peano) a.
[TermInstr (v -> Bool)]
-> [ViewMachine sN inp vs es a]
-> ViewMachine sN inp vs es a
-> ViewMachine sN inp (v : vs) es a
choices [TermInstr (v -> Bool)]
ps [ViewMachine sN inp vs es a]
bs ViewMachine sN inp vs es a
d = (Forest String -> Forest String)
-> ViewMachine sN inp (v : vs) es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp (v : vs) es a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp (v : vs) es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is ->
String -> Forest String -> Tree String
viewInstrCmd (String
"choices "String -> String -> String
forall a. Semigroup a => a -> a -> a
<>[TermInstr (v -> Bool)] -> String
forall a. Show a => a -> String
show [TermInstr (v -> Bool)]
ps) (
(String -> Forest String -> Tree String
viewInstrArg String
"branch" (Forest String -> Tree String)
-> (ViewMachine sN inp vs es a -> Forest String)
-> ViewMachine sN inp vs es a
-> Tree String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Forest String -> Forest String) -> Forest String -> Forest String
forall a b. (a -> b) -> a -> b
$ []) ((Forest String -> Forest String) -> Forest String)
-> (ViewMachine sN inp vs es a -> Forest String -> Forest String)
-> ViewMachine sN inp vs es a
-> Forest String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewMachine sN inp vs es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine (ViewMachine sN inp vs es a -> Tree String)
-> [ViewMachine sN inp vs es a] -> Forest String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ViewMachine sN inp vs es a]
bs) Forest String -> Forest String -> Forest String
forall a. Semigroup a => a -> a -> a
<>
[ String -> Forest String -> Tree String
viewInstrArg String
"default" (ViewMachine sN inp vs es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp vs es a
d []) ]
) Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: Forest String
is
instance Failable (ViewMachine sN) where
fail :: forall inp (vs :: [*]) (es :: Peano) a.
[ErrorItem (InputToken inp)] -> ViewMachine sN inp vs ('Succ es) a
fail [ErrorItem (InputToken inp)]
_err = (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd String
"fail" [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: Forest String
is
popFail :: forall inp (vs :: [*]) (es :: Peano) a.
ViewMachine sN inp vs es a -> ViewMachine sN inp vs ('Succ es) a
popFail ViewMachine sN inp vs es a
k = (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd String
"popFail" [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp vs es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp vs es a
k Forest String
is
catchFail :: forall inp (vs :: [*]) (es :: Peano) a.
ViewMachine sN inp vs ('Succ es) a
-> ViewMachine sN inp (Cursor inp : vs) es a
-> ViewMachine sN inp vs es a
catchFail ViewMachine sN inp vs ('Succ es) a
t ViewMachine sN inp (Cursor inp : vs) es a
h = (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String) -> ViewMachine sN inp vs es a)
-> (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd String
"catchFail"
[ String -> Forest String -> Tree String
viewInstrArg String
"try" (ViewMachine sN inp vs ('Succ es) a
-> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp vs ('Succ es) a
t [])
, String -> Forest String -> Tree String
viewInstrArg String
"handler" (ViewMachine sN inp (Cursor inp : vs) es a
-> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (Cursor inp : vs) es a
h [])
] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: Forest String
is
instance Inputable (ViewMachine sN) where
loadInput :: forall inp (vs :: [*]) (es :: Peano) a.
ViewMachine sN inp vs es a
-> ViewMachine sN inp (Cursor inp : vs) es a
loadInput ViewMachine sN inp vs es a
k = (Forest String -> Forest String)
-> ViewMachine sN inp (Cursor inp : vs) es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp (Cursor inp : vs) es a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp (Cursor inp : vs) es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd String
"loadInput" [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp vs es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp vs es a
k Forest String
is
pushInput :: forall inp (vs :: [*]) (es :: Peano) a.
ViewMachine sN inp (Cursor inp : vs) es a
-> ViewMachine sN inp vs es a
pushInput ViewMachine sN inp (Cursor inp : vs) es a
k = (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String) -> ViewMachine sN inp vs es a)
-> (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd String
"pushInput" [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp (Cursor inp : vs) es a
-> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (Cursor inp : vs) es a
k Forest String
is
instance
ShowLetName sN TH.Name =>
Routinable (ViewMachine sN) where
subroutine :: forall v inp (vs :: [*]) (es :: Peano) a.
LetName v
-> ViewMachine sN inp '[] ('Succ 'Zero) v
-> ViewMachine sN inp vs ('Succ es) a
-> ViewMachine sN inp vs ('Succ es) a
subroutine (LetName Name
n) ViewMachine sN inp '[] ('Succ 'Zero) v
sub ViewMachine sN inp vs ('Succ es) a
k = (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall a b. (a -> b) -> a -> b
$ \Forest String
is ->
String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node (forall (showName :: Bool) letName.
ShowLetName showName letName =>
letName -> String
showLetName @sN Name
nString -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
":") (ViewMachine sN inp '[] ('Succ 'Zero) v
-> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp '[] ('Succ 'Zero) v
sub [])
Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp vs ('Succ es) a
-> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp vs ('Succ es) a
k Forest String
is
jump :: forall a inp (es :: Peano).
LetName a -> ViewMachine sN inp '[] ('Succ es) a
jump (LetName Name
n) = (Forest String -> Forest String)
-> ViewMachine sN inp '[] ('Succ es) a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp '[] ('Succ es) a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp '[] ('Succ es) a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd (String
"jump "String -> String -> String
forall a. Semigroup a => a -> a -> a
<>forall (showName :: Bool) letName.
ShowLetName showName letName =>
letName -> String
showLetName @sN Name
n) [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: Forest String
is
call :: forall v inp (vs :: [*]) (es :: Peano) a.
LetName v
-> ViewMachine sN inp (v : vs) ('Succ es) a
-> ViewMachine sN inp vs ('Succ es) a
call (LetName Name
n) ViewMachine sN inp (v : vs) ('Succ es) a
k = (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd (String
"call "String -> String -> String
forall a. Semigroup a => a -> a -> a
<>forall (showName :: Bool) letName.
ShowLetName showName letName =>
letName -> String
showLetName @sN Name
n) [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp (v : vs) ('Succ es) a
-> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (v : vs) ('Succ es) a
k Forest String
is
ret :: forall inp a (es :: Peano). ViewMachine sN inp '[a] es a
ret = (Forest String -> Forest String) -> ViewMachine sN inp '[a] es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String) -> ViewMachine sN inp '[a] es a)
-> (Forest String -> Forest String) -> ViewMachine sN inp '[a] es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd String
"ret" [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: Forest String
is
instance
ShowLetName sN TH.Name =>
Joinable (ViewMachine sN) where
defJoin :: forall v inp (vs :: [*]) (es :: Peano) a.
LetName v
-> ViewMachine sN inp (v : vs) es a
-> ViewMachine sN inp vs es a
-> ViewMachine sN inp vs es a
defJoin (LetName Name
n) ViewMachine sN inp (v : vs) es a
j ViewMachine sN inp vs es a
k = (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String) -> ViewMachine sN inp vs es a)
-> (Forest String -> Forest String) -> ViewMachine sN inp vs es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is ->
String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Tree.Node (forall (showName :: Bool) letName.
ShowLetName showName letName =>
letName -> String
showLetName @sN Name
nString -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
":") (ViewMachine sN inp (v : vs) es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (v : vs) es a
j [])
Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp vs es a -> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp vs es a
k Forest String
is
refJoin :: forall v inp (vs :: [*]) (es :: Peano) a.
LetName v -> ViewMachine sN inp (v : vs) es a
refJoin (LetName Name
n) = (Forest String -> Forest String)
-> ViewMachine sN inp (v : vs) es a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp (v : vs) es a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp (v : vs) es a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd (String
"refJoin "String -> String -> String
forall a. Semigroup a => a -> a -> a
<>forall (showName :: Bool) letName.
ShowLetName showName letName =>
letName -> String
showLetName @sN Name
n) [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: Forest String
is
instance Readable tok (ViewMachine sN) where
read :: forall inp (vs :: [*]) (es :: Peano) a.
(tok ~ InputToken inp) =>
[ErrorItem tok]
-> TermInstr (tok -> Bool)
-> ViewMachine sN inp (tok : vs) ('Succ es) a
-> ViewMachine sN inp vs ('Succ es) a
read [ErrorItem tok]
_es TermInstr (tok -> Bool)
p ViewMachine sN inp (tok : vs) ('Succ es) a
k = (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
(Forest String -> Forest String)
-> ViewMachine showName inp vs es a
ViewMachine ((Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a)
-> (Forest String -> Forest String)
-> ViewMachine sN inp vs ('Succ es) a
forall a b. (a -> b) -> a -> b
$ \Forest String
is -> String -> Forest String -> Tree String
viewInstrCmd (String
"read "String -> String -> String
forall a. Semigroup a => a -> a -> a
<>Int -> TermInstr (tok -> Bool) -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
10 TermInstr (tok -> Bool)
p String
"") [] Tree String -> Forest String -> Forest String
forall a. a -> [a] -> [a]
: ViewMachine sN inp (tok : vs) ('Succ es) a
-> Forest String -> Forest String
forall (showName :: Bool) inp (vs :: [*]) (es :: Peano) a.
ViewMachine showName inp vs es a -> Forest String -> Forest String
unViewMachine ViewMachine sN inp (tok : vs) ('Succ es) a
k Forest String
is