Moved to directory, added test program

26 files changed, 1289 insertions, 0 deletions

diff --git a/ABC/AStack.dcl b/ABC/AStack.dcl
new file mode 100644
index 0000000..423b81c
--- /dev/null
+++ b/ABC/AStack.dcl
@@ -0,0 +1,18 @@
+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
new file mode 100644
index 0000000..0a91ecd
--- /dev/null
+++ b/ABC/AStack.icl
@@ -0,0 +1,42 @@
+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
new file mode 100644
index 0000000..f750609
--- /dev/null
+++ b/ABC/Assembler.dcl
@@ -0,0 +1,78 @@
+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
+
+:: Label     :== String
+:: RedLabel  :== Label
+:: DescLabel :== Label
+:: NrInstr   :== Int
+
+:: Assembler :== [Statement]
+
+:: Statement
+	= Label        Label
+	| Descriptor   DescLabel RedLabel Arity Name
+	| Br           NrInstr
+	| BrFalse      NrInstr
+	| BrTrue       NrInstr
+	| Dump         String
+	| AddArgs      ASrc NrArgs ADst
+	| Create
+	| DelArgs      ASrc NrArgs ADst
+	| EqDesc       DescLabel ASrc
+	| EqDescArity  DescLabel Arity ASrc
+	| EqB
+	| EqB_a        Bool ASrc
+	| EqB_b        Bool BSrc
+	| EqI
+	| EqI_a        Int ASrc
+	| EqI_b        Int BSrc
+	| Fill         DescLabel NrArgs Label ADst
+	| Fill_a       ASrc ADst
+	| FillB        Bool ADst
+	| FillB_b      BSrc ADst
+	| FillI        Int ADst
+	| FillI_b      BSrc ADst
+	| GetDescArity ASrc
+	| GetNodeArity ASrc
+	| Halt
+	| Jmp          Label
+	| JmpEval
+	| JmpFalse     Label
+	| JmpTrue      Label
+	| Jsr          Label
+	| JsrEval
+	| NoOp
+	| Pop_a        Int
+	| Pop_b        Int
+	| Print        String
+	| PrintSymbol  ASrc
+	| Push_a       ASrc
+	| PushAPEntry  ASrc
+	| PushArg      ASrc Arity ArgNr
+	| PushArg_b    ASrc
+	| PushArgs     ASrc Arity ArgNr
+	| PushArgs_b   ASrc
+	| Push_b       Int
+	| PushB        Bool
+	| PushB_a      ASrc
+	| PushI        Int
+	| PushI_a      ASrc
+	| ReplArgs     Arity NrArgs
+	| ReplArgs_b
+	| Rtn
+	| SetEntry     Label ADst
+	| Update_a     ASrc ADst
+	| Update_b     BSrc BDst
+	| AddI
+	| DecI
+	| GtI 
+	| IncI
+	| LtI
+	| MulI
+	| SubI
+
+assemble :: Assembler -> ([Instruction], [Desc])
diff --git a/ABC/Assembler.icl b/ABC/Assembler.icl
new file mode 100644
index 0000000..9de0708
--- /dev/null
+++ b/ABC/Assembler.icl
@@ -0,0 +1,122 @@
+implementation module ABC.Assembler
+
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+assemble :: Assembler -> ([Instruction], [Desc])
+assemble stms = (translate stms loc_counter syms, descTable stms syms)
+where
+	loc_counter  = 0
+	desc_counter = 0
+	syms         = collect stms loc_counter desc_counter
+
+:: SymType  =   LabSym | DescSym
+
+instance == SymType
+where
+	(==) LabSym  LabSym  = True
+	(==) DescSym DescSym = True
+	(==) _       _       = False
+
+instance toString SymType
+where
+	toString LabSym  = "label"
+	toString DescSym = "descriptor"
+
+:: SymTable :== [(Name, Int, SymType)]
+
+collect :: Assembler Int Int -> SymTable
+collect []                       _  _  = []
+collect [Label l             :r] lc dc = [(l,lc,LabSym)  :collect r lc dc]
+collect [Descriptor dl rl _ _:r] lc dc = [(dl,dc,DescSym):collect r lc (dc+1)]
+collect [_                   :r] lc dc = collect r (lc+1) dc
+
+lookup :: Label SymType SymTable -> Int
+lookup l t [] = abortn ("label " <+ l <+ " not defined as " <+ t)
+lookup l t [(name,n,type):r]
+| l == name && t == type = n
+| otherwise              = lookup l t r
+
+descTable :: Assembler SymTable -> [Desc]
+descTable []                      _    = []
+descTable [Descriptor dl e a n:r] syms = [Desc ap_addr a n:descTable r syms]
+where ap_addr = lookup e LabSym syms
+descTable [_                  :r] syms = descTable r syms
+
+translate :: Assembler Int SymTable -> [Instruction]
+translate []                     _  _    = []
+translate [Label _           :r] lc syms = translate r lc syms
+translate [Descriptor _ _ _ _:r] lc syms = translate r lc syms
+translate [stm               :r] lc syms
+	= [trans stm lc syms:translate r (lc+1) syms]
+where
+	trans :: Statement Int SymTable -> Instruction
+	trans (Br n)               lc _    = jmp            (lc+n+1)
+	trans (BrFalse n)          lc _    = jmp_false      (lc+n+1)
+	trans (BrTrue n)           lc _    = jmp_true       (lc+n+1)
+	trans (Dump s)             _  _    = dump           s
+	trans (AddArgs s n d)      _  _    = add_args       s n d
+	trans Create               _  _    = create
+	trans (DelArgs s n d)      _  _    = del_args       s n d
+	trans (EqDesc dl s)        _  syms = eq_desc        daddr s
+		where daddr = (lookup dl DescSym syms)
+	trans (EqDescArity dl a s) _  syms = eq_desc_arity  daddr a s
+		where daddr = (lookup dl DescSym syms)
+	trans EqB                  _  _    = eqB
+	trans (EqB_a b s)          _  _    = eqB_a b s
+	trans (EqB_b b s)          _  _    = eqB_b b s
+	trans EqI                  _  _    = eqI
+	trans (EqI_a i s)          _  _    = eqI_a i s
+	trans (EqI_b i s)          _  _    = eqI_b i s
+	trans (Fill l n e d)       _  syms = fill daddr     n eaddr d
+		where (daddr,eaddr) = (lookup l DescSym syms, lookup e LabSym syms)
+	trans (Fill_a s d)         _  _    = fill_a s d
+	trans (FillB b d)          _  _    = fillB b d
+	trans (FillB_b s d)        _  _    = fillB_b s d
+	trans (FillI i d)          _  _    = fillI i d
+	trans (FillI_b s d)        _  _    = fillI_b s d
+	trans (GetDescArity s)     _  _    = get_desc_arity s
+	trans (GetNodeArity s)     _  _    = get_node_arity s
+	trans Halt                 _  _    = halt
+	trans (Jmp l)              _  syms = jmp            addr
+		where addr = lookup l LabSym syms
+	trans JmpEval              _  _    = jmp_eval
+	trans (JmpFalse l)         _  syms = jmp_false      addr
+		where addr = lookup l LabSym syms
+	trans (JmpTrue l)          _  syms = jmp_true       addr
+		where addr = lookup l LabSym syms
+	trans (Jsr l)              _  syms = jsr            addr
+		where addr = lookup l LabSym syms
+	trans JsrEval              _  _    = jsr_eval
+	trans NoOp                 _  _    = no_op
+	trans (Pop_a n)            _  _    = pop_a          n
+	trans (Pop_b n)            _  _    = pop_b          n
+	trans (Print s)            _  _    = print          s
+	trans (PrintSymbol s)      _  _    = print_symbol   s
+	trans (Push_a s)           _  _    = push_a         s
+	trans (PushAPEntry s)      _  _    = push_ap_entry  s
+	trans (PushArg s a n)      _  _    = push_arg       s a n
+	trans (PushArg_b s)        _  _    = push_arg_b     s
+	trans (PushArgs s a n)     _  _    = push_args      s a n
+	trans (PushArgs_b s)       _  _    = push_args_b    s
+	trans (Push_b i)           _  _    = push_b         i
+	trans (PushB b)            _  _    = pushB          b
+	trans (PushB_a s)          _  _    = pushB_a        s
+	trans (PushI i)            _  _    = pushI          i
+	trans (PushI_a s)          _  _    = pushI_a        s
+	trans (ReplArgs a n)       _  _    = repl_args      a n
+	trans ReplArgs_b           _  _    = repl_args_b
+	trans Rtn                  _  _    = rtn
+	trans (SetEntry l d)       _  syms = set_entry      addr d
+		where addr = lookup l LabSym syms
+	trans (Update_a s d)       _  _    = update_a       s d
+	trans (Update_b s d)       _  _    = update_b       s d
+	trans AddI                 _  _    = addI
+	trans DecI                 _  _    = decI
+	trans GtI                  _  _    = gtI
+	trans IncI                 _  _    = incI
+	trans LtI                  _  _    = ltI
+	trans MulI                 _  _    = mulI
+	trans SubI                 _  _    = subI
diff --git a/ABC/BStack.dcl b/ABC/BStack.dcl
new file mode 100644
index 0000000..95cf86e
--- /dev/null
+++ b/ABC/BStack.dcl
@@ -0,0 +1,38 @@
+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
new file mode 100644
index 0000000..a1caafd
--- /dev/null
+++ b/ABC/BStack.icl
@@ -0,0 +1,103 @@
+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
new file mode 100644
index 0000000..31d72de
--- /dev/null
+++ b/ABC/CStack.dcl
@@ -0,0 +1,15 @@
+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
new file mode 100644
index 0000000..74ca885
--- /dev/null
+++ b/ABC/CStack.icl
@@ -0,0 +1,26 @@
+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/Def.dcl b/ABC/Def.dcl
new file mode 100644
index 0000000..db2c0c0
--- /dev/null
+++ b/ABC/Def.dcl
@@ -0,0 +1,31 @@
+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
new file mode 100644
index 0000000..81bfeee
--- /dev/null
+++ b/ABC/Def.icl
@@ -0,0 +1 @@
+implementation module ABC.Def
diff --git a/ABC/Driver.dcl b/ABC/Driver.dcl
new file mode 100644
index 0000000..e5dd9f6
--- /dev/null
+++ b/ABC/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/ABC/Driver.icl b/ABC/Driver.icl
new file mode 100644
index 0000000..aa89ae1
--- /dev/null
+++ b/ABC/Driver.icl
@@ -0,0 +1,26 @@
+implementation module ABC.Driver
+
+import StdEnv, StdDebug
+
+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 = trace_n pc pc
+| 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
new file mode 100644
index 0000000..108a77e
--- /dev/null
+++ b/ABC/GraphStore.dcl
@@ -0,0 +1,25 @@
+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
new file mode 100644
index 0000000..0f32994
--- /dev/null
+++ b/ABC/GraphStore.icl
@@ -0,0 +1,70 @@
+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
new file mode 100644
index 0000000..501d8cc
--- /dev/null
+++ b/ABC/IO.dcl
@@ -0,0 +1,17 @@
+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
new file mode 100644
index 0000000..a7cda49
--- /dev/null
+++ b/ABC/IO.icl
@@ -0,0 +1,30 @@
+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}
+		= "output  : " <+ io <+ "\n" <+
+		  "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
new file mode 100644
index 0000000..45bd568
--- /dev/null
+++ b/ABC/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/ABC/Instructions.icl b/ABC/Instructions.icl
new file mode 100644
index 0000000..6317972
--- /dev/null
+++ b/ABC/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/ABC/Machine.dcl b/ABC/Machine.dcl
new file mode 100644
index 0000000..de98de2
--- /dev/null
+++ b/ABC/Machine.dcl
@@ -0,0 +1,17 @@
+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
diff --git a/ABC/Machine.icl b/ABC/Machine.icl
new file mode 100644
index 0000000..ab1acb4
--- /dev/null
+++ b/ABC/Machine.icl
@@ -0,0 +1 @@
+implementation module ABC.Machine
diff --git a/ABC/Misc.dcl b/ABC/Misc.dcl
new file mode 100644
index 0000000..3e632bf
--- /dev/null
+++ b/ABC/Misc.dcl
@@ -0,0 +1,8 @@
+definition module ABC.Misc
+
+from StdOverloaded import class toString
+
+abortn :: String -> a
+
+(<+) infixl 5  :: a b -> String | toString a & toString b
+(<++) infixl 5 :: a (g, [b]) -> String | toString a & toString b & toString g
diff --git a/ABC/Misc.icl b/ABC/Misc.icl
new file mode 100644
index 0000000..15e5b9d
--- /dev/null
+++ b/ABC/Misc.icl
@@ -0,0 +1,17 @@
+implementation module ABC.Misc
+
+import StdEnv
+
+abortn :: String -> a
+abortn s = abort (s +++ "\n")
+
+(<+) infixl 5 :: a b -> String | toString a & toString b
+(<+) a b = toString a +++ toString b
+
+(<++) infixl 5 :: a (g, [b]) -> String | toString a & toString b & toString g
+(<++) a (g,xs) = a <+ printersperse g xs
+
+printersperse :: a [b] -> String | toString a & toString b
+printersperse g []     = ""
+printersperse g [x]    = toString x
+printersperse g [x:xs] = x <+ g <++ (g, xs)
diff --git a/ABC/Nodes.dcl b/ABC/Nodes.dcl
new file mode 100644
index 0000000..9edd604
--- /dev/null
+++ b/ABC/Nodes.dcl
@@ -0,0 +1,27 @@
+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
new file mode 100644
index 0000000..fa29cb4
--- /dev/null
+++ b/ABC/Nodes.icl
@@ -0,0 +1,77 @@
+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 _ _ args) a
+| a == length args = args
+| otherwise        = abortn "n_args: incorrect arity"
+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
new file mode 100644
index 0000000..ffdf948
--- /dev/null
+++ b/ABC/Program.dcl
@@ -0,0 +1,13 @@
+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
new file mode 100644
index 0000000..4a34ec6
--- /dev/null
+++ b/ABC/Program.icl
@@ -0,0 +1,30 @@
+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 0 [I p:_] = p
+ps_get _ []      = abortn "ps_get: index too large"
+ps_get i [_:ps]  = ps_get (i-1) ps
+
+ps_init :: [Instruction] -> ProgramStore
+ps_init []     = []
+ps_init [i:is] = [I i:ps_init is]