-- -----------------------------------------------------------------------------
-- 
-- Info.hs, part of Alex
--
-- (c) Simon Marlow 2003
--
-- Generate a human-readable rendition of the state machine.
--
-- ----------------------------------------------------------------------------}

module Info (infoDFA) where

import AbsSyn
import qualified Map
import qualified Data.IntMap as IntMap
import Util

import Data.Array

-- -----------------------------------------------------------------------------
-- Generate a human readable dump of the state machine

infoDFA :: Int -> String -> DFA SNum Code -> ShowS
infoDFA :: Int -> String -> DFA Int String -> ShowS
infoDFA Int
_ String
func_nm DFA Int String
dfa
  = String -> ShowS
str String
"Scanner : " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
func_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
"States  : " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows ([(Int, State Int String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, State Int String)]
dfa_list) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
infoDFA'
  where    
    dfa_list :: [(Int, State Int String)]
dfa_list = Map Int (State Int String) -> [(Int, State Int String)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (DFA Int String -> Map Int (State Int String)
forall s a. DFA s a -> Map s (State s a)
dfa_states DFA Int String
dfa)

    infoDFA' :: ShowS
infoDFA' = ShowS -> [ShowS] -> ShowS
interleave_shows ShowS
nl (((Int, State Int String) -> ShowS)
-> [(Int, State Int String)] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (Int, State Int String) -> ShowS
forall a. Show a => (a, State Int String) -> ShowS
infoStateN [(Int, State Int String)]
dfa_list)

    infoStateN :: (a, State Int String) -> ShowS
infoStateN (a
i,State Int String
s) = String -> ShowS
str String
"State " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State Int String -> ShowS
infoState State Int String
s

    infoState :: State SNum Code -> ShowS
    infoState :: State Int String -> ShowS
infoState (State [Accept String]
accs IntMap Int
out)
        = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id ((Accept String -> ShowS) -> [Accept String] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map Accept String -> ShowS
infoAccept [Accept String]
accs)
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap Int -> ShowS
forall a. Show a => IntMap a -> ShowS
infoArr IntMap Int
out ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl

    infoArr :: IntMap a -> ShowS
infoArr IntMap a
out
        = Char -> ShowS
char Char
'\t' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> ShowS
interleave_shows (String -> ShowS
str String
"\n\t")
                        (((Int, a) -> ShowS) -> [(Int, a)] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> ShowS
forall a a. (Show a, Show a) => (a, a) -> ShowS
infoTransition (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap a
out))

    infoAccept :: Accept String -> ShowS
infoAccept (Acc Int
p Maybe String
act Maybe CharSet
lctx RightContext Int
rctx)
        = String -> ShowS
str String
"\tAccept" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> ShowS
paren (Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
p) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CharSet -> ShowS
forall a. Show a => Maybe a -> ShowS
outputLCtx Maybe CharSet
lctx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RightContext Int -> ShowS
forall r. Show r => RightContext r -> ShowS
showRCtx RightContext Int
rctx
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (case Maybe String
act of
            Maybe String
Nothing   -> ShowS
forall a. a -> a
id
            Just String
code -> String -> ShowS
str String
" { " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
code ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" }")
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
        
    infoTransition :: (a, a) -> ShowS
infoTransition (a
char',a
state)
        = String -> ShowS
str (Int -> ShowS
ljustify Int
8 (a -> String
forall a. Show a => a -> String
show a
char'))
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" -> "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
state

    outputLCtx :: Maybe a -> ShowS
outputLCtx Maybe a
Nothing
          = ShowS
forall a. a -> a
id
    outputLCtx (Just a
set)
          = ShowS -> ShowS
paren (a -> String
forall a. Show a => a -> String
show a
set String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
char Char
'^'

    outputArr :: Array i e -> ShowS
outputArr Array i e
arr
          = String -> ShowS
str String
"Array.array " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, i) -> ShowS
forall a. Show a => a -> ShowS
shows (Array i e -> (i, i)
forall i e. Array i e -> (i, i)
bounds Array i e
arr) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(i, e)] -> ShowS
forall a. Show a => a -> ShowS
shows (Array i e -> [(i, e)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs Array i e
arr)