> {-# OPTIONS_HADDOCK show-extensions #-}
>
> module LTK.Porters.ATT
> ( embedSymbolsATT
> , extractSymbolsATT
> , invertATT
>
> , readATT
>
> , exportATT
> ) where
> import Data.Char (isDigit)
> import Data.List (intercalate)
> import Data.List.NonEmpty (NonEmpty(..))
> import Data.Maybe (fromMaybe)
> import Data.Set (Set)
> import Data.Map (Map)
> import qualified Data.List.NonEmpty as NE
> import qualified Data.Map.Strict as Map
> import qualified Data.Set as Set
> import LTK.FSA
> separator :: String
> separator :: [Char]
separator = [Char]
"* * *"
> defaultEpsilon :: String
> defaultEpsilon :: [Char]
defaultEpsilon = [Char]
"<EPS>"
>
>
>
>
> embedSymbolsATT :: String -> Maybe String -> Maybe String -> String
> embedSymbolsATT :: [Char] -> Maybe [Char] -> Maybe [Char] -> [Char]
embedSymbolsATT [Char]
x Maybe [Char]
mi Maybe [Char]
mo
> = [[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> (Maybe [[Char]] -> [[Char]]) -> Maybe [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
(++) ([Char] -> [[Char]]
lines [Char]
x) ([[Char]] -> [[Char]])
-> (Maybe [[Char]] -> [[Char]]) -> Maybe [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Maybe [[Char]] -> [[Char]]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [[Char]] -> [[Char]])
-> (Maybe [[Char]] -> Maybe [[Char]]) -> Maybe [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> Maybe [[Char]] -> Maybe [[Char]]
m Maybe [Char]
mi (Maybe [[Char]] -> [Char]) -> Maybe [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> Maybe [[Char]] -> Maybe [[Char]]
m Maybe [Char]
mo Maybe [[Char]]
forall a. Maybe a
Nothing
> where presep :: [[Char]] -> [[Char]]
presep = (:) [Char]
separator
> multisep :: Maybe [[Char]] -> Maybe [[Char]] -> Maybe [[Char]]
multisep = (Maybe [[Char]] -> Maybe [[Char]])
-> ([[Char]] -> Maybe [[Char]] -> Maybe [[Char]])
-> Maybe [[Char]]
-> Maybe [[Char]]
-> Maybe [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
> (([[Char]] -> [[Char]]) -> Maybe [[Char]] -> Maybe [[Char]]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Char]] -> [[Char]]
presep)
> (\[[Char]]
a ->
> Maybe [[Char]]
-> ([[Char]] -> Maybe [[Char]]) -> Maybe [[Char]] -> Maybe [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just ([[Char]] -> Maybe [[Char]]) -> [[Char]] -> Maybe [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
presep [[Char]]
a) ([[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just ([[Char]] -> Maybe [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Maybe [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
(++) ([[Char]] -> [[Char]]
presep [[Char]]
a))
> )
> m :: Maybe [Char] -> Maybe [[Char]] -> Maybe [[Char]]
m = Maybe [[Char]] -> Maybe [[Char]] -> Maybe [[Char]]
multisep (Maybe [[Char]] -> Maybe [[Char]] -> Maybe [[Char]])
-> (Maybe [Char] -> Maybe [[Char]])
-> Maybe [Char]
-> Maybe [[Char]]
-> Maybe [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [[Char]]) -> Maybe [Char] -> Maybe [[Char]]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> [[Char]]
lines
>
>
>
> extractSymbolsATT :: String -> (String, String, String)
>
> = [[Char]] -> ([Char], [Char], [Char])
forall {a}. [[a]] -> ([a], [a], [a])
f ([[Char]] -> ([Char], [Char], [Char]))
-> ([Char] -> [[Char]]) -> [Char] -> ([Char], [Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> [Char]
unlines ([[[Char]]] -> [[Char]])
-> ([Char] -> [[[Char]]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [[Char]] -> [[[Char]]]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty [[Char]] -> [[[Char]]])
-> ([Char] -> NonEmpty [[Char]]) -> [Char] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> NonEmpty [[Char]]
forall a. Eq a => a -> [a] -> NonEmpty [a]
splitOn [Char]
separator ([[Char]] -> NonEmpty [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> NonEmpty [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
> where f :: [[a]] -> ([a], [a], [a])
f ([a]
x:[a]
y:[a]
z:[[a]]
_) = ([a]
x, [a]
y, [a]
z)
> f ([a]
x:[a]
y:[[a]]
_) = ([a]
x, [a]
y, [])
> f ([a]
x:[[a]]
_) = ([a]
x, [], [])
> f [[a]]
_ = ([], [], [])
>
>
> invertATT :: String -> String
> invertATT :: [Char] -> [Char]
invertATT [Char]
s = [Char] -> Maybe [Char] -> Maybe [Char] -> [Char]
embedSymbolsATT [Char]
ts' ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
o) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
i)
> where ([Char]
ts, [Char]
i, [Char]
o) = [Char] -> ([Char], [Char], [Char])
extractSymbolsATT [Char]
s
> ts' :: [Char]
ts' = [[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
invertSingle ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
ts
> invertSingle :: [Char] -> [Char]
invertSingle [Char]
t = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall {a}. [a] -> [a]
maybeInvert ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words [Char]
t
> maybeInvert :: [a] -> [a]
maybeInvert (a
a:a
b:a
c:a
d:[a]
xs)
> = a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
> maybeInvert [a]
xs = [a]
xs
Reading an AT&T format automaton
================================
>
>
>
> readATT :: String -> FSA Integer String
> readATT :: [Char] -> FSA Integer [Char]
readATT [Char]
x = FSA [Char] [Char] -> FSA Integer [Char]
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA [Char] [Char] -> FSA Integer [Char])
-> FSA [Char] [Char] -> FSA Integer [Char]
forall a b. (a -> b) -> a -> b
$
> FSA { sigma :: Set [Char]
sigma = Set [Char]
al' Set [Char] -> Set [Char] -> Set [Char]
forall c a. Container c a => c -> c -> c
`union` Set [Char]
as
> , transitions :: Set (Transition [Char] [Char])
transitions = Set (Transition [Char] [Char])
ts
> , initials :: Set (State [Char])
initials = State [Char] -> Set (State [Char])
forall c a. Container c a => a -> c
singleton State [Char]
qi
> , finals :: Set (State [Char])
finals = Set (State [Char])
fs
> , isDeterministic :: Bool
isDeterministic = Bool
False
> }
> where ([Char]
es, [Char]
i, [Char]
_) = [Char] -> ([Char], [Char], [Char])
extractSymbolsATT [Char]
x
> (Map [Char] [Char]
al, Maybe [Char]
eps) = [[Char]] -> (Map [Char] [Char], Maybe [Char])
makeAlphabet ([Char] -> [[Char]]
lines [Char]
i)
> al' :: Set [Char]
al' = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList ([[Char]] -> Set [Char]) -> [[Char]] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ Map [Char] [Char] -> [[Char]]
forall k a. Map k a -> [a]
Map.elems Map [Char] [Char]
al
> (Set (Transition [Char] [Char])
ts,Set [Char]
as,State [Char]
qi,Set (State [Char])
fs) = [[Char]]
-> Map [Char] [Char]
-> Maybe [Char]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
makeTransitions ([Char] -> [[Char]]
lines [Char]
es) Map [Char] [Char]
al Maybe [Char]
eps
> makeAlphabet :: [String] -> (Map String String, Maybe String)
> makeAlphabet :: [[Char]] -> (Map [Char] [Char], Maybe [Char])
makeAlphabet [[Char]]
ss = (Map [Char] [Char], Maybe [Char])
-> [([Char], [Char])] -> (Map [Char] [Char], Maybe [Char])
forall {a}.
(Map [Char] a, Maybe a) -> [(a, [Char])] -> (Map [Char] a, Maybe a)
findEps (Map [Char] [Char]
forall k a. Map k a
Map.empty, Maybe [Char]
forall a. Maybe a
Nothing) [([Char], [Char])]
ps
> where ps :: [([Char], [Char])]
ps = ([Char] -> [([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])] -> [[Char]] -> [([Char], [Char])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[Char]] -> [([Char], [Char])] -> [([Char], [Char])]
forall {b}. [b] -> [(b, b)] -> [(b, b)]
maybeInsert ([[Char]] -> [([Char], [Char])] -> [([Char], [Char])])
-> ([Char] -> [[Char]])
-> [Char]
-> [([Char], [Char])]
-> [([Char], [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words) [] [[Char]]
ss
> maybeInsert :: [b] -> [(b, b)] -> [(b, b)]
maybeInsert (b
a:b
b:[b]
_) = (:) (b
a, b
b)
> maybeInsert [b]
_ = [(b, b)] -> [(b, b)]
forall a. a -> a
id
> findEps :: (Map [Char] a, Maybe a) -> [(a, [Char])] -> (Map [Char] a, Maybe a)
findEps (Map [Char] a
l, Maybe a
x) [] = (Map [Char] a
l, Maybe a
x)
> findEps (Map [Char] a
l, Maybe a
x) ((a
s, [Char]
t):[(a, [Char])]
as)
> = ((Map [Char] a, Maybe a)
-> [(a, [Char])] -> (Map [Char] a, Maybe a))
-> [(a, [Char])]
-> (Map [Char] a, Maybe a)
-> (Map [Char] a, Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Map [Char] a, Maybe a) -> [(a, [Char])] -> (Map [Char] a, Maybe a)
findEps [(a, [Char])]
as ((Map [Char] a, Maybe a) -> (Map [Char] a, Maybe a))
-> (Map [Char] a, Maybe a) -> (Map [Char] a, Maybe a)
forall a b. (a -> b) -> a -> b
$
> if [Char]
t [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"0" then (Map [Char] a
l, a -> Maybe a
forall a. a -> Maybe a
Just a
s) else ([Char] -> a -> Map [Char] a -> Map [Char] a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
t a
s Map [Char] a
l, Maybe a
x)
> makeTransitions :: [String] -> Map String String -> Maybe String ->
> ( Set (Transition String String)
> , Set String
> , State String
> , Set (State String)
> )
> makeTransitions :: [[Char]]
-> Map [Char] [Char]
-> Maybe [Char]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
makeTransitions [[Char]]
ss Map [Char] [Char]
tags Maybe [Char]
meps
> = ([Char]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char])))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
-> [[Char]]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[Char]]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
update ([[Char]]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char])))
-> ([Char] -> [[Char]])
-> [Char]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words)
> (Set (Transition [Char] [Char])
forall a. Set a
Set.empty, Set [Char]
forall a. Set a
Set.empty, [Char] -> State [Char]
forall n. n -> State n
State [Char]
"", Set (State [Char])
forall a. Set a
Set.empty)
> [[Char]]
ss
> where symbolify :: [Char] -> Maybe [Char]
symbolify [Char]
x
> | [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"0" = Maybe [Char]
forall a. Maybe a
Nothing
> | [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
x Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [Char]
meps = Maybe [Char]
forall a. Maybe a
Nothing
> | Bool
otherwise = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> (Maybe [Char] -> [Char]) -> Maybe [Char] -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
x (Maybe [Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Map [Char] [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
x Map [Char] [Char]
tags
> update :: [[Char]]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
update [[Char]
a] (Set (Transition [Char] [Char])
ts, Set [Char]
as, State [Char]
qi, Set (State [Char])
fs)
> = (Set (Transition [Char] [Char])
ts, Set [Char]
as, State [Char]
qi, State [Char] -> Set (State [Char]) -> Set (State [Char])
forall a. Ord a => a -> Set a -> Set a
Set.insert ([Char] -> State [Char]
forall n. n -> State n
State [Char]
a) Set (State [Char])
fs)
> update [[Char]
a,[Char]
_] (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
partial
> = [[Char]]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
update [[Char]
a] (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
partial
> update ([Char]
s:[Char]
d:[Char]
l:[[Char]]
_) (Set (Transition [Char] [Char])
ts, Set [Char]
as, State [Char]
_, Set (State [Char])
fs)
> = ( (Transition [Char] [Char]
-> Set (Transition [Char] [Char])
-> Set (Transition [Char] [Char]))
-> Set (Transition [Char] [Char])
-> Transition [Char] [Char]
-> Set (Transition [Char] [Char])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Transition [Char] [Char]
-> Set (Transition [Char] [Char]) -> Set (Transition [Char] [Char])
forall a. Ord a => a -> Set a -> Set a
Set.insert Set (Transition [Char] [Char])
ts (Transition [Char] [Char] -> Set (Transition [Char] [Char]))
-> Transition [Char] [Char] -> Set (Transition [Char] [Char])
forall a b. (a -> b) -> a -> b
$
> Transition
> { source :: State [Char]
source = [Char] -> State [Char]
forall n. n -> State n
State [Char]
s
> , destination :: State [Char]
destination = [Char] -> State [Char]
forall n. n -> State n
State [Char]
d
> , edgeLabel :: Symbol [Char]
edgeLabel = Symbol [Char]
-> ([Char] -> Symbol [Char]) -> Maybe [Char] -> Symbol [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Symbol [Char]
forall e. Symbol e
Epsilon [Char] -> Symbol [Char]
forall e. e -> Symbol e
Symbol (Maybe [Char] -> Symbol [Char]) -> Maybe [Char] -> Symbol [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
symbolify [Char]
l
> }
> , Set [Char] -> ([Char] -> Set [Char]) -> Maybe [Char] -> Set [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set [Char]
as ([Char] -> Set [Char] -> Set [Char]
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set [Char]
as) (Maybe [Char] -> Set [Char]) -> Maybe [Char] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
symbolify [Char]
l
> , [Char] -> State [Char]
forall n. n -> State n
State [Char]
s
> , Set (State [Char])
fs
> )
> update [[Char]]
_ (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
partial = (Set (Transition [Char] [Char]), Set [Char], State [Char],
Set (State [Char]))
partial
Creating an AT&T format automaton
=================================
>
>
>
>
>
>
> exportATT :: (Ord n, Ord e, Show e) => FSA n e -> String
> exportATT :: forall n e. (Ord n, Ord e, Show e) => FSA n e -> [Char]
exportATT FSA n e
f = [[Char]] -> [Char]
unlines
> ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [(e, Int)] -> Set (State Integer) -> [[Char]]
forall n e.
(Ord n, Ord e, Show n, Show e, Num n) =>
[(e, Int)] -> Set (State n) -> [[Char]]
dumpInitials [(e, Int)]
tags (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
initials FSA Integer e
f')
> [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [(e, Int)]
-> Set (State Integer, State Integer, Symbol e)
-> Set (State Integer)
-> [[Char]]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)]
-> Set (State n, State n, Symbol e) -> Set (State n) -> [[Char]]
dumpTransitions [(e, Int)]
tags Set (State Integer, State Integer, Symbol e)
ts (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
initials FSA Integer e
f')
> [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [(e, Int)]
-> Set (State Integer, State Integer, Symbol e)
-> Set (State Integer)
-> [[Char]]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)]
-> Set (State n, State n, Symbol e) -> Set (State n) -> [[Char]]
dumpTransitions [(e, Int)]
tags Set (State Integer, State Integer, Symbol e)
ts (Set (State Integer) -> Set (State Integer) -> Set (State Integer)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (FSA Integer e -> Set (State Integer)
forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states FSA Integer e
f')
> (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
initials FSA Integer e
f'))
> [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Set (State Integer) -> [[Char]]
forall n. (Ord n, Show n) => Set (State n) -> [[Char]]
dumpFinals (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
finals FSA Integer e
f')
> [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
syms [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
syms
> where tags :: [(e, Int)]
tags = ([e] -> [Int] -> [(e, Int)]) -> [Int] -> [e] -> [(e, Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [e] -> [Int] -> [(e, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([e] -> [(e, Int)]) -> (Set e -> [e]) -> Set e -> [(e, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set e -> [e]
forall a. Set a -> [a]
Set.toAscList (Set e -> [(e, Int)]) -> Set e -> [(e, Int)]
forall a b. (a -> b) -> a -> b
$ FSA Integer e -> Set e
forall e. FSA Integer e -> Set e
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet FSA Integer e
f'
> syms :: [[Char]]
syms = [Char]
separator [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [(e, Int)] -> [[Char]]
forall e. (Ord e, Show e) => [(e, Int)] -> [[Char]]
dumpAlphabet [(e, Int)]
tags
> f' :: FSA Integer e
f' = if Set (State n) -> Int
forall a. Set a -> Int
Set.size (FSA n e -> Set (State n)
forall n e. FSA n e -> Set (State n)
initials FSA n e
f) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
> then (Integer -> Integer) -> FSA Integer e -> FSA Integer e
forall e n n1.
(Ord e, Ord n, Ord n1) =>
(n -> n1) -> FSA n e -> FSA n1 e
renameStatesBy (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
subtract (Integer
1::Integer)) (FSA Integer e -> FSA Integer e) -> FSA Integer e -> FSA Integer e
forall a b. (a -> b) -> a -> b
$
> FSA n e -> FSA Integer e
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates FSA n e
f
> else FSA n e -> FSA Integer e
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates FSA n e
f
> ts :: Set (State Integer, State Integer, Symbol e)
ts = (Transition Integer e -> (State Integer, State Integer, Symbol e))
-> Set (Transition Integer e)
-> Set (State Integer, State Integer, Symbol e)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Transition Integer e
t -> (Transition Integer e -> State Integer
forall n e. Transition n e -> State n
source Transition Integer e
t, Transition Integer e -> State Integer
forall n e. Transition n e -> State n
destination Transition Integer e
t, Transition Integer e -> Symbol e
forall n e. Transition n e -> Symbol e
edgeLabel Transition Integer e
t)) (Set (Transition Integer e)
-> Set (State Integer, State Integer, Symbol e))
-> Set (Transition Integer e)
-> Set (State Integer, State Integer, Symbol e)
forall a b. (a -> b) -> a -> b
$
> FSA Integer e -> Set (Transition Integer e)
forall n e. FSA n e -> Set (Transition n e)
transitions FSA Integer e
f'
> dumpAlphabet :: (Ord e, Show e) => [(e, Int)] -> [String]
> dumpAlphabet :: forall e. (Ord e, Show e) => [(e, Int)] -> [[Char]]
dumpAlphabet [(e, Int)]
tags = [Char] -> Int -> [Char]
forall {a}. Show a => a -> Int -> [Char]
p [Char]
defaultEpsilon Int
0 [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ((e, Int) -> [Char]) -> [(e, Int)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((e -> Int -> [Char]) -> (e, Int) -> [Char]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry e -> Int -> [Char]
forall {a}. Show a => a -> Int -> [Char]
p) [(e, Int)]
tags
> where p :: a -> Int -> [Char]
p a
a Int
t = [Char] -> [Char]
deescape (a -> [Char]
forall a. Show a => a -> [Char]
showish a
a) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\t" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
0 :: Int))
> dumpInitials :: (Ord n, Ord e, Show n, Show e, Num n) =>
> [(e, Int)] -> Set (State n) -> [String]
> dumpInitials :: forall n e.
(Ord n, Ord e, Show n, Show e, Num n) =>
[(e, Int)] -> Set (State n) -> [[Char]]
dumpInitials [(e, Int)]
tags Set (State n)
qis
> | Set (State n) -> Int
forall a. Set a -> Int
Set.size Set (State n)
qis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = []
> | Bool
otherwise = (State n -> [Char]) -> [State n] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\State n
q -> [(e, Int)] -> (State n, State n, Symbol e) -> [Char]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)] -> (State n, State n, Symbol e) -> [Char]
dumpTr [(e, Int)]
tags (n -> State n
forall n. n -> State n
State n
0, State n
q, Symbol e
forall e. Symbol e
eps))
> ([State n] -> [[Char]]) -> [State n] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Set (State n) -> [State n]
forall a. Set a -> [a]
Set.toAscList Set (State n)
qis
> where eps :: Symbol e
eps = Symbol e
forall e. Symbol e
Epsilon
> dumpTransitions :: (Ord n, Ord e, Show n, Show e) =>
> [(e, Int)] -> Set (State n, State n, Symbol e) ->
> Set (State n) ->
> [String]
> dumpTransitions :: forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)]
-> Set (State n, State n, Symbol e) -> Set (State n) -> [[Char]]
dumpTransitions [(e, Int)]
tags Set (State n, State n, Symbol e)
ts Set (State n)
qs = ((State n, State n, Symbol e) -> [Char])
-> [(State n, State n, Symbol e)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([(e, Int)] -> (State n, State n, Symbol e) -> [Char]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)] -> (State n, State n, Symbol e) -> [Char]
dumpTr [(e, Int)]
tags) ([(State n, State n, Symbol e)] -> [[Char]])
-> [(State n, State n, Symbol e)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Set (State n, State n, Symbol e) -> [(State n, State n, Symbol e)]
forall a. Set a -> [a]
Set.toAscList Set (State n, State n, Symbol e)
ts'
> where ts' :: Set (State n, State n, Symbol e)
ts' = ((State n, State n, Symbol e) -> Bool)
-> Set (State n, State n, Symbol e)
-> Set (State n, State n, Symbol e)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\(State n
a,State n
_,Symbol e
_) -> Set (State n) -> State n -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn Set (State n)
qs State n
a) Set (State n, State n, Symbol e)
ts
> dumpTr :: (Ord n, Ord e, Show n, Show e) =>
> [(e, Int)] -> (State n, State n, Symbol e) -> String
> dumpTr :: forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)] -> (State n, State n, Symbol e) -> [Char]
dumpTr [(e, Int)]
tags (State n
s, State n
d, Symbol e
l)
> = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t"
> [n -> [Char]
forall a. Show a => a -> [Char]
show (n -> [Char]) -> n -> [Char]
forall a b. (a -> b) -> a -> b
$ State n -> n
forall n. State n -> n
nodeLabel State n
s, n -> [Char]
forall a. Show a => a -> [Char]
show (n -> [Char]) -> n -> [Char]
forall a b. (a -> b) -> a -> b
$ State n -> n
forall n. State n -> n
nodeLabel State n
d, [Char]
l', [Char]
l']
> where l' :: [Char]
l' = case Symbol e
l
> of Symbol e
e -> e -> [Char]
f e
e
> Symbol e
_ -> [Char]
defaultEpsilon
> f :: e -> [Char]
f e
e
> | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit (e -> [Char]
forall a. Show a => a -> [Char]
showish e
e)
> = [Char] -> [[Char]] -> [Char]
forall {a}. a -> [a] -> a
h (e -> [Char]
forall a. Show a => a -> [Char]
showish e
e) ([[Char]] -> [Char])
-> ([(e, Int)] -> [[Char]]) -> [(e, Int)] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((e, Int) -> [Char]) -> [(e, Int)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Char]
forall a. Show a => a -> [Char]
showish (Int -> [Char]) -> ((e, Int) -> Int) -> (e, Int) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, Int) -> Int
forall a b. (a, b) -> b
snd)
> ([(e, Int)] -> [Char]) -> [(e, Int)] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((e, Int) -> Bool) -> [(e, Int)] -> [(e, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
e) (e -> Bool) -> ((e, Int) -> e) -> (e, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, Int) -> e
forall a b. (a, b) -> a
fst) [(e, Int)]
tags
> | Bool
otherwise = [Char] -> [Char]
deescape (e -> [Char]
forall a. Show a => a -> [Char]
showish e
e)
> where h :: a -> [a] -> a
h a
_ (a
x:[a]
_) = a
x
> h a
x [] = a
x
> dumpFinals :: (Ord n, Show n) => Set (State n) -> [String]
> dumpFinals :: forall n. (Ord n, Show n) => Set (State n) -> [[Char]]
dumpFinals = (State n -> [Char]) -> [State n] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (n -> [Char]
forall a. Show a => a -> [Char]
show (n -> [Char]) -> (State n -> n) -> State n -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State n -> n
forall n. State n -> n
nodeLabel) ([State n] -> [[Char]])
-> (Set (State n) -> [State n]) -> Set (State n) -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (State n) -> [State n]
forall a. Set a -> [a]
Set.toAscList
Helpers
=======
> splitOn :: Eq a => a -> [a] -> NonEmpty [a]
> splitOn :: forall a. Eq a => a -> [a] -> NonEmpty [a]
splitOn a
_ [] = [] [a] -> [[a]] -> NonEmpty [a]
forall a. a -> [a] -> NonEmpty a
:| []
> splitOn a
b (a
a:[a]
as)
> | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = [] [a] -> [[a]] -> NonEmpty [a]
forall a. a -> [a] -> NonEmpty a
:| NonEmpty [a] -> [[a]]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty [a]
x
> | Bool
otherwise = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:NonEmpty [a] -> [a]
forall a. NonEmpty a -> a
NE.head NonEmpty [a]
x) [a] -> [[a]] -> NonEmpty [a]
forall a. a -> [a] -> NonEmpty a
:| NonEmpty [a] -> [[a]]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty [a]
x
> where x :: NonEmpty [a]
x = a -> [a] -> NonEmpty [a]
forall a. Eq a => a -> [a] -> NonEmpty [a]
splitOn a
b [a]
as
> showish :: Show a => a -> String
> showish :: forall a. Show a => a -> [Char]
showish = [Char] -> [Char]
f ([Char] -> [Char]) -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show
> where f :: [Char] -> [Char]
f [Char]
xs = if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
xs [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"\"" then [Char] -> [Char]
f' (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
xs) else [Char]
xs
> f' :: [Char] -> [Char]
f' [Char]
"" = [Char]
""
> f' [Char]
"\"" = [Char]
""
> f' (Char
x:[Char]
xs) = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
f' [Char]
xs
> deescape :: String -> String
> deescape :: [Char] -> [Char]
deescape (Char
'\\' : Char
'&' : [Char]
xs) = [Char] -> [Char]
deescape [Char]
xs
> deescape (Char
'\\' : Char
x : [Char]
xs)
> | [Char] -> Bool
forall c a. Container c a => c -> Bool
isEmpty [Char]
digits = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
deescape [Char]
xs
> | Bool
otherwise = Int -> Char
forall a. Enum a => Int -> a
toEnum ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
digits) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
deescape [Char]
others
> where ([Char]
digits, [Char]
others) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ([Char] -> Char -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn [Char]
"0123456789") (Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs)
> deescape (Char
x:[Char]
xs) = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
deescape [Char]
xs
> deescape [Char]
_ = []