558d959e217d6fd58cb8543f58f4515a5efc78e5
[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.Graph
9 import Compiler.Hoopl.Label
10
11 --------------------------------------------------------------------------------
12 -- Prettyprinting
13 --------------------------------------------------------------------------------
14
15 type Showing n = forall e x . n e x -> String
16
17
18 showGraph :: forall n e x . (Edges n) => Showing n -> Graph n e x -> String
19 showGraph node = g
20 where g :: (Edges n) => Graph n e x -> String
21 g GNil = ""
22 g (GUnit block) = b block
23 g (GMany g_entry g_blocks g_exit) =
24 open b g_entry ++ body g_blocks ++ open b g_exit
25 body blocks = concatMap b (map snd $ bodyList blocks)
26 b :: forall e x . Block n e x -> String
27 b (BFirst n) = node n
28 b (BMiddle n) = node n
29 b (BLast n) = node n ++ "\n"
30 b (BCat b1 b2) = b b1 ++ b b2
31 b (BHead b1 n) = b b1 ++ node n ++ "\n"
32 b (BTail n b1) = node n ++ b b1
33 b (BClosed b1 b2) = b b1 ++ b b2
34
35 open :: (a -> String) -> MaybeO z a -> String
36 open _ NothingO = ""
37 open p (JustO n) = p n
38
39 showFactBase :: Show f => FactBase f -> String
40 showFactBase = show . factBaseList