Convert a non-deterministic finite-state automaton (NFA) to a constraint grammar (CG) in the VislCG3 format.

NFA2CG.hs

{-# LANGUAGE RecordWildCards #-}

import Data.Char (toUpper)
import Data.List (intersperse)
import Text.Printf (printf)

-- |The definition of a non-deterministic finite-state automata.
--  Note: this definition assumes that all epsilon transitions
--  have been removed from the NFA.
data NFA s c = NFA
  { states     :: [s]
  , alphabet   :: [c]
  , transition :: c -> s -> [s]
  , startState :: s
  , finalState :: s -> Bool
  }

-- |Test whether or not a string matches an NFA.
match :: NFA s c -> [c] -> Bool
match NFA{..} = any finalState . go [startState]
  where
    go states [    ] = states
    go states (x:xs) = go (concatMap (transition x) states) xs

-- |Convert an NFA which uses any type of showable and readable states to one which uses strings.
showState :: (Read a, Show a) => NFA a b -> NFA String b
showState NFA{..} = NFA
  { states     = map show states
  , alphabet   = alphabet
  , transition = \c s -> map show (transition c (read s))
  , startState = show startState
  , finalState = \s -> finalState (read s)
  }

-- |An example NFA which matches the language "a*b*".
anbm :: NFA Int String
anbm = NFA{..}
  where
    states     = [0..2]
    alphabet   = ["a","b"]

    transition "a" 0 = [1]
    transition "a" 1 = [1]
    transition "b" 1 = [2]
    transition "b" 2 = [2]
    transition  _  _ = [ ]

    startState   = 0
    finalState 2 = True
    finalState _ = False

-- |Print an NFA as a constraint grammar in the VislCG3 format.
cg :: NFA String String -> String
cg NFA{..} = unlines . concat $
  [ [        "DELIMITERS = \"<.>\";"                                            ]
  , [        ""                                                                 ]
  , [        "SET  >>>      = (>>>);"                                           ]
  , [        "SET  <<<      = (<<<);"                                           ]
  , [        ""                                                                 ]
  , [ printf "LIST %s       = \"%s\";"  c c                  | c <- alphabet    ]
  , [ printf "LIST S%-3s    = \"s%s\";" s s                  | s <- states      ]
  , [        ""                                                                 ]
  , [ printf "SET  VISITED = %s;"            visited                            ]
  , [ printf "SET  ANY     = %s OR (\".\");" any                                ]
  , [        ""                                                                 ]
  , [        "BEFORE-SECTIONS"                                                  ]
  , [ printf "  APPEND S%s (*) (-1 >>>);" startState                            ]
  , [ printf "  APPEND S%s (*) IF (-1 %s LINK 0 S%s);" m c n | (n,c,m) <- rules ]
  , [        ""                                                                 ]
  , [        "SECTION"                                                          ]
  , [        "  REMCOHORT (*) IF (1* <<< LINK NOT 0 VISITED);"                  ]
  , [        ""                                                                 ]
  , [        "AFTER-SECTIONS"                                                   ]
  , [        "  REMCOHORT <<< IF (NOT 0 VISITED);"                              ]
  , [        "  SELECT ANY;"                                                    ]
  ]
  where
    any     = unwords (intersperse "OR" [printf "%s"  c | c <- alphabet])
    visited = unwords (intersperse "OR" [printf "S%s" s | s <- states  ])
    rules   = [(n,c,m) | n <- states, c <- alphabet, m <- transition c n]