tools/pas2c/PascalBasics.hs
changeset 10113 b26c2772e754
parent 10015 4feced261c68
child 10120 b7f632c12784
--- a/tools/pas2c/PascalBasics.hs	Thu Feb 06 23:02:35 2014 +0400
+++ b/tools/pas2c/PascalBasics.hs	Fri Feb 07 00:46:49 2014 +0400
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}
 module PascalBasics where
 
 import Text.Parsec.Combinator
@@ -7,9 +7,19 @@
 import Text.Parsec.Token
 import Text.Parsec.Language
 import Data.Char
+import Control.Monad
+import Data.Functor.Identity
 
+char' :: Char -> Parsec String u ()
+char' = void . char
+
+string' :: String -> Parsec String u ()
+string' = void . string
+
+builtin :: [String]
 builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"]
 
+pascalLanguageDef :: GenLanguageDef String u Identity
 pascalLanguageDef
     = emptyDef
     { commentStart   = "(*"
@@ -31,40 +41,45 @@
     , caseSensitive  = False
     }
 
-preprocessorSwitch :: Stream s m Char => ParsecT s u m String
+preprocessorSwitch :: Stream String Identity Char => Parsec String u String
 preprocessorSwitch = do
-    try $ string "{$"
+    try $ string' "{$"
     s <- manyTill (noneOf "\n") $ char '}'
     return s
 
+caseInsensitiveString :: Stream String Identity Char => String -> Parsec String u String
 caseInsensitiveString s = do
     mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s
     return s
 
+pas :: GenTokenParser String u Identity
 pas = patch $ makeTokenParser pascalLanguageDef
     where
     patch tp = tp {stringLiteral = stringL}
 
+comment :: Stream String Identity Char => Parsec String u String
 comment = choice [
         char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}')
         , (try $ string "(*") >> manyTill anyChar (try $ string "*)")
         , (try $ string "//") >> manyTill anyChar (try newline)
         ]
 
+comments :: Parsec String u ()
 comments = do
     spaces
     skipMany $ do
-        preprocessorSwitch <|> comment
+        void $ preprocessorSwitch <|> comment
         spaces
 
+stringL :: Parsec String u String
 stringL = do
-    (char '\'')
+    char' '\''
     s <- (many $ noneOf "'")
-    (char '\'')
+    char' '\''
     ss <- many $ do
-        (char '\'')
+        char' '\''
         s' <- (many $ noneOf "'")
-        (char '\'')
+        char' '\''
         return $ '\'' : s'
     comments
     return $ concat (s:ss)