mirror of
https://git.cs.ou.nl/joshua.moerman/mealy-decompose.git
synced 2025-04-30 02:07:44 +02:00
66 lines
2.4 KiB
Haskell
66 lines
2.4 KiB
Haskell
module DotParser where
|
|
|
|
import Data.Char (isAlphaNum)
|
|
import Data.List.Ordered qualified as OrdList
|
|
import Data.Map.Strict qualified as Map
|
|
import Data.Void (Void)
|
|
import Mealy
|
|
import Text.Megaparsec
|
|
import Text.Megaparsec.Char
|
|
import Text.Megaparsec.Char.Lexer qualified as L
|
|
|
|
{-
|
|
Parser for Dot files generated by the RERS LearnLib learner. This is not
|
|
a fully fledged parser. It is specific to our models.
|
|
|
|
Really only parses a single transition. We just collect all succesfull
|
|
transitions. This gives all transitions.
|
|
|
|
Usage:
|
|
transitions <- mapMaybe (parseMaybe parseTransFull) . lines <$> readFile dotFile
|
|
-}
|
|
|
|
type Stat = String
|
|
type Input = String
|
|
type Output = String
|
|
type Trans = (Stat, Stat, Input, Output)
|
|
|
|
type Parser = Parsec Void String
|
|
|
|
parseTrans :: Parser Trans
|
|
parseTrans = assoc <$> identifierQ <* symbol "->" <*> identifierQ <*> brackets parseLabel <* optional (symbol ";")
|
|
where
|
|
-- defines whitespace and lexemes
|
|
sc = L.space space1 empty empty
|
|
lexeme = L.lexeme sc
|
|
symbol = L.symbol sc
|
|
-- state, input, output is any string of alphaNumChar's
|
|
isAlphaNumExtra c = isAlphaNum c || c == '_' || c == '+' || c == '.' || c == ',' || c == '-' || c == '(' || c == ')'
|
|
alphaNumCharExtra = satisfy isAlphaNumExtra <?> "alphanumeric character or extra"
|
|
identifier = lexeme (some alphaNumCharExtra)
|
|
identifierQ = identifier <|> between (symbol "\"") (symbol "\"") identifier
|
|
-- The label has the shape [label="i/o"]
|
|
brackets = between (symbol "[") (symbol "]")
|
|
parseLabel = (,) <$> (symbol "label=\"" *> identifier <* symbol "/") <*> (identifier <* symbol "\"")
|
|
-- re-associate different parts of the parser
|
|
assoc from to (i, o) = (from, to, i, o)
|
|
|
|
parseTransFull :: Parser Trans
|
|
parseTransFull = space *> parseTrans <* eof
|
|
|
|
convertToMealy :: [Trans] -> MealyMachine String String String
|
|
convertToMealy l = MealyMachine
|
|
{ states = states
|
|
, inputs = ins
|
|
, outputs = outs
|
|
, behaviour = \s i -> base Map.! (s, i)
|
|
, initialState = (\(a,_,_,_) -> a) . head $ l
|
|
-- ^ Assumption: first transition in the file belongs to the initial state
|
|
}
|
|
where
|
|
froms = OrdList.nubSort . fmap (\(a,_,_,_) -> a) $ l
|
|
tos = OrdList.nubSort . fmap (\(_,a,_,_) -> a) $ l
|
|
ins = OrdList.nubSort . fmap (\(_,_,i,_) -> i) $ l
|
|
outs = OrdList.nubSort . fmap (\(_,_,_,o) -> o) $ l
|
|
states = froms `OrdList.union` tos
|
|
base = Map.fromList . fmap (\(from, to, i, o) -> ((from, i), (o, to))) $ l
|