Modified Animate.lua: Modified event removal function to check if removed event is before current one, added optional parameter to RemoveEventFunc for optional checking of parameter list identicity.
module Main whereimport PascalParserimport Systemimport Control.Monadimport Data.Eitherimport Data.Listimport Data.Graphimport Data.Maybeunident :: Identificator -> Stringunident (Identificator s) = sextractUnits :: PascalUnit -> (String, [String])extractUnits (Program (Identificator name) (Implementation (Uses idents) _ _) _) = ("program " ++ name, map unident idents)extractUnits (Unit (Identificator name) (Interface (Uses idents1) _) (Implementation (Uses idents2) _ _) _ _) = (name, map unident $ idents1 ++ idents2)f :: [(String, [String])] -> Stringf = unlines . map showSCC . stronglyConnComp . map (\(a, b) -> (a, a, b)) where showSCC (AcyclicSCC v) = v showSCC (CyclicSCC vs) = intercalate ", " vsmyf :: [(String, [String])] -> Stringmyf d = unlines . map (findCycle . fst) $ d where findCycle :: String -> String findCycle searched = searched ++ ": " ++ (intercalate ", " $ fc searched []) where fc :: String -> [String] -> [String] fc curSearch visited = let uses = curSearch `lookup` d; res = dropWhile null . map t $ fromJust uses in if isNothing uses || null res then [] else head res where t u = if u == searched then [u] else if u `elem` visited then [] else let chain = fc u (u:visited) in if null chain then [] else u:chainmain = do fileNames <- getArgs files <- mapM readFile fileNames putStrLn . myf . map extractUnits . rights . map parsePascalUnit $ files