merge, as --rebase didn't work for some reason
authorunc0rr
Sat, 19 Nov 2011 22:42:52 +0300
changeset 6401 b9d9024cf203
parent 6398 33c92c4ac749 (current diff)
parent 6399 a904c735979c (diff)
child 6404 789c17eac2fe
merge, as --rebase didn't work for some reason
--- a/tools/PascalParser.hs	Sat Nov 19 14:29:35 2011 -0500
+++ b/tools/PascalParser.hs	Sat Nov 19 22:42:52 2011 +0300
@@ -9,6 +9,7 @@
 import Text.Parsec.String
 import Control.Monad
 import Data.Char
+import Data.Maybe
 
 data PascalUnit =
     Program Identifier Implementation
@@ -24,7 +25,7 @@
     deriving Show
 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
-    | FunctionDeclaration Identifier TypeDecl (Maybe Phrase)
+    | FunctionDeclaration Identifier TypeDecl (Maybe (TypesAndVars,Phrase))
     deriving Show
 data TypeDecl = SimpleType Identifier
     | RangeType Range
@@ -32,7 +33,7 @@
     | ArrayDecl Range TypeDecl
     | RecordType [TypeVarDeclaration]
     | PointerTo TypeDecl
-    | String
+    | String Integer
     | UnknownType
     deriving Show
 data Range = Range Identifier
@@ -237,7 +238,8 @@
         
 typeDecl = choice [
     char '^' >> typeDecl >>= return . PointerTo
-    , try (string "shortstring") >> return String
+    , try (string "shortstring") >> return (String 255)
+    , try (string "string") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
     , arrayDecl
     , recordDecl
     , sequenceDecl >>= return . Sequence
@@ -324,17 +326,11 @@
         try $ string "procedure"
         comments
         i <- iD
-        optional $ do
-            char '('
-            varsDecl False
-            char ')'
+        optional $ parens pas $ varsDecl False
         comments
         char ';'
+        comments
         b <- if isImpl then
-                do
-                comments
-                optional $ typeVarDeclaration True
-                comments
                 liftM Just functionBody
                 else
                 return Nothing
@@ -345,10 +341,7 @@
         try $ string "function"
         comments
         i <- iD
-        optional $ do
-            char '('
-            varsDecl False
-            char ')'
+        optional $ parens pas $ varsDecl False
         comments
         char ':'
         comments
@@ -357,9 +350,6 @@
         char ';'
         comments
         b <- if isImpl then
-                do
-                optional $ typeVarDeclaration True
-                comments
                 liftM Just functionBody
                 else
                 return Nothing
@@ -540,6 +530,7 @@
         comments
         return o
     string "end"
+    comments
     return $ SwitchCase e cs o2
     where
     aCase = do
@@ -559,10 +550,12 @@
 parameters = (commaSep pas) expression <?> "parameters"
         
 functionBody = do
+    tv <- typeVarDeclaration True
+    comments
     p <- phrasesBlock
     char ';'
     comments
-    return p
+    return (TypesAndVars tv, p)
 
 uses = liftM Uses (option [] u)
     where
--- a/tools/pas2c.hs	Sat Nov 19 14:29:35 2011 -0500
+++ b/tools/pas2c.hs	Sat Nov 19 22:42:52 2011 +0300
@@ -34,10 +34,14 @@
 tvar2C :: TypeVarDeclaration -> Doc
 tvar2C (FunctionDeclaration (Identifier name) returnType Nothing) = 
     type2C returnType <+> text (name ++ "();")
-tvar2C (FunctionDeclaration (Identifier name) returnType (Just phrase)) = 
+tvar2C (FunctionDeclaration (Identifier name) returnType (Just (tvars, phrase))) = 
     type2C returnType <+> text (name ++ "()") 
     $$
+    text "{" $+$ (nest 4 $ typesAndVars2C tvars)
+    $+$
     phrase2C phrase
+    $+$ 
+    text "}"
 tvar2C (TypeDeclaration (Identifier i) t) = text "type" <+> text i <+> type2C t <> text ";"
 tvar2C (VarDeclaration isConst (ids, t) mInitExpr) = 
     if isConst then text "const" else empty
@@ -66,7 +70,7 @@
 
 type2C :: TypeDecl -> Doc
 type2C UnknownType = text "void"
-type2C String = text "string"
+type2C (String l) = text $ "string" ++ show l
 type2C (SimpleType (Identifier i)) = text i
 type2C (PointerTo t) = type2C t <> text "*"
 type2C (RecordType tvs) = text "{" $+$ (nest 4 . vcat . map tvar2C $ tvs) $+$ text "}"