From ceb0b74bd0b368124679378ebfb2cf316deb2e39 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Tue, 5 Jul 2016 17:25:10 +0200
Subject: Added Machine as module level

---
 ABC/AStack.dcl               |  18 --
 ABC/AStack.icl               |  42 -----
 ABC/Assembler.dcl            |   8 +-
 ABC/BStack.dcl               |  38 -----
 ABC/BStack.icl               | 103 ------------
 ABC/CStack.dcl               |  15 --
 ABC/CStack.icl               |  26 ---
 ABC/Code/RTS.icl             |   2 +-
 ABC/Def.dcl                  |  31 ----
 ABC/Def.icl                  |   1 -
 ABC/Driver.dcl               |   7 -
 ABC/Driver.icl               |  25 ---
 ABC/GraphStore.dcl           |  25 ---
 ABC/GraphStore.icl           |  70 --------
 ABC/IO.dcl                   |  17 --
 ABC/IO.icl                   |  29 ----
 ABC/Instructions.dcl         |  64 -------
 ABC/Instructions.icl         | 386 -------------------------------------------
 ABC/Machine.dcl              |  26 ++-
 ABC/Machine/AStack.dcl       |  18 ++
 ABC/Machine/AStack.icl       |  42 +++++
 ABC/Machine/BStack.dcl       |  38 +++++
 ABC/Machine/BStack.icl       | 103 ++++++++++++
 ABC/Machine/CStack.dcl       |  15 ++
 ABC/Machine/CStack.icl       |  26 +++
 ABC/Machine/Def.dcl          |  31 ++++
 ABC/Machine/Def.icl          |   1 +
 ABC/Machine/Driver.dcl       |   7 +
 ABC/Machine/Driver.icl       |  25 +++
 ABC/Machine/GraphStore.dcl   |  25 +++
 ABC/Machine/GraphStore.icl   |  70 ++++++++
 ABC/Machine/IO.dcl           |  17 ++
 ABC/Machine/IO.icl           |  29 ++++
 ABC/Machine/Instructions.dcl |  64 +++++++
 ABC/Machine/Instructions.icl | 386 +++++++++++++++++++++++++++++++++++++++++++
 ABC/Machine/Nodes.dcl        |  27 +++
 ABC/Machine/Nodes.icl        |  77 +++++++++
 ABC/Machine/Program.dcl      |  13 ++
 ABC/Machine/Program.icl      |  27 +++
 ABC/Nodes.dcl                |  27 ---
 ABC/Nodes.icl                |  77 ---------
 ABC/Program.dcl              |  13 --
 ABC/Program.icl              |  27 ---
 43 files changed, 1058 insertions(+), 1060 deletions(-)
 delete mode 100644 ABC/AStack.dcl
 delete mode 100644 ABC/AStack.icl
 delete mode 100644 ABC/BStack.dcl
 delete mode 100644 ABC/BStack.icl
 delete mode 100644 ABC/CStack.dcl
 delete mode 100644 ABC/CStack.icl
 delete mode 100644 ABC/Def.dcl
 delete mode 100644 ABC/Def.icl
 delete mode 100644 ABC/Driver.dcl
 delete mode 100644 ABC/Driver.icl
 delete mode 100644 ABC/GraphStore.dcl
 delete mode 100644 ABC/GraphStore.icl
 delete mode 100644 ABC/IO.dcl
 delete mode 100644 ABC/IO.icl
 delete mode 100644 ABC/Instructions.dcl
 delete mode 100644 ABC/Instructions.icl
 create mode 100644 ABC/Machine/AStack.dcl
 create mode 100644 ABC/Machine/AStack.icl
 create mode 100644 ABC/Machine/BStack.dcl
 create mode 100644 ABC/Machine/BStack.icl
 create mode 100644 ABC/Machine/CStack.dcl
 create mode 100644 ABC/Machine/CStack.icl
 create mode 100644 ABC/Machine/Def.dcl
 create mode 100644 ABC/Machine/Def.icl
 create mode 100644 ABC/Machine/Driver.dcl
 create mode 100644 ABC/Machine/Driver.icl
 create mode 100644 ABC/Machine/GraphStore.dcl
 create mode 100644 ABC/Machine/GraphStore.icl
 create mode 100644 ABC/Machine/IO.dcl
 create mode 100644 ABC/Machine/IO.icl
 create mode 100644 ABC/Machine/Instructions.dcl
 create mode 100644 ABC/Machine/Instructions.icl
 create mode 100644 ABC/Machine/Nodes.dcl
 create mode 100644 ABC/Machine/Nodes.icl
 create mode 100644 ABC/Machine/Program.dcl
 create mode 100644 ABC/Machine/Program.icl
 delete mode 100644 ABC/Nodes.dcl
 delete mode 100644 ABC/Nodes.icl
 delete mode 100644 ABC/Program.dcl
 delete mode 100644 ABC/Program.icl

