aboutsummaryrefslogtreecommitdiff
path: root/ABC/Machine
diff options
context:
space:
mode:
Diffstat (limited to 'ABC/Machine')
-rw-r--r--ABC/Machine/AStack.dcl18
-rw-r--r--ABC/Machine/AStack.icl42
-rw-r--r--ABC/Machine/BStack.dcl38
-rw-r--r--ABC/Machine/BStack.icl103
-rw-r--r--ABC/Machine/CStack.dcl15
-rw-r--r--ABC/Machine/CStack.icl26
-rw-r--r--ABC/Machine/Def.dcl31
-rw-r--r--ABC/Machine/Def.icl1
-rw-r--r--ABC/Machine/Driver.dcl7
-rw-r--r--ABC/Machine/Driver.icl25
-rw-r--r--ABC/Machine/GraphStore.dcl25
-rw-r--r--ABC/Machine/GraphStore.icl70
-rw-r--r--ABC/Machine/IO.dcl17
-rw-r--r--ABC/Machine/IO.icl29
-rw-r--r--ABC/Machine/Instructions.dcl64
-rw-r--r--ABC/Machine/Instructions.icl386
-rw-r--r--ABC/Machine/Nodes.dcl27
-rw-r--r--ABC/Machine/Nodes.icl77
-rw-r--r--ABC/Machine/Program.dcl13
-rw-r--r--ABC/Machine/Program.icl27
20 files changed, 1041 insertions, 0 deletions
diff --git a/ABC/Machine/AStack.dcl b/ABC/Machine/AStack.dcl
new file mode 100644
index 0000000..19156c7
--- /dev/null
+++ b/ABC/Machine/AStack.dcl
@@ -0,0 +1,18 @@
+definition module ABC.Machine.AStack
+
+from StdOverloaded import class toString
+from ABC.Machine.Def import ::NodeId, ::NrArgs
+
+:: ASrc :== Int
+:: ADst :== Int
+:: AStack (:== [NodeId])
+
+instance toString AStack
+
+as_get :: ASrc AStack -> NodeId
+as_init :: AStack
+as_popn :: NrArgs AStack -> AStack
+as_push :: NodeId AStack -> AStack
+as_pushn :: [NodeId] AStack -> AStack
+as_topn :: NrArgs AStack -> [NodeId]
+as_update :: ADst NodeId AStack -> AStack
diff --git a/ABC/Machine/AStack.icl b/ABC/Machine/AStack.icl
new file mode 100644
index 0000000..2dc46ec
--- /dev/null
+++ b/ABC/Machine/AStack.icl
@@ -0,0 +1,42 @@
+implementation module ABC.Machine.AStack
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+:: AStack :== [NodeId]
+
+instance toString AStack where toString xs = "[" <++ (",", xs) <+ "]"
+
+as_get :: ASrc AStack -> NodeId
+as_get _ [] = abortn "as_get: index too large"
+as_get 0 [n:_] = n
+as_get i [_:s] = as_get (i-1) s
+
+as_init :: AStack
+as_init = []
+
+as_popn :: NrArgs AStack -> AStack
+as_popn 0 s = s
+as_popn _ [] = abortn "as_popn: popping too many elements"
+as_popn i [_:s] = as_popn (i-1) s
+
+as_push :: NodeId AStack -> AStack
+as_push n s = [n:s]
+
+as_pushn :: [NodeId] AStack -> AStack
+as_pushn is s = is ++ s
+
+as_topn :: NrArgs AStack -> [NodeId]
+as_topn i s = topn [] i s
+where
+ topn :: [NodeId] NrArgs AStack -> [NodeId]
+ topn ns 0 _ = ns
+ topn _ i [] = abortn "as_topn: taking too many elements"
+ topn ns i [n:s] = topn (ns ++ [n]) (i-1) s
+
+as_update :: ADst NodeId AStack -> AStack
+as_update 0 n [_:s] = [n:s]
+as_update _ _ [] = abortn "as_update: index too large"
+as_update i n [m:s] = [m:as_update (i-1) n s]
diff --git a/ABC/Machine/BStack.dcl b/ABC/Machine/BStack.dcl
new file mode 100644
index 0000000..488ed75
--- /dev/null
+++ b/ABC/Machine/BStack.dcl
@@ -0,0 +1,38 @@
+definition module ABC.Machine.BStack
+
+from StdOverloaded import class ==, class toString
+from ABC.Machine.Def import ::NrArgs
+
+:: Basic = Int Int
+ | Bool Bool
+
+instance == Basic
+instance toString Basic
+
+:: BSrc :== Int
+:: BDst :== Int
+:: BStack (:== [Basic])
+
+instance toString BStack
+
+bs_copy :: BSrc BStack -> BStack
+bs_get :: BSrc BStack -> Basic
+bs_getB :: BSrc BStack -> Bool
+bs_getI :: BSrc BStack -> Int
+bs_init :: BStack
+bs_popn :: NrArgs BStack -> BStack
+bs_push :: Basic BStack -> BStack
+bs_pushB :: Bool BStack -> BStack
+bs_pushI :: Int BStack -> BStack
+bs_update :: BDst Basic BStack -> BStack
+bs_addI :: BStack -> BStack
+bs_decI :: BStack -> BStack
+bs_incI :: BStack -> BStack
+bs_eqB :: BStack -> BStack
+bs_eqI :: BStack -> BStack
+bs_eqBi :: Bool BSrc BStack -> BStack
+bs_eqIi :: Int BSrc BStack -> BStack
+bs_gtI :: BStack -> BStack
+bs_ltI :: BStack -> BStack
+bs_mulI :: BStack -> BStack
+bs_subI :: BStack -> BStack
diff --git a/ABC/Machine/BStack.icl b/ABC/Machine/BStack.icl
new file mode 100644
index 0000000..624692e
--- /dev/null
+++ b/ABC/Machine/BStack.icl
@@ -0,0 +1,103 @@
+implementation module ABC.Machine.BStack
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+instance == Basic
+where
+ (==) (Bool b) (Bool c) = b == c
+ (==) (Int m) (Int n) = m == n
+ (==) _ _ = False
+
+instance toString Basic
+where
+ toString (Bool b) = toString b
+ toString (Int i) = toString i
+
+:: BStack :== [Basic]
+
+instance toString BStack where toString xs = "[" <++ (",", xs) <+ "]"
+
+bs_copy :: BSrc BStack -> BStack
+bs_copy i s = [bs_get i s:s]
+
+bs_get :: BSrc BStack -> Basic
+bs_get _ [] = abortn "bs_get: index too large"
+bs_get 0 [b:s] = b
+bs_get i [_:s] = bs_get (i-1) s
+
+bs_getB :: BSrc BStack -> Bool
+bs_getB i s = case bs_get i s of
+ (Bool b) = b
+ _ = abortn "bs_getB on non-Bool value\n"
+
+bs_getI :: BSrc BStack -> Int
+bs_getI i s = case bs_get i s of
+ (Int i) = i
+ _ = abortn "bs_getI on non-Int value\n"
+
+bs_init :: BStack
+bs_init = []
+
+bs_popn :: NrArgs BStack -> BStack
+bs_popn 0 s = s
+bs_popn _ [] = abortn "bs_popn: popping too many elements"
+bs_popn i [_:s] = bs_popn (i-1) s
+
+bs_push :: Basic BStack -> BStack
+bs_push d s = [d:s]
+
+bs_pushB :: Bool BStack -> BStack
+bs_pushB b s = [Bool b:s]
+
+bs_pushI :: Int BStack -> BStack
+bs_pushI i s = [Int i:s]
+
+bs_update :: BDst Basic BStack -> BStack
+bs_update 0 d [_:s] = [d:s]
+bs_update _ _ [] = abortn "bs_update: index too large"
+bs_update i d [e:s] = [e:bs_update (i-1) d s]
+
+bs_addI :: BStack -> BStack
+bs_addI [Int m:Int n:s] = bs_pushI (m+n) s
+bs_addI _ = abortn "bs_addI: no integers"
+
+bs_decI :: BStack -> BStack
+bs_decI [Int n:s] = bs_pushI (n-1) s
+bs_decI _ = abortn "bs_decI: no integer"
+
+bs_incI :: BStack -> BStack
+bs_incI [Int n:s] = bs_pushI (n+1) s
+bs_incI _ = abortn "bs_incI: no integer"
+
+bs_eqB :: BStack -> BStack
+bs_eqB [Bool b:Bool c:s] = bs_pushB (b == c) s
+bs_eqB _ = abortn "bs_eqB: no booleans"
+
+bs_eqI :: BStack -> BStack
+bs_eqI [Int m:Int n:s] = bs_pushB (m == n) s
+bs_eqI _ = abortn "bs_eqI: no integers"
+
+bs_eqBi :: Bool BSrc BStack -> BStack
+bs_eqBi b i s = bs_pushB (bs_getB i s == b) s
+
+bs_eqIi :: Int BSrc BStack -> BStack
+bs_eqIi n i s = bs_pushB (bs_getI i s == n) s
+
+bs_gtI :: BStack -> BStack
+bs_gtI [Int m:Int n:s] = bs_pushB (m > n) s
+bs_gtI _ = abortn "bs_gtI: no integers"
+
+bs_ltI :: BStack -> BStack
+bs_ltI [Int m:Int n:s] = bs_pushB (m < n) s
+bs_ltI _ = abortn "bs_ltI: no integers"
+
+bs_mulI :: BStack -> BStack
+bs_mulI [Int m:Int n:s] = bs_pushI (m * n) s
+bs_mulI _ = abortn "bs_mulI: no integers"
+
+bs_subI :: BStack -> BStack
+bs_subI [Int m:Int n:s] = bs_pushI (m - n) s
+bs_subI _ = abortn "bs_subI: no integers"
diff --git a/ABC/Machine/CStack.dcl b/ABC/Machine/CStack.dcl
new file mode 100644
index 0000000..cab2466
--- /dev/null
+++ b/ABC/Machine/CStack.dcl
@@ -0,0 +1,15 @@
+definition module ABC.Machine.CStack
+
+from StdOverloaded import class toString
+from ABC.Machine.Def import ::InstrId
+
+:: CSrc :== Int
+:: CDst :== Int
+:: CStack (:== [InstrId])
+
+instance toString CStack
+
+cs_init :: CStack
+cs_get :: CSrc CStack -> InstrId
+cs_popn :: CSrc CStack -> CStack
+cs_push :: InstrId CStack -> CStack
diff --git a/ABC/Machine/CStack.icl b/ABC/Machine/CStack.icl
new file mode 100644
index 0000000..51c1562
--- /dev/null
+++ b/ABC/Machine/CStack.icl
@@ -0,0 +1,26 @@
+implementation module ABC.Machine.CStack
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+:: CStack :== [InstrId]
+
+instance toString CStack where toString xs = "[" <++ (",", xs) <+ "]"
+
+cs_init :: CStack
+cs_init = []
+
+cs_get :: CSrc CStack -> InstrId
+cs_get _ [] = abortn "cs_get: index too large"
+cs_get 0 [i:_] = i
+cs_get i [_:s] = cs_get (i-1) s
+
+cs_popn :: CSrc CStack -> CStack
+cs_popn 0 s = s
+cs_popn _ [] = abortn "cs_popn: popping too many elements"
+cs_popn i [_:s] = cs_popn (i-1) s
+
+cs_push :: InstrId CStack -> CStack
+cs_push i s = [i:s]
diff --git a/ABC/Machine/Def.dcl b/ABC/Machine/Def.dcl
new file mode 100644
index 0000000..ba36fb6
--- /dev/null
+++ b/ABC/Machine/Def.dcl
@@ -0,0 +1,31 @@
+definition module ABC.Machine.Def
+
+from ABC.Machine.AStack import ::AStack
+from ABC.Machine.BStack import ::BStack
+from ABC.Machine.CStack import ::CStack
+from ABC.Machine.GraphStore import ::GraphStore, ::DescStore
+from ABC.Machine.Program import ::ProgramStore
+from ABC.Machine.IO import ::IO
+
+:: State = { astack :: AStack
+ , bstack :: BStack
+ , cstack :: CStack
+ , graphstore :: GraphStore
+ , descstore :: DescStore
+ , pc :: InstrId
+ , program :: ProgramStore
+ , io :: IO
+ }
+
+:: NodeId :== Int
+:: NrArgs :== Int
+:: ArgNr :== Int
+:: DescId :== Int
+:: InstrId :== Int
+:: Name :== String
+:: Arity :== Int
+
+:: Instruction :== State -> State
+
+:: APEntry :== InstrId
+:: Args :== [NodeId]
diff --git a/ABC/Machine/Def.icl b/ABC/Machine/Def.icl
new file mode 100644
index 0000000..4d22f22
--- /dev/null
+++ b/ABC/Machine/Def.icl
@@ -0,0 +1 @@
+implementation module ABC.Machine.Def
diff --git a/ABC/Machine/Driver.dcl b/ABC/Machine/Driver.dcl
new file mode 100644
index 0000000..5beebe5
--- /dev/null
+++ b/ABC/Machine/Driver.dcl
@@ -0,0 +1,7 @@
+definition module ABC.Machine.Driver
+
+from ABC.Machine.Def import ::State, ::Instruction
+from ABC.Machine.GraphStore import ::Desc
+
+boot :: ([Instruction], [Desc]) -> State
+fetch_cycle :: State -> State
diff --git a/ABC/Machine/Driver.icl b/ABC/Machine/Driver.icl
new file mode 100644
index 0000000..29b42ca
--- /dev/null
+++ b/ABC/Machine/Driver.icl
@@ -0,0 +1,25 @@
+implementation module ABC.Machine.Driver
+
+import StdEnv
+
+import ABC.Machine
+
+boot :: ([Instruction], [Desc]) -> State
+boot (prog,descs)
+ = { astack = as_init
+ , bstack = bs_init
+ , cstack = cs_init
+ , graphstore = gs_init
+ , descstore = ds_init descs
+ , pc = pc_init
+ , program = ps_init prog
+ , io = io_init
+ }
+
+fetch_cycle :: State -> State
+fetch_cycle st=:{pc,program}
+| pc_end pc = st
+| otherwise = fetch_cycle (currinstr {st & pc=pc`})
+where
+ pc` = pc_next pc
+ currinstr = ps_get pc program
diff --git a/ABC/Machine/GraphStore.dcl b/ABC/Machine/GraphStore.dcl
new file mode 100644
index 0000000..da96156
--- /dev/null
+++ b/ABC/Machine/GraphStore.dcl
@@ -0,0 +1,25 @@
+definition module ABC.Machine.GraphStore
+
+from StdOverloaded import class toString
+from ABC.Machine.Def import ::Arity, ::InstrId, ::Name, ::APEntry, ::DescId, ::NodeId
+from ABC.Machine.Nodes import ::Node
+
+:: Desc = Desc APEntry Arity Name
+
+d_ap_entry :: Desc -> InstrId
+d_arity :: Desc -> Arity
+d_name :: Desc -> String
+
+:: DescStore (:== [Desc])
+
+ds_get :: DescId DescStore -> Desc
+ds_init :: [Desc] -> DescStore
+
+:: GraphStore
+
+show_graphstore :: GraphStore DescStore -> String
+
+gs_get :: NodeId GraphStore -> Node
+gs_init :: GraphStore
+gs_newnode :: GraphStore -> (GraphStore, NodeId)
+gs_update :: NodeId (Node -> Node) GraphStore -> GraphStore
diff --git a/ABC/Machine/GraphStore.icl b/ABC/Machine/GraphStore.icl
new file mode 100644
index 0000000..b7aa32e
--- /dev/null
+++ b/ABC/Machine/GraphStore.icl
@@ -0,0 +1,70 @@
+implementation module ABC.Machine.GraphStore
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+STORE_SIZE :== 1000
+
+d_ap_entry :: Desc -> InstrId
+d_ap_entry (Desc e _ _) = e
+
+d_arity :: Desc -> Arity
+d_arity (Desc _ a _) = a
+
+d_name :: Desc -> String
+d_name (Desc _ _ n) = n
+
+:: DescStore :== [Desc]
+
+ds_get :: DescId DescStore -> Desc
+ds_get 0 [d:_] = d
+ds_get _ [] = abortn "ds_get: index too large"
+ds_get i [_:s] = ds_get (i-1) s
+
+ds_init :: [Desc] -> DescStore
+ds_init ds = ds
+
+:: GraphStore = { nodes :: [Node]
+ , free :: Int
+ }
+
+show_graphstore :: GraphStore DescStore -> String
+show_graphstore {nodes,free} ds = show_nds (free+1) nodes ds
+where
+ show_nds :: Int [Node] [Desc] -> String
+ show_nds i [] ds = ""
+ show_nds i [n:ns] ds
+ = " " <+ i <+ " : " <+ show_nd n ds <+ "\n" <+ show_nds (i+1) ns ds
+
+ show_nd :: Node [Desc] -> String
+ show_nd (Basic _ e b) _ = e <+ " " <+ b
+ show_nd (Node d e a) ds = d_name (ds_get d ds) <+ " " <+ e <+ " [" <++ (",", a) <+ "]"
+ show_nd Empty _ = "Empty"
+
+gs_get :: NodeId GraphStore -> Node
+gs_get i {nodes,free} = get (i-free-1) nodes
+where
+ get :: NodeId [Node] -> Node
+ get 0 [n:_] = n
+ get _ [] = abortn ("gs_get: index " <+ i <+ " too large for " <+ length nodes <+ " node(s)")
+ get i [_:s] = get (i-1) s
+
+gs_init :: GraphStore
+gs_init = {nodes=[], free=STORE_SIZE}
+
+gs_newnode :: GraphStore -> (GraphStore, NodeId)
+gs_newnode {free=0} = abortn "gs_newnode: graph store is full"
+gs_newnode {nodes,free} = ({nodes=[Empty:nodes], free=free-1}, free)
+
+gs_update :: NodeId (Node -> Node) GraphStore -> GraphStore
+gs_update i f gs=:{nodes,free}
+| place <= STORE_SIZE-free = {gs & nodes=update place nodes f}
+| otherwise = abortn "gs_update: nodeid nonexistant"
+where
+ place = i - free - 1
+
+ update :: Int [Node] (Node -> Node) -> [Node]
+ update 0 [n:s] f = [f n:s]
+ update i [n:s] f = [n:update (i-1) s f]
diff --git a/ABC/Machine/IO.dcl b/ABC/Machine/IO.dcl
new file mode 100644
index 0000000..a9b1c5b
--- /dev/null
+++ b/ABC/Machine/IO.dcl
@@ -0,0 +1,17 @@
+definition module ABC.Machine.IO
+
+from StdOverloaded import class toString
+
+from ABC.Machine.Nodes import ::Node
+from ABC.Machine.GraphStore import ::Desc
+from ABC.Machine.Def import ::State
+
+:: IO (:== [Char])
+
+instance toString IO
+
+io_init :: IO
+io_print :: a IO -> IO | toString a
+
+show_node :: Node Desc -> String
+instance toString State
diff --git a/ABC/Machine/IO.icl b/ABC/Machine/IO.icl
new file mode 100644
index 0000000..aac5ba7
--- /dev/null
+++ b/ABC/Machine/IO.icl
@@ -0,0 +1,29 @@
+implementation module ABC.Machine.IO
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+:: IO :== [Char]
+
+instance toString IO where toString io = {c \\ c <- io}
+
+io_init :: IO
+io_init = []
+
+io_print :: a IO -> IO | toString a
+io_print x io = io ++ fromString (toString x)
+
+show_node :: Node Desc -> String
+show_node (Basic _ _ b) _ = toString b
+show_node (Node _ _ _) (Desc _ _ n) = n
+
+instance toString State
+where
+ toString {astack,bstack,cstack,graphstore,descstore,pc,program,io}
+ = "pc : " <+ pc <+ "\n" <+
+ "A-stack : " <+ astack <+ "\n" <+
+ "B-stack : " <+ bstack <+ "\n" <+
+ "C-stack : " <+ cstack <+ "\n" <+
+ "Graph :\n" <+ show_graphstore graphstore descstore
diff --git a/ABC/Machine/Instructions.dcl b/ABC/Machine/Instructions.dcl
new file mode 100644
index 0000000..6c3c8b8
--- /dev/null
+++ b/ABC/Machine/Instructions.dcl
@@ -0,0 +1,64 @@
+definition module ABC.Machine.Instructions
+
+from ABC.Machine.Def import ::NrArgs, ::State, ::DescId, ::Arity, ::InstrId, ::ArgNr
+from ABC.Machine.AStack import ::ASrc, ::ADst
+from ABC.Machine.BStack import ::BSrc, ::BDst
+
+add_args :: ASrc NrArgs ADst State -> State
+create :: State -> State
+del_args :: ASrc NrArgs ADst State -> State
+dump :: String State -> State
+eq_desc :: DescId ASrc State -> State
+eq_desc_arity :: DescId Arity ASrc State -> State
+eq_symbol :: ASrc ASrc State -> State
+eqB :: State -> State
+eqB_a :: Bool ASrc State -> State
+eqB_b :: Bool BSrc State -> State
+eqI :: State -> State
+eqI_a :: Int ASrc State -> State
+eqI_b :: Int BSrc State -> State
+fill :: DescId NrArgs InstrId ADst State -> State
+fill_a :: ASrc ADst State -> State
+fillB :: Bool ADst State -> State
+fillB_b :: BSrc ADst State -> State
+fillI :: Int ADst State -> State
+fillI_b :: BSrc ADst State -> State
+get_desc_arity :: ASrc State -> State
+get_node_arity :: ASrc State -> State
+halt :: State -> State
+jmp :: InstrId State -> State
+jmp_eval :: State -> State
+jmp_false :: InstrId State -> State
+jmp_true :: InstrId State -> State
+jsr :: InstrId State -> State
+jsr_eval :: State -> State
+no_op :: State -> State
+pop_a :: NrArgs State -> State
+pop_b :: NrArgs State -> State
+print :: String State -> State
+print_symbol :: ASrc State -> State
+push_a :: ASrc State -> State
+push_ap_entry :: ASrc State -> State
+push_arg :: ASrc Arity ArgNr State -> State
+push_arg_b :: ASrc State -> State
+push_args :: ASrc Arity NrArgs State -> State
+push_args_b :: ASrc State -> State
+push_b :: BSrc State -> State
+pushB :: Bool State -> State
+pushB_a :: ASrc State -> State
+pushI :: Int State -> State
+pushI_a :: ASrc State -> State
+repl_args :: Arity NrArgs State -> State
+repl_args_b :: State -> State
+rtn :: State -> State
+set_entry :: InstrId ADst State -> State
+update_a :: ASrc ADst State -> State
+update_b :: BSrc BDst State -> State
+
+addI :: State -> State
+decI :: State -> State
+gtI :: State -> State
+incI :: State -> State
+ltI :: State -> State
+mulI :: State -> State
+subI :: State -> State
diff --git a/ABC/Machine/Instructions.icl b/ABC/Machine/Instructions.icl
new file mode 100644
index 0000000..911b999
--- /dev/null
+++ b/ABC/Machine/Instructions.icl
@@ -0,0 +1,386 @@
+implementation module ABC.Machine.Instructions
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+int_desc :== 0
+bool_desc :== 1
+rnf_entry :== 1
+
+add_args :: ASrc NrArgs ADst State -> State
+add_args a_src nr_args a_dst st=:{astack,graphstore}
+ = {st & astack=astack`, graphstore=graphstore`}
+where
+ astack` = as_popn nr_args astack
+ graphstore` = gs_update dstid (n_fill descid entry newargs) graphstore
+ dstid = as_get a_dst astack
+ srcid = as_get a_src astack
+ node = gs_get srcid graphstore
+ descid = n_descid node
+ entry = n_entry node
+ arity = n_arity node
+ newargs = n_args node arity ++ as_topn nr_args astack
+
+create :: State -> State
+create st=:{astack,graphstore}
+ = {st & astack=astack`, graphstore=graphstore`}
+where
+ astack` = as_push nodeid astack
+ (graphstore`,nodeid) = gs_newnode graphstore
+
+del_args :: ASrc NrArgs ADst State -> State
+del_args a_src nr_args a_dst st=:{astack,graphstore}
+ = {st & astack=astack`, graphstore=graphstore`}
+where
+ astack` = as_pushn newargs astack
+ graphstore` = gs_update dstid (n_fill descid entry newargs) graphstore
+ dstid = as_get a_dst astack
+ srcid = as_get a_src astack
+ node = gs_get srcid graphstore
+ descid = n_descid node
+ entry = n_entry node
+ newargs = n_nargs node (arity - nr_args) arity
+ arity = n_arity node
+
+dump :: String State -> State
+dump s st=:{io}
+ = {st & io=io_print ("\n" <+ s <+ "\n" <+ st) io}
+
+eq_desc :: DescId ASrc State -> State
+eq_desc descid a_src st=:{astack,bstack,graphstore}
+ = {st & bstack=bstack`}
+where
+ bstack` = bs_pushB equal bstack
+ equal = n_eq_descid node descid
+ node = gs_get nodeid graphstore
+ nodeid = as_get a_src astack
+
+eq_desc_arity :: DescId Arity ASrc State -> State
+eq_desc_arity descid arity a_src st=:{astack,bstack,graphstore}
+ = {st & bstack=bstack`}
+where
+ bstack` = bs_pushB equal bstack
+ equal = n_eq_descid node descid && n_eq_arity node arity
+ node = gs_get nodeid graphstore
+ nodeid = as_get a_src astack
+
+eq_symbol :: ASrc ASrc State -> State
+eq_symbol a_src1 a_src2 st=:{astack,bstack,graphstore}
+ = {st & bstack=bstack`}
+where
+ bstack` = bs_pushB equal bstack
+ equal = n_eq_symbol node1 node2
+ (node1, node2) = (gs_get id1 graphstore, gs_get id2 graphstore)
+ (id1, id2) = (as_get a_src1 astack, as_get a_src2 astack)
+
+eqB :: State -> State
+eqB st=:{bstack}
+ = {st & bstack=bs_eqB bstack}
+
+eqB_a :: Bool ASrc State -> State
+eqB_a b a_src st=:{astack,bstack,graphstore}
+ = {st & bstack=bstack`}
+where
+ bstack` = bs_pushB equal bstack
+ equal = n_eq_B (gs_get nodeid graphstore) b
+ nodeid = as_get a_src astack
+
+eqB_b :: Bool BSrc State -> State
+eqB_b b b_src st=:{bstack}
+ = {st & bstack=bs_eqBi b b_src bstack}
+
+eqI :: State -> State
+eqI st=:{bstack}
+ = {st & bstack=bs_eqI bstack}
+
+eqI_a :: Int ASrc State -> State
+eqI_a i a_src st=:{astack,bstack,graphstore}
+ = {st & bstack=bstack`}
+where
+ bstack` = bs_pushB equal bstack
+ equal = n_eq_I (gs_get nodeid graphstore) i
+ nodeid = as_get a_src astack
+
+eqI_b :: Int BSrc State -> State
+eqI_b i b_src st=:{bstack}
+ = {st & bstack=bs_eqIi i b_src bstack}
+
+fill :: DescId NrArgs InstrId ADst State -> State
+fill desc nr_args entry a_dst st=:{astack,graphstore}
+ = {st & astack=astack`, graphstore=graphstore`}
+where
+ astack` = as_popn nr_args astack
+ graphstore` = gs_update nodeid (n_fill desc entry args) graphstore
+ nodeid = as_get a_dst astack
+ args = as_topn nr_args astack
+
+fill_a :: ASrc ADst State -> State
+fill_a a_src a_dst st=:{astack,graphstore}
+ = {st & graphstore=graphstore`}
+where
+ graphstore` = gs_update nodeid_dst (n_copy node_src) graphstore
+ node_src = gs_get nodeid_src graphstore
+ nodeid_dst = as_get a_dst astack
+ nodeid_src = as_get a_src astack
+
+fillB :: Bool ADst State -> State
+fillB b a_dst st=:{astack,graphstore}
+ = {st & graphstore=graphstore`}
+where
+ graphstore` = gs_update nodeid (n_fillB bool_desc rnf_entry b) graphstore
+ nodeid = as_get a_dst astack
+
+fillB_b :: BSrc ADst State -> State
+fillB_b b_src a_dst st=:{astack,bstack,graphstore}
+ = {st & graphstore=graphstore`}
+where
+ graphstore` = gs_update nodeid (n_fillB bool_desc rnf_entry b) graphstore
+ b = bs_getB b_src bstack
+ nodeid = as_get a_dst astack
+
+fillI :: Int ADst State -> State
+fillI i a_dst st=:{astack,graphstore}
+ = {st & graphstore=graphstore`}
+where
+ graphstore` = gs_update nodeid (n_fillI int_desc rnf_entry i) graphstore
+ nodeid = as_get a_dst astack
+
+fillI_b :: BSrc ADst State -> State
+fillI_b b_src a_dst st=:{astack,bstack,graphstore}
+ = {st & graphstore=graphstore`}
+where
+ graphstore` = gs_update nodeid (n_fillI int_desc rnf_entry i) graphstore
+ i = bs_getI b_src bstack
+ nodeid = as_get a_dst astack
+
+get_desc_arity :: ASrc State -> State
+get_desc_arity a_src st=:{astack,bstack,descstore,graphstore}
+ = {st & bstack=bstack`}
+where
+ bstack` = bs_pushI arity bstack
+ arity = d_arity (ds_get descid descstore)
+ descid = n_descid (gs_get nodeid graphstore)
+ nodeid = as_get a_src astack
+
+get_node_arity :: ASrc State -> State
+get_node_arity a_src st=:{astack,bstack,graphstore}
+ = {st & bstack=bstack`}
+where
+ bstack` = bs_pushI arity bstack
+ arity = n_arity (gs_get nodeid graphstore)
+ nodeid = as_get a_src astack
+
+halt :: State -> State
+halt st=:{pc}
+ = {st & pc=pc_halt pc}
+
+jmp :: InstrId State -> State
+jmp addr st
+ = {st & pc=addr}
+
+jmp_eval :: State -> State
+jmp_eval st=:{astack,graphstore}
+ = {st & pc=pc`}
+where
+ pc` = n_entry (gs_get nodeid graphstore)
+ nodeid = as_get 0 astack
+
+jmp_false :: InstrId State -> State
+jmp_false addr st=:{bstack,pc}
+ = {st & bstack=bstack`, pc=pc`}
+where
+ pc` = if (not b) addr pc
+ b = bs_getB 0 bstack
+ bstack` = bs_popn 1 bstack
+
+jmp_true :: InstrId State -> State
+jmp_true addr st=:{bstack,pc}
+ = {st & bstack=bstack`, pc=pc`}
+where
+ pc` = if b addr pc
+ b = bs_getB 0 bstack
+ bstack` = bs_popn 1 bstack
+
+jsr :: InstrId State -> State
+jsr addr st=:{cstack,pc}
+ = {st & cstack=cstack`, pc=pc`}
+where
+ pc` = addr
+ cstack` = cs_push pc cstack
+
+jsr_eval :: State -> State
+jsr_eval st=:{astack,cstack,graphstore,pc}
+ = {st & cstack=cstack`, pc=pc`}
+where
+ pc` = n_entry (gs_get nodeid graphstore)
+ nodeid = as_get 0 astack
+ cstack` = cs_push pc cstack
+
+no_op :: State -> State
+no_op st = st
+
+pop_a :: NrArgs State -> State
+pop_a n st=:{astack}
+ = {st & astack=as_popn n astack}
+
+pop_b :: NrArgs State -> State
+pop_b n st=:{bstack}
+ = {st & bstack=bs_popn n bstack}
+
+print :: String State -> State
+print s st=:{io}
+ = {st & io=io_print s io}
+
+print_symbol :: ASrc State -> State
+print_symbol a_src st=:{astack,descstore,graphstore,io}
+ = {st & io=io`}
+where
+ io` = io_print string io
+ string = show_node node desc
+ desc = ds_get (n_descid node) descstore
+ node = gs_get nodeid graphstore
+ nodeid = as_get a_src astack
+
+push_a :: ASrc State -> State
+push_a a_src st=:{astack}
+ = {st & astack=as_push (as_get a_src astack) astack}
+
+push_ap_entry :: ASrc State -> State
+push_ap_entry a_src st=:{astack,cstack,descstore,graphstore}
+ = {st & cstack=cstack`}
+where
+ cstack` = cs_push (d_ap_entry (ds_get descid descstore)) cstack
+ descid = n_descid (gs_get nodeid graphstore)
+ nodeid = as_get a_src astack
+
+push_arg :: ASrc Arity ArgNr State -> State
+push_arg a_src arity arg_nr st=:{astack,graphstore}
+ = {st & astack=astack`}
+where
+ astack` = as_push arg astack
+ arg = n_arg (gs_get nodeid graphstore) arg_nr arity
+ nodeid = as_get a_src astack
+
+push_arg_b :: ASrc State -> State
+push_arg_b a_src st=:{astack,bstack,graphstore}
+ = {st & astack=astack`}
+where
+ astack` = as_push arg astack
+ arg = n_arg (gs_get nodeid graphstore) arg_nr arity
+ nodeid = as_get a_src astack
+ arg_nr = bs_getI 0 bstack
+ arity = bs_getI 1 bstack
+
+push_args :: ASrc Arity NrArgs State -> State
+push_args a_src arity nr_args st=:{astack,graphstore}
+ = {st & astack=astack`}
+where
+ astack` = as_pushn args astack
+ args = n_nargs (gs_get nodeid graphstore) nr_args arity
+ nodeid = as_get a_src astack
+
+push_args_b :: ASrc State -> State
+push_args_b a_src st=:{astack,bstack,graphstore}
+ = {st & astack=astack`}
+where
+ astack` = as_pushn args astack
+ args = n_nargs (gs_get nodeid graphstore) nargs arity
+ nargs = bs_getI 0 bstack
+ nodeid = as_get a_src astack
+ arity = bs_getI 1 bstack
+
+push_b :: BSrc State -> State
+push_b b_src st=:{bstack}
+ = {st & bstack=bs_push (bs_get b_src bstack) bstack}
+
+pushB :: Bool State -> State
+pushB b st=:{bstack}
+ = {st & bstack=bs_pushB b bstack}
+
+pushB_a :: ASrc State -> State
+pushB_a a_src st=:{astack,bstack,graphstore}
+ = {st & bstack=bstack`}
+where
+ bstack` = bs_pushB b bstack
+ b = n_B (gs_get nodeid graphstore)
+ nodeid = as_get a_src astack
+
+pushI :: Int State -> State
+pushI i st=:{bstack}
+ = {st & bstack=bs_pushI i bstack}
+
+pushI_a :: ASrc State -> State
+pushI_a a_src st=:{astack,bstack,graphstore}
+ = {st & bstack=bstack`}
+where
+ bstack` = bs_pushI i bstack
+ i = n_I (gs_get nodeid graphstore)
+ nodeid = as_get a_src astack
+
+repl_args :: Arity NrArgs State -> State
+repl_args arity nr_args st=:{astack,graphstore}
+ = {st & astack=astack`}
+where
+ astack` = as_pushn args (as_popn 1 astack)
+ args = n_nargs (gs_get nodeid graphstore) nr_args arity
+ nodeid = as_get 0 astack
+
+repl_args_b :: State -> State
+repl_args_b st=:{astack,bstack,graphstore}
+ = {st & astack=astack`}
+where
+ astack` = as_pushn args (as_popn 1 astack)
+ args = n_nargs (gs_get nodeid graphstore) nr_args arity
+ nodeid = as_get 0 astack
+ arity = bs_getI 0 bstack
+ nr_args = bs_getI 1 bstack
+
+rtn :: State -> State
+rtn st=:{cstack}
+ = {st & cstack=cs_popn 1 cstack, pc=cs_get 0 cstack}
+
+set_entry :: InstrId ADst State -> State
+set_entry entry a_dst st=:{astack,graphstore}
+ = {st & graphstore=graphstore`}
+where
+ graphstore` = gs_update nodeid (n_setentry entry) graphstore
+ nodeid = as_get a_dst astack
+
+update_a :: ASrc ADst State -> State
+update_a a_src a_dst st=:{astack}
+ = {st & astack=as_update a_dst (as_get a_src astack) astack}
+
+update_b :: BSrc BDst State -> State
+update_b b_src b_dst st=:{bstack}
+ = {st & bstack=bs_update b_dst (bs_get b_src bstack) bstack}
+
+
+addI :: State -> State
+addI st=:{bstack}
+ = {st & bstack=bs_addI bstack}
+
+decI :: State -> State
+decI st=:{bstack}
+ = {st & bstack=bs_decI bstack}
+
+gtI :: State -> State
+gtI st=:{bstack}
+ = {st & bstack=bs_gtI bstack}
+
+incI :: State -> State
+incI st=:{bstack}
+ = {st & bstack=bs_incI bstack}
+
+ltI :: State -> State
+ltI st=:{bstack}
+ = {st & bstack=bs_ltI bstack}
+
+mulI :: State -> State
+mulI st=:{bstack}
+ = {st & bstack=bs_mulI bstack}
+
+subI :: State -> State
+subI st=:{bstack}
+ = {st & bstack=bs_subI bstack}
diff --git a/ABC/Machine/Nodes.dcl b/ABC/Machine/Nodes.dcl
new file mode 100644
index 0000000..b9ba996
--- /dev/null
+++ b/ABC/Machine/Nodes.dcl
@@ -0,0 +1,27 @@
+definition module ABC.Machine.Nodes
+
+from ABC.Machine.Def import ::ArgNr, ::Arity, ::NodeId, ::InstrId, ::Args, ::DescId, ::NrArgs
+from ABC.Machine.BStack import ::Basic
+
+:: Node = Node DescId InstrId Args
+ | Basic DescId InstrId Basic
+ | Empty
+
+n_arg :: Node ArgNr Arity -> NodeId
+n_args :: Node Arity -> [NodeId]
+n_arity :: Node -> Arity
+n_B :: Node -> Bool
+n_I :: Node -> Int
+n_copy :: Node Node -> Node
+n_descid :: Node -> DescId
+n_entry :: Node -> InstrId
+n_eq_arity :: Node Arity -> Bool
+n_eq_B :: Node Bool -> Bool
+n_eq_descid :: Node DescId -> Bool
+n_eq_I :: Node Int -> Bool
+n_eq_symbol :: Node Node -> Bool
+n_fill :: DescId InstrId Args Node -> Node
+n_fillB :: DescId InstrId Bool Node -> Node
+n_fillI :: DescId InstrId Int Node -> Node
+n_nargs :: Node NrArgs Arity -> [NodeId]
+n_setentry :: InstrId Node -> Node
diff --git a/ABC/Machine/Nodes.icl b/ABC/Machine/Nodes.icl
new file mode 100644
index 0000000..d224fd8
--- /dev/null
+++ b/ABC/Machine/Nodes.icl
@@ -0,0 +1,77 @@
+implementation module ABC.Machine.Nodes
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+n_arg :: Node ArgNr Arity -> NodeId
+n_arg n i a
+| a >= i = (n_args n a)!!i
+| otherwise = abortn "n_arg: index greater than arity"
+
+n_args :: Node Arity -> [NodeId]
+n_args (Node d e args) a
+| a == length args = args
+| otherwise = abortn ("n_args: incorrect arity " <+ a <+ " for node " <+ d <+ ":" <++ (",", args))
+n_args _ _ = abortn "n_args: no arguments in node"
+
+n_arity :: Node -> Arity
+n_arity (Basic _ _ _) = 0
+n_arity (Node _ _ args) = length args
+n_arity Empty = abortn "n_arity: arity on Empty not defined"
+
+n_B :: Node -> Bool
+n_B (Basic _ _ (Bool b)) = b
+n_B _ = abortn "n_B: no boolean in node"
+
+n_I :: Node -> Int
+n_I (Basic _ _ (Int i)) = i
+n_I _ = abortn "n_I: no integer in node"
+
+n_copy :: Node Node -> Node
+n_copy new old = new
+
+n_descid :: Node -> DescId
+n_descid (Node i _ _) = i
+n_descid (Basic i _ _) = i
+n_descid Empty = abortn "n_descid: no descid in node"
+
+n_entry :: Node -> InstrId
+n_entry (Node _ e _) = e
+n_entry (Basic _ e _) = e
+n_entry Empty = abortn "n_entry: no entry in node"
+
+n_eq_arity :: Node Arity -> Bool
+n_eq_arity n a = n_arity n == a
+
+n_eq_B :: Node Bool -> Bool
+n_eq_B n b = n_B n == b
+
+n_eq_descid :: Node DescId -> Bool
+n_eq_descid n i = n_descid n == i
+
+n_eq_I :: Node Int -> Bool
+n_eq_I n i = n_I n == i
+
+n_eq_symbol :: Node Node -> Bool
+n_eq_symbol (Node i1 _ _) (Node i2 _ _) = i1 == i2
+n_eq_symbol (Basic i1 _ b1) (Basic i2 _ b2) = i1 == i2 && b1 == b2
+n_eq_symbol _ _ = False
+
+n_fill :: DescId InstrId Args Node -> Node
+n_fill d i a _ = Node d i a
+
+n_fillB :: DescId InstrId Bool Node -> Node
+n_fillB d e b _ = Basic d e (Bool b)
+
+n_fillI :: DescId InstrId Int Node -> Node
+n_fillI d e i _ = Basic d e (Int i)
+
+n_nargs :: Node NrArgs Arity -> [NodeId]
+n_nargs n i a = take i (n_args n a)
+
+n_setentry :: InstrId Node -> Node
+n_setentry e (Node d _ a) = Node d e a
+n_setentry e (Basic d _ b) = Basic d e b
+n_setentry _ Empty = abortn "n_setentry: Empty node"
diff --git a/ABC/Machine/Program.dcl b/ABC/Machine/Program.dcl
new file mode 100644
index 0000000..0526e56
--- /dev/null
+++ b/ABC/Machine/Program.dcl
@@ -0,0 +1,13 @@
+definition module ABC.Machine.Program
+
+from ABC.Machine.Def import ::InstrId, ::Instruction, ::State
+
+pc_init :: InstrId
+pc_next :: InstrId -> InstrId
+pc_halt :: InstrId -> InstrId
+pc_end :: InstrId -> Bool
+
+:: ProgramStore
+
+ps_get :: InstrId ProgramStore -> Instruction
+ps_init :: [Instruction] -> ProgramStore
diff --git a/ABC/Machine/Program.icl b/ABC/Machine/Program.icl
new file mode 100644
index 0000000..5b4e822
--- /dev/null
+++ b/ABC/Machine/Program.icl
@@ -0,0 +1,27 @@
+implementation module ABC.Machine.Program
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+pc_init :: InstrId
+pc_init = 0
+
+pc_next :: InstrId -> InstrId
+pc_next i = i + 1
+
+pc_halt :: InstrId -> InstrId
+pc_halt _ = -1
+
+pc_end :: InstrId -> Bool
+pc_end i = i < 0
+
+:: Location = I Instruction
+:: ProgramStore :== {Location}
+
+ps_get :: InstrId ProgramStore -> Instruction
+ps_get n p = let (I i) = p.[n] in i
+
+ps_init :: [Instruction] -> ProgramStore
+ps_init is = {I i \\ i <- is}
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-13 17:20:45 +0000