/
CFG.hs
50 lines (41 loc) · 1.44 KB
/
CFG.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
-- | Helpers for working with general context-free grammars.
module CFG.Helpers.CFG (
-- * Monad for fresh names.
NameMonad, runNameMonad, freshName, rememberName
)
where
import CFG.Types
import Control.Monad.State
import qualified Data.Set as S
-- Monad for generating fresh names.
data NameState = NameState { nameStateCounter :: !Int
, nameStateSet :: !(S.Set RuleName) }
deriving Show
type NameMonad = State NameState
-- | Initial state, for using in conjunction with 'runState'.
runNameMonad :: S.Set RuleName -> NameMonad a -> a
runNameMonad s act = fst $ runState act (NameState 0 s)
-- | Generate a fresh name.
freshName :: NameMonad RuleName
freshName = do
c <- getCounter
incCounter
let n = "Z" ++ (show c)
hasSeen <- nameSetContains n
if hasSeen
then freshName
else do rememberName n
return n
where
getCounter :: NameMonad Int
getCounter = gets nameStateCounter
incCounter :: NameMonad ()
incCounter = modify
(\s -> s { nameStateCounter = (+1) . nameStateCounter $ s })
nameSetContains :: RuleName -> NameMonad Bool
nameSetContains n = S.member n `fmap` gets nameStateSet
-- | Remember a given name. A remembered name will never be produced by
-- 'freshName'.
rememberName :: RuleName -> NameMonad ()
rememberName n = modify
(\s -> s { nameStateSet = S.insert n . nameStateSet $ s})