diff --git a/HaLeX.cabal b/HaLeX.cabal --- a/HaLeX.cabal +++ b/HaLeX.cabal @@ -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 diff --git a/HaLeX_lib/Language/HaLex/DfaMonad.lhs b/HaLeX_lib/Language/HaLex/DfaMonad.lhs --- a/HaLeX_lib/Language/HaLex/DfaMonad.lhs +++ b/HaLeX_lib/Language/HaLex/DfaMonad.lhs @@ -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))])) diff --git a/HaLeX_lib/Language/HaLex/FaAsDiGraph.hs b/HaLeX_lib/Language/HaLex/FaAsDiGraph.hs --- a/HaLeX_lib/Language/HaLex/FaAsDiGraph.hs +++ b/HaLeX_lib/Language/HaLex/FaAsDiGraph.hs @@ -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