Change the block representation (version bumped to 3.9.0.0)
[packages/hoopl.git] / src / Compiler / Hoopl / Show.hs
1 {-# LANGUAGE RankNTypes, GADTs, ScopedTypeVariables, FlexibleContexts #-}
2 #if __GLASGOW_HASKELL__ >= 701
3 {-# LANGUAGE Safe #-}
4 #endif
5
6 module Compiler.Hoopl.Show
7 ( showGraph, showFactBase
8 )
9 where
10
11 import Compiler.Hoopl.Collections
12 import Compiler.Hoopl.Block
13 import Compiler.Hoopl.Graph
14 import Compiler.Hoopl.Label
15
16 --------------------------------------------------------------------------------
17 -- Prettyprinting
18 --------------------------------------------------------------------------------
19
20 type Showing n = forall e x . n e x -> String
21
22
23 showGraph :: forall n e x . (NonLocal n) => Showing n -> Graph n e x -> String
24 showGraph node = g
25 where g :: (NonLocal n) => Graph n e x -> String
26 g GNil = ""
27 g (GUnit block) = b block
28 g (GMany g_entry g_blocks g_exit) =
29 open b g_entry ++ body g_blocks ++ open b g_exit
30 body blocks = concatMap b (mapElems blocks)
31 b :: forall e x . Block n e x -> String
32 b (BlockCO l b1) = node l ++ "\n" ++ b b1
33 b (BlockCC l b1 n) = node l ++ "\n" ++ b b1 ++ node n ++ "\n"
34 b (BlockOC b1 n) = b b1 ++ node n ++ "\n"
35 b (BNil) = ""
36 b (BMiddle n) = node n ++ "\n"
37 b (BCat b1 b2) = b b1 ++ b b2
38 b (BHead b1 n) = b b1 ++ node n ++ "\n"
39 b (BTail n b1) = node n ++ "\n" ++ b b1
40
41 open :: (a -> String) -> MaybeO z a -> String
42 open _ NothingO = ""
43 open p (JustO n) = p n
44
45 showFactBase :: Show f => FactBase f -> String
46 showFactBase = show . mapToList