Printing

15 files changed, 125 insertions, 46 deletions

diff --git a/AStack.dcl b/AStack.dcl
index 799892f..423b81c 100644
--- a/AStack.dcl
+++ b/AStack.dcl
@@ -1,11 +1,14 @@
 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
diff --git a/AStack.icl b/AStack.icl
index e6dc312..0a91ecd 100644
--- a/AStack.icl
+++ b/AStack.icl
@@ -7,6 +7,8 @@ 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
diff --git a/BStack.dcl b/BStack.dcl
index 4095f60..95cf86e 100644
--- a/BStack.dcl
+++ b/BStack.dcl
@@ -1,17 +1,20 @@
 definition module ABC.BStack
 
-from StdOverloaded import class ==
+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
diff --git a/BStack.icl b/BStack.icl
index 8ca4017..a1caafd 100644
--- a/BStack.icl
+++ b/BStack.icl
@@ -11,8 +11,15 @@ where
 	(==) (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]
 
diff --git a/CStack.dcl b/CStack.dcl
index 8aa6824..31d72de 100644
--- a/CStack.dcl
+++ b/CStack.dcl
@@ -1,11 +1,14 @@
 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
diff --git a/CStack.icl b/CStack.icl
index ae9cceb..74ca885 100644
--- a/CStack.icl
+++ b/CStack.icl
@@ -7,6 +7,8 @@ import ABC.Misc
 
 :: CStack :== [InstrId]
 
+instance toString CStack where toString xs = "[" <++ (",", xs) <+ "]"
+
 cs_init :: CStack
 cs_init = []
 
diff --git a/Def.dcl b/Def.dcl
index 9249ab0..db2c0c0 100644
--- a/Def.dcl
+++ b/Def.dcl
@@ -3,8 +3,7 @@ definition module ABC.Def
 from ABC.AStack import ::AStack
 from ABC.BStack import ::BStack
 from ABC.CStack import ::CStack
-from ABC.GraphStore import ::GraphStore
-from ABC.Descriptors import ::DescStore
+from ABC.GraphStore import ::GraphStore, ::DescStore
 from ABC.Program import ::ProgramStore
 from ABC.IO import ::IO
 
diff --git a/Descriptors.dcl b/Descriptors.dcl
deleted file mode 100644
index 7c0dad6..0000000
--- a/Descriptors.dcl
+++ /dev/null
@@ -1,14 +0,0 @@
-definition module ABC.Descriptors
-
-from ABC.Def import ::Arity, ::InstrId, ::Name, ::APEntry, ::DescId
-
-:: 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
diff --git a/Descriptors.icl b/Descriptors.icl
deleted file mode 100644
index 5874136..0000000
--- a/Descriptors.icl
+++ /dev/null
@@ -1,25 +0,0 @@
-implementation module ABC.Descriptors
-
-import StdEnv
-
-import ABC.Machine
-import ABC.Misc
-
-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
diff --git a/GraphStore.dcl b/GraphStore.dcl
index 5095a78..108a77e 100644
--- a/GraphStore.dcl
+++ b/GraphStore.dcl
@@ -1,10 +1,24 @@
 definition module ABC.GraphStore
 
-from ABC.Def import ::NodeId
+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)
diff --git a/GraphStore.icl b/GraphStore.icl
index 3d966c0..6f2a2e0 100644
--- a/GraphStore.icl
+++ b/GraphStore.icl
@@ -5,11 +5,43 @@ 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
                 }
 
-STORE_SIZE :== 1000
+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} = get i nodes
diff --git a/IO.dcl b/IO.dcl
index 3251b8d..c2634ea 100644
--- a/IO.dcl
+++ b/IO.dcl
@@ -1,3 +1,15 @@
 definition module ABC.IO
 
-:: IO
+from StdOverloaded import class toString
+
+from ABC.Nodes import ::Node
+from ABC.GraphStore import ::Desc
+from ABC.Def import ::State
+
+:: IO (:== [Char])
+
+io_init  :: IO
+io_print :: a IO -> IO | toString a
+
+show_node :: Node Desc -> String
+instance toString State
diff --git a/IO.icl b/IO.icl
index 0cec8fb..f2b0e29 100644
--- a/IO.icl
+++ b/IO.icl
@@ -1,3 +1,28 @@
 implementation module ABC.IO
 
-:: IO = IO
+import StdEnv
+
+import ABC.Machine
+import ABC.Misc
+
+:: IO :== [Char]
+
+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/Misc.dcl b/Misc.dcl
index acd5117..3e632bf 100644
--- a/Misc.dcl
+++ b/Misc.dcl
@@ -1,3 +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/Misc.icl b/Misc.icl
index 034ce9d..15e5b9d 100644
--- a/Misc.icl
+++ b/Misc.icl
@@ -4,3 +4,14 @@ 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)