(limited to 'ABC')

diff --git a/ABC/AStack.dcl b/ABC/AStack.dcl
deleted file mode 100644
index 423b81c..0000000
--- a/ABC/AStack.dcl
+++ /dev/null
@@ -1,18 +0,0 @@
-definition module ABC.AStack
-
-from StdOverloaded import class toString
-from ABC.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/AStack.icl b/ABC/AStack.icl
deleted file mode 100644
index 0a91ecd..0000000
--- a/ABC/AStack.icl
+++ /dev/null
@@ -1,42 +0,0 @@
-implementation module ABC.AStack
-
-import StdEnv
-
-import ABC.Def
-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/Assembler.dcl b/ABC/Assembler.dcl
index f750609..6b0a585 100644
--- a/ABC/Assembler.dcl
+++ b/ABC/Assembler.dcl
@@ -1,9 +1,9 @@
 definition module ABC.Assembler
 
-from ABC.Def import ::Arity, ::Name, ::NrArgs, ::ArgNr, ::Instruction, ::State
-from ABC.AStack import ::ASrc, ::ADst
-from ABC.BStack import ::BSrc, ::BDst
-from ABC.GraphStore import ::Desc
+from ABC.Machine.Def import ::Arity, ::Name, ::NrArgs, ::ArgNr, ::Instruction, ::State
+from ABC.Machine.AStack import ::ASrc, ::ADst
+from ABC.Machine.BStack import ::BSrc, ::BDst
+from ABC.Machine.GraphStore import ::Desc
 
 :: Label     :== String
 :: RedLabel  :== Label
diff --git a/ABC/BStack.dcl b/ABC/BStack.dcl
deleted file mode 100644
index 95cf86e..0000000
--- a/ABC/BStack.dcl
+++ /dev/null
@@ -1,38 +0,0 @@
-definition module ABC.BStack
-
-from StdOverloaded import class ==, class toString
-from ABC.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/BStack.icl b/ABC/BStack.icl
deleted file mode 100644
index a1caafd..0000000
--- a/ABC/BStack.icl
+++ /dev/null
@@ -1,103 +0,0 @@
-implementation module ABC.BStack
-
-import StdEnv
-
-import ABC.Def
-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/CStack.dcl b/ABC/CStack.dcl
deleted file mode 100644
index 31d72de..0000000
--- a/ABC/CStack.dcl
+++ /dev/null
@@ -1,15 +0,0 @@
-definition module ABC.CStack
-
-from StdOverloaded import class toString
-from ABC.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/CStack.icl b/ABC/CStack.icl
deleted file mode 100644
index 74ca885..0000000
--- a/ABC/CStack.icl
+++ /dev/null
@@ -1,26 +0,0 @@
-implementation module ABC.CStack
-
-import StdEnv
-
-import ABC.Def
-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/Code/RTS.icl b/ABC/Code/RTS.icl
index 89032f3..2551c51 100644
--- a/ABC/Code/RTS.icl
+++ b/ABC/Code/RTS.icl
@@ -1,6 +1,6 @@
 implementation module ABC.Code.RTS
 
-import ABC.Machine
+import ABC.Assembler
 
 rts :: Assembler
 rts
