Abstracting collections of Uniques and Labels.
[packages/hoopl.git] / src / Compiler / Hoopl / Show.hs
1 {-# LANGUAGE RankNTypes, GADTs, ScopedTypeVariables, FlexibleContexts #-}
2
3 module Compiler.Hoopl.Show
4 ( showGraph, showFactBase
5 )
6 where
7
8 import Compiler.Hoopl.Collections
9 import Compiler.Hoopl.Graph
10 import Compiler.Hoopl.Label
11
12 --------------------------------------------------------------------------------
13 -- Prettyprinting
14 --------------------------------------------------------------------------------
15
16 type Showing n = forall e x . n e x -> String
17
18
19 showGraph :: forall n e x . (Edges n) => Showing n -> Graph n e x -> String
20 showGraph node = g
21 where g :: (Edges n) => Graph n e x -> String
22 g GNil = ""
23 g (GUnit block) = b block
24 g (GMany g_entry g_blocks g_exit) =
25 open b g_entry ++ body g_blocks ++ open b g_exit
26 body blocks = concatMap b (map snd $ bodyList blocks)
27 b :: forall e x . Block n e x -> String
28 b (BFirst n) = node n
29 b (BMiddle n) = node n
30 b (BLast n) = node n ++ "\n"
31 b (BCat b1 b2) = b b1 ++ b b2
32 b (BHead b1 n) = b b1 ++ node n ++ "\n"
33 b (BTail n b1) = node n ++ b b1
34 b (BClosed b1 b2) = b b1 ++ b b2
35
36 open :: (a -> String) -> MaybeO z a -> String
37 open _ NothingO = ""
38 open p (JustO n) = p n
39
40 showFactBase :: Show f => FactBase f -> String
41 showFactBase = show . toListMap