HaLeX 1.1.1 → 1.2
raw patch · 3 files changed
+58/−59 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- HaLeX.cabal +4/−5
- HaLeX_lib/Language/HaLex/DfaMonad.lhs +9/−9
- HaLeX_lib/Language/HaLex/FaAsDiGraph.hs +45/−45
HaLeX.cabal view
@@ -1,5 +1,5 @@ name: HaLeX-version: 1.1.1+version: 1.2 synopsis: HaLeX enables modelling, manipulation and animation of regular languages description: This library was developed in the context of a programming methodology course for undergraduate students, and as a consequence, it was defined mainly for educational purposes.@@ -21,10 +21,10 @@ extra-source-files: scripts/Make_Animation, scripts/faAnim.lefty, example/real, example/real_dfa.hs, example/real_ndfa.hs, example/GenMDfa.hs Library- build-depends: base, mtl+ build-depends: base>4 && <5, mtl extensions: FlexibleContexts, FlexibleInstances, MultiParamTypeClasses - ghc-options: -O2 -Wall+ ghc-options: -Wall ghc-prof-options: -prof -auto-all hs-source-dirs: HaLeX_lib@@ -35,9 +35,8 @@ Language.HaLex.FaOperations, Language.HaLex.Util, Language.HaLex.Equivalence Executable halex- executable: halex main-is: halex.hs hs-source-dirs: HaLeX_tool, HaLeX_lib - ghc-options: -O2 -Wall + ghc-options: -Wall ghc-prof-options: -prof -auto-all
HaLeX_lib/Language/HaLex/DfaMonad.lhs view
@@ -347,7 +347,7 @@ delta 'B' 'a' = do countA return 'C' - countA = State f+ countA = state f where f s = ((),s+1) runAccept dfa str = runState (dfaaccept dfa str) 0@@ -436,10 +436,10 @@ delta 3 'd' = do accumD return 3 - accumM = State f+ accumM = state f where f s = (s,'-':s) - accumD = State f+ accumD = state f where f s = (s,'d':s) @@ -484,10 +484,10 @@ delta _ _ = return 5 -- To complete the DFA - accum x = State f+ accum x = state f where f s = ((),((fst s)++[x],snd s)) - convert = State f+ convert = state f where f s = ((),(fst s,(read (fst s))::Int)) @@ -551,16 +551,16 @@ delta _ _ = return 20 - accum x = State f+ accum x = state f where f s = ((),((fst s)++[x],snd s)) - init = State f+ init = state f where f s = ((),("",snd s)) - open = State f+ open = state f where f s = ((),(fst s,(snd s) ++ [Open (fst s)])) - locate = State f+ locate = state f where f s = ((),(fst s,(snd s) ++ [Locate (read (fst s))]))
HaLeX_lib/Language/HaLex/FaAsDiGraph.hs view
@@ -3,21 +3,21 @@ -- Module : Language.HaLex.FaAsDiGraph -- Copyright : (c) João Saraiva 2001,2002,2003,2004,2005 -- License : LGPL--- +-- -- Maintainer : jas@di.uminho.pt -- Stability : provisional -- Portability : portable ----- Finite Automata as Directed Graphs in GraphViz. --- Code Included in the Lecture Notes on --- Language Processing (with a functional flavour). +-- Finite Automata as Directed Graphs in GraphViz.+-- Code Included in the Lecture Notes on+-- Language Processing (with a functional flavour). -- ----------------------------------------------------------------------------- -module Language.HaLex.FaAsDiGraph ( +module Language.HaLex.FaAsDiGraph ( ndfa2graphviz , ndfa2graphviz2file- , dfa2graphviz + , dfa2graphviz , dfa2graphviz2file , tographviz , tographvizIO@@ -31,82 +31,82 @@ import Language.HaLex.Ndfa import Language.HaLex.Dfa import Language.HaLex.FaOperations-import Language.HaLex.Minimize +import Language.HaLex.Minimize -- | Print a 'Ndfa' in GraphViz-ndfa2graphviz ndfa name = tographviz ndfa name "circle" "LR" show +ndfa2graphviz ndfa name = tographviz ndfa name "circle" "LR" (show . show) -- | Print a 'Ndfa' in GraphViz in a file-ndfa2graphviz2file ndfa name = writeFile (name++".dot") (ndfa2graphviz ndfa name) +ndfa2graphviz2file ndfa name = writeFile (name++".dot") (ndfa2graphviz ndfa name) -- | Print a 'Dfa' in GraphViz-dfa2graphviz dfa name = tographviz (dfa2ndfa dfa) name "circle" "LR" show +dfa2graphviz dfa name = tographviz (dfa2ndfa dfa) name "circle" "LR" (show . show) -- | Print a 'Dfa' in GraphViz in a file-dfa2graphviz2file dfa name = writeFile (name++".dot") (dfa2graphviz dfa name) +dfa2graphviz2file dfa name = writeFile (name++".dot") (dfa2graphviz dfa name) -- | Print a 'Ndfa' in GraphViz -tographviz :: (Eq sy, Show sy, Ord st , Show st) +tographviz :: (Eq sy, Show sy, Ord st , Show st) => Ndfa st sy -- ^ Automaton -> [Char] -- ^ Graph's name -> [Char] -- ^ Node's shape -> [Char] -- ^ Orientation -> (st -> [Char]) -- ^ Show function to print the state ids -> [Char]-tographviz ndfa@(Ndfa v q s z delta) name shape orientation showState = - "digraph " ++ name ++ " {\n " - ++ "rankdir = " ++ orientation ++ " ;\n " - ++ (showElemsListPerLine (showStates q)) ++ "\n " - ++ (showElemsListPerLine (showInitialStates s)) ++ "\n " +tographviz ndfa@(Ndfa v q s z delta) name shape orientation showState =+ "digraph " ++ name ++ " {\n "+ ++ "rankdir = " ++ orientation ++ " ;\n "+ ++ (showElemsListPerLine (showStates q)) ++ "\n "+ ++ (showElemsListPerLine (showInitialStates s)) ++ "\n " ++ (showElemsListPerLine (showFinalStates' z))- ++ (showElemsListPerLine (showNdfaArrows'' ndfa)) + ++ (showElemsListPerLine (showNdfaArrows'' ndfa)) ++ "node [shape=none, lavel=initialState, style = invis];\n" ++ (createInitialArrows (mirroredInitialStates s) s) ++ "\n}"- where + where showElemsListPerLine :: [String] -> String showElemsListPerLine [] = ""- showElemsListPerLine (h:t) = ((showString h) "\n ") ++ - (showElemsListPerLine t) + showElemsListPerLine (h:t) = ((showString h) "\n ") +++ (showElemsListPerLine t) - showStates qs = [(showState q) ++ - " [shape=" ++ shape ++" , label=" ++ (showState q) ++ " ,color=black];" + showStates qs = [(showState q) +++ " [shape=" ++ shape ++" , label=" ++ (showState q) ++ " ,color=black];" | q <- qs , not (ndfaIsStDead delta v z q ) ]- + showInitialStates ss = map showInitialState ss - showInitialState s = (showState s) - ++ " [shape=" ++ shape ++ " , label= " ++ (showState s) - ++ ", color=green];\n " + showInitialState s = (showState s)+ ++ " [shape=" ++ shape ++ " , label= " ++ (showState s)+ ++ ", color=green];\n " -- showFinalStates' :: Show a => [a] -> [String]- showFinalStates' zs = [ (showState z) + showFinalStates' zs = [ (showState z) ++ " [shape=double" ++ shape ++" , color=red];" | z <- zs ] -- showNdfaArrows' :: (Eq sy, Show sy) => Ndfa st sy -> [String] showNdfaArrows' ndfa- = map (\ (o,l,d) -> genOneArrow (showState o) (show l) (showState d)) + = map (\ (o,l,d) -> genOneArrow (showState o) (show l) (showState d)) ((groupMoves . transitionTableNdfa) ndfa) -- showNdfaArrows'' :: (Ord st, Eq sy, Show st, Show sy) => Ndfa st sy -> [String] showNdfaArrows'' ndfa@(Ndfa v q s z delta) = map (\ (o,l,d) -> if (ndfaIsStDead delta v z o) || (ndfaIsStDead delta v z d) then ""- else genOneArrow (showState o) (showListMaybe l) (showState d)) + else genOneArrow (showState o) (showListMaybe l) (showState d)) ((groupMoves . transitionTableNdfa) ndfa) -- Creating the incoming arrows for the initial states -- (for each state we create an invisible node and a arrow connecting to the initial one) - mirroredInitialStates = map (\state -> "_newState" ++ (show state)) + mirroredInitialStates = map (\state -> "_newState" ++ (show state)) createInitialArrows [] [] = " "- createInitialArrows (x:xs) (y:ys) = x ++ " -> " ++ (showState y) ++ - "[color = green];\n" ++ + createInitialArrows (x:xs) (y:ys) = x ++ " -> " ++ (showState y) +++ "[color = green];\n" ++ createInitialArrows xs ys @@ -129,24 +129,24 @@ res = (o,l',d) : groupMoves rs' -groupMoves' :: (Eq st, Eq sy) => (st,Maybe sy,st) -> [(st,Maybe sy,st)] +groupMoves' :: (Eq st, Eq sy) => (st,Maybe sy,st) -> [(st,Maybe sy,st)] -> ([Maybe sy],[(st,Maybe sy,st)]) groupMoves' _ [] = ([],[])-groupMoves' (o,l,d) ((o',l',d'):rs) +groupMoves' (o,l,d) ((o',l',d'):rs) | o==o' && d==d' = (new_label,rs') | otherwise = (l'', (o',l',d') : rs')- where (l'',rs') = groupMoves' (o,l,d) rs - new_label = if l'' == [] then [l'] + where (l'',rs') = groupMoves' (o,l,d) rs+ new_label = if l'' == [] then [l'] else l' : l'' showNdfaArrows :: (Ord st,Show st,Show sy) => Ndfa st sy -> [String]-showNdfaArrows (Ndfa vs qs s z delta) = [ genOneArrow (show q) (show v) (show r) - | q <- qs , v <- vs +showNdfaArrows (Ndfa vs qs s z delta) = [ genOneArrow (show q) (show v) (show r)+ | q <- qs , v <- vs , r <- delta q (Just v) , not (ndfaIsStDead delta vs z r ) , not (ndfaIsStDead delta vs z q )- ] ++ + ] ++ [ genOneArrow (show q) "Epsilon" (show r) | q <- qs , r <- delta q Nothing@@ -154,21 +154,21 @@ , not (ndfaIsStDead delta vs z q ) ] -genOneArrow orin label dest = orin - ++ " -> " ++ dest +genOneArrow orin label dest = orin+ ++ " -> " ++ dest ++ " [label = " ++ (show label) ++ "];" -tographvizIO ndfa name shape orientation showState = +tographvizIO ndfa name shape orientation showState = writeFile (name++".dot") (tographviz ndfa name shape orientation showState) dfa2DiGraphWithNoSyncSt dfa name = dfa2graphviz dfa name -dfa2DiGraphIO dfa name fn = writeFile (fn++".gph") (dfa2graphviz dfa name ) +dfa2DiGraphIO dfa name fn = writeFile (fn++".gph") (dfa2graphviz dfa name ) -dfaDiGraphWithNoSyncStIO dfa name fn = writeFile fn (dfa2graphviz dfa name) +dfaDiGraphWithNoSyncStIO dfa name fn = writeFile fn (dfa2graphviz dfa name) -- dfa2DiGraphIO'' :: (Show sy, Ord sy , Eq st) => Dfa st sy -> [Char] -> IO () dfa2DiGraphIO'' dfa name = dfa2DiGraphIO (beautifyDfa dfa) name name