# HG changeset patch
# User unC0Rr
# Date 1289999968 -10800
# Node ID 671d66ba3af664406cf620ed7023e7ea42e8b58c
# Parent  9d155da5b417f4741c6287a0717a166f7cb33f11
Dumb parser of pascal, and a program which lists unit dependencies

diff -r 9d155da5b417 -r 671d66ba3af6 tools/PascalParser.hs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/PascalParser.hs	Wed Nov 17 16:19:28 2010 +0300
@@ -0,0 +1,98 @@
+module PascalParser where
+
+import Text.ParserCombinators.Parsec
+import Control.Monad
+
+data PascalUnit =
+    Program Identificator Implementation FunctionBody
+    | Unit Identificator Interface Implementation (Maybe Initialize) (Maybe Finalize)
+    deriving Show
+
+data Interface = Interface Uses TypesAndVars
+    deriving Show
+data Implementation = Implementation Uses TypesAndVars Functions
+    deriving Show
+data Functions = Functions [Function]
+    deriving Show
+data Function = Function String
+    deriving Show
+data Identificator = Identificator String
+    deriving Show
+data FunctionBody = FunctionBody String
+    deriving Show
+data TypesAndVars = TypesAndVars String
+    deriving Show
+data Initialize = Initialize Functions
+    deriving Show
+data Finalize = Finalize Functions
+    deriving Show
+data Uses = Uses [Identificator]
+    deriving Show
+
+parsePascalUnit :: String -> Either ParseError PascalUnit
+parsePascalUnit = parse pascalUnit "unit"
+    where
+    comments = skipMany (comment >> spaces)
+    identificator = do
+        spaces
+        l <- letter <|> oneOf "_"
+        ls <- many (alphaNum <|> oneOf "_")
+        spaces
+        return $ Identificator (l:ls)
+
+    pascalUnit = do
+        spaces
+        comments
+        u <- choice [program, unit]
+        comments
+        spaces
+        return u
+
+    comment = choice [
+            char '{' >> manyTill anyChar (try $ char '}')
+            , string "(*" >> manyTill anyChar (try $ string "*)")
+            , string "//" >> manyTill anyChar (try newline)
+            ]
+
+    unit = do
+        name <- unitName
+        spaces
+        comments
+        int <- string "interface" >> interface
+        manyTill anyChar (try $ string "implementation")
+        spaces
+        comments
+        impl <- implementation
+        return $ Unit name int impl Nothing Nothing
+        where
+            unitName = between (string "unit") (char ';') identificator
+
+    interface = do
+        spaces
+        comments
+        u <- uses
+        return $ Interface u (TypesAndVars "")
+
+    program = do
+        name <- programName
+        spaces
+        comments
+        impl <- implementation
+        return $ Program name impl (FunctionBody "")
+        where
+            programName = between (string "program") (char ';') identificator
+
+    implementation = do
+        u <- uses
+        manyTill anyChar (try $ string "end.")
+        return $ Implementation u (TypesAndVars "") (Functions [])
+
+    uses = liftM Uses (option [] u)
+        where
+            u = do
+                string "uses"
+                spaces
+                u <- (identificator >>= \i -> spaces >> return i) `sepBy1` (char ',' >> spaces)
+                char ';'
+                spaces
+                return u
diff -r 9d155da5b417 -r 671d66ba3af6 tools/unitCycles.hs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/unitCycles.hs	Wed Nov 17 16:19:28 2010 +0300
@@ -0,0 +1,19 @@
+module Main where
+
+import PascalParser
+import System
+import Control.Monad
+import Data.Either
+import Data.List
+
+unident :: Identificator -> String
+unident (Identificator s) = s
+
+extractUnits :: 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)
+
+main = do
+    fileNames <- getArgs
+    files <- mapM readFile fileNames
+    mapM_ (putStrLn . show . extractUnits) . rights . map parsePascalUnit $ files