aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Driver.dcl7
-rw-r--r--Driver.icl25
-rw-r--r--IO.dcl2
-rw-r--r--IO.icl2
-rw-r--r--Instructions.dcl64
-rw-r--r--Instructions.icl386
-rw-r--r--Machine.dcl8
7 files changed, 493 insertions, 1 deletions
diff --git a/Driver.dcl b/Driver.dcl
new file mode 100644
index 0000000..e5dd9f6
--- /dev/null
+++ b/Driver.dcl
@@ -0,0 +1,7 @@
+definition module ABC.Driver
+
+from ABC.Def import ::State, ::Instruction
+from ABC.GraphStore import ::Desc
+
+boot :: ([Instruction], [Desc]) -> State
+fetch_cycle :: State -> State
diff --git a/Driver.icl b/Driver.icl
new file mode 100644
index 0000000..633d248
--- /dev/null
+++ b/Driver.icl
@@ -0,0 +1,25 @@
+implementation module ABC.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/IO.dcl b/IO.dcl
index c2634ea..501d8cc 100644
--- a/IO.dcl
+++ b/IO.dcl
@@ -8,6 +8,8 @@ from ABC.Def import ::State
:: IO (:== [Char])
+instance toString IO
+
io_init :: IO
io_print :: a IO -> IO | toString a
diff --git a/IO.icl b/IO.icl
index f2b0e29..a7cda49 100644
--- a/IO.icl
+++ b/IO.icl
@@ -7,6 +7,8 @@ import ABC.Misc
:: IO :== [Char]
+instance toString IO where toString io = {c \\ c <- io}
+
io_init :: IO
io_init = []
diff --git a/Instructions.dcl b/Instructions.dcl
new file mode 100644
index 0000000..45bd568
--- /dev/null
+++ b/Instructions.dcl
@@ -0,0 +1,64 @@
+definition module ABC.Instructions
+
+from ABC.Def import ::NrArgs, ::State, ::DescId, ::Arity, ::InstrId, ::ArgNr
+from ABC.AStack import ::ASrc, ::ADst
+from ABC.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/Instructions.icl b/Instructions.icl
new file mode 100644
index 0000000..6317972
--- /dev/null
+++ b/Instructions.icl
@@ -0,0 +1,386 @@
+implementation module ABC.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/Machine.dcl b/Machine.dcl
index 4106009..e71147b 100644
--- a/Machine.dcl
+++ b/Machine.dcl
@@ -2,8 +2,14 @@ definition module ABC.Machine
import
ABC.Def,
+
ABC.AStack,
ABC.BStack,
ABC.CStack,
ABC.Nodes,
- ABC.GraphStore
+ ABC.GraphStore,
+ ABC.Program,
+ ABC.IO,
+
+ ABC.Instructions,
+ ABC.Driver
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-13 11:01:02 +0000