diff --git a/ABC/Def.dcl b/ABC/Def.dcl
deleted file mode 100644
index db2c0c0..0000000
--- a/ABC/Def.dcl
+++ /dev/null
@@ -1,31 +0,0 @@
-definition module ABC.Def
-
-from ABC.AStack import ::AStack
-from ABC.BStack import ::BStack
-from ABC.CStack import ::CStack
-from ABC.GraphStore import ::GraphStore, ::DescStore
-from ABC.Program import ::ProgramStore
-from ABC.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/Def.icl b/ABC/Def.icl
deleted file mode 100644
index 81bfeee..0000000
--- a/ABC/Def.icl
+++ /dev/null
@@ -1 +0,0 @@
-implementation module ABC.Def
diff --git a/ABC/Driver.dcl b/ABC/Driver.dcl
deleted file mode 100644
index e5dd9f6..0000000
--- a/ABC/Driver.dcl
+++ /dev/null
@@ -1,7 +0,0 @@
-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/ABC/Driver.icl b/ABC/Driver.icl
deleted file mode 100644
index 633d248..0000000
--- a/ABC/Driver.icl
+++ /dev/null
@@ -1,25 +0,0 @@
-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/ABC/GraphStore.dcl b/ABC/GraphStore.dcl
deleted file mode 100644
index 108a77e..0000000
--- a/ABC/GraphStore.dcl
+++ /dev/null
@@ -1,25 +0,0 @@
-definition module ABC.GraphStore
-
-from StdOverloaded import class toString
-from ABC.Def import ::Arity, ::InstrId, ::Name, ::APEntry, ::DescId, ::NodeId
-from ABC.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/GraphStore.icl b/ABC/GraphStore.icl
deleted file mode 100644
index fd41517..0000000
--- a/ABC/GraphStore.icl
+++ /dev/null
@@ -1,70 +0,0 @@
-implementation module ABC.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/IO.dcl b/ABC/IO.dcl
deleted file mode 100644
index 501d8cc..0000000
--- a/ABC/IO.dcl
+++ /dev/null
@@ -1,17 +0,0 @@
-definition module ABC.IO
-
-from StdOverloaded import class toString
-
-from ABC.Nodes import ::Node
-from ABC.GraphStore import ::Desc
-from ABC.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/IO.icl b/ABC/IO.icl
deleted file mode 100644
index 0762ed2..0000000
--- a/ABC/IO.icl
+++ /dev/null
@@ -1,29 +0,0 @@
-implementation module ABC.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/Instructions.dcl b/ABC/Instructions.dcl
deleted file mode 100644
index 45bd568..0000000
--- a/ABC/Instructions.dcl
+++ /dev/null
@@ -1,64 +0,0 @@
-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/ABC/Instructions.icl b/ABC/Instructions.icl
deleted file mode 100644
index 6317972..0000000
--- a/ABC/Instructions.icl
+++ /dev/null
@@ -1,386 +0,0 @@
-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/ABC/Machine.dcl b/ABC/Machine.dcl
index de98de2..68bf4cc 100644
--- a/ABC/Machine.dcl
+++ b/ABC/Machine.dcl
@@ -1,17 +1,15 @@
 definition module ABC.Machine
 
 import
-	ABC.Def,
-
-	ABC.AStack,
-	ABC.BStack,
-	ABC.CStack,
-	ABC.Nodes,
-	ABC.GraphStore,
-	ABC.Program,
-	ABC.IO,
-
-	ABC.Instructions,
-	ABC.Driver,
-
-	ABC.Assembler
+	ABC.Machine.Def,
+
+	ABC.Machine.AStack,
+	ABC.Machine.BStack,
+	ABC.Machine.CStack,
+	ABC.Machine.Nodes,
+	ABC.Machine.GraphStore,
+	ABC.Machine.Program,
+	ABC.Machine.IO,
+
+	ABC.Machine.Instructions,
+	ABC.Machine.Driver
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}
diff --git a/ABC/Nodes.dcl b/ABC/Nodes.dcl
deleted file mode 100644
index 9edd604..0000000
--- a/ABC/Nodes.dcl
+++ /dev/null
@@ -1,27 +0,0 @@
-definition module ABC.Nodes
-
-from ABC.Def import ::ArgNr, ::Arity, ::NodeId, ::InstrId, ::Args, ::DescId, ::NrArgs
-from ABC.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/Nodes.icl b/ABC/Nodes.icl
deleted file mode 100644
index 55be090..0000000
--- a/ABC/Nodes.icl
+++ /dev/null
@@ -1,77 +0,0 @@
-implementation module ABC.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/Program.dcl b/ABC/Program.dcl
deleted file mode 100644
index ffdf948..0000000
--- a/ABC/Program.dcl
+++ /dev/null
@@ -1,13 +0,0 @@
-definition module ABC.Program
-
-from ABC.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/Program.icl b/ABC/Program.icl
deleted file mode 100644
index 28416bb..0000000
--- a/ABC/Program.icl
+++ /dev/null
@@ -1,27 +0,0 @@
-implementation module ABC.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}
-- 
cgit v1.2.3