--- 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 "}"