--- a/tools/PascalParser.hs Sat Dec 03 19:18:13 2011 +0100
+++ b/tools/PascalParser.hs Sat Dec 03 22:21:23 2011 +0300
@@ -23,7 +23,7 @@
return u
iD = do
- i <- liftM Identifier (identifier pas)
+ i <- liftM (flip Identifier Unknown) (identifier pas)
comments
return i
@@ -62,7 +62,7 @@
t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
e <- parens pas expression
comments
- return $ TypeCast (Identifier t) e
+ return $ TypeCast (Identifier t Unknown) e
varsDecl1 = varsParser sepEndBy1
@@ -124,7 +124,7 @@
, setDecl
, functionType
, sequenceDecl >>= return . Sequence
- , try (identifier pas) >>= return . SimpleType . Identifier
+ , try iD >>= return . SimpleType
, rangeDecl >>= return . RangeType
] <?> "type declaration"
where
@@ -348,7 +348,7 @@
expression = buildExpressionParser table term <?> "expression"
where
term = comments >> choice [
- builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n))
+ builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n Unknown))
, try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e)
, brackets pas (commaSep pas iD) >>= return . SetExpression
, try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
@@ -591,7 +591,7 @@
t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
i <- parens pas initExpression
comments
- return $ InitTypeCast (Identifier t) i
+ return $ InitTypeCast (Identifier t Unknown) i
builtInFunction e = do
name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
--- a/tools/PascalUnitSyntaxTree.hs Sat Dec 03 19:18:13 2011 +0100
+++ b/tools/PascalUnitSyntaxTree.hs Sat Dec 03 22:21:23 2011 +0300
@@ -11,7 +11,7 @@
deriving Show
data Implementation = Implementation Uses TypesAndVars
deriving Show
-data Identifier = Identifier String
+data Identifier = Identifier String BaseType
deriving Show
data TypesAndVars = TypesAndVars [TypeVarDeclaration]
deriving Show
@@ -92,3 +92,17 @@
| InitRange Range
| InitTypeCast Identifier InitExpression
deriving Show
+
+data BaseType = Unknown
+ | BTChar
+ | BTString
+ | BTInt
+ | BTRecord
+ | BTArray
+ | BTFunction
+ | BTPointerTo BaseType
+ | BTSet
+ | BTEnum [String]
+ | Void
+ deriving Show
+
\ No newline at end of file
--- a/tools/pas2c.hs Sat Dec 03 19:18:13 2011 +0100
+++ b/tools/pas2c.hs Sat Dec 03 22:21:23 2011 +0300
@@ -75,7 +75,7 @@
pascal2C (Program _ implementation mainFunction) =
implementation2C implementation
$+$
- tvar2C True (FunctionDeclaration (Identifier "main") (SimpleType $ Identifier "int") [] (Just (TypesAndVars [], mainFunction)))
+ tvar2C True (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [] (Just (TypesAndVars [], mainFunction)))
interface2C :: Interface -> Doc
@@ -92,12 +92,12 @@
uses2C uses = vcat $ map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses
uses2List :: Uses -> [String]
-uses2List (Uses ids) = map (\(Identifier i) -> i) ids
+uses2List (Uses ids) = map (\(Identifier i _) -> i) ids
tvar2C :: Bool -> TypeVarDeclaration -> Doc
-tvar2C _ (FunctionDeclaration (Identifier name) returnType params Nothing) =
+tvar2C _ (FunctionDeclaration (Identifier name _) returnType params Nothing) =
type2C returnType <+> text name <> parens (hcat $ map (tvar2C False) params) <> text ";"
-tvar2C True (FunctionDeclaration (Identifier name) returnType params (Just (tvars, phrase))) =
+tvar2C True (FunctionDeclaration (Identifier name _) returnType params (Just (tvars, phrase))) =
type2C returnType <+> text name <> parens (hcat $ map (tvar2C False) params)
$+$
text "{"
@@ -111,14 +111,14 @@
where
phrase2C' (Phrases p) = vcat $ map phrase2C p
phrase2C' p = phrase2C p
-tvar2C False (FunctionDeclaration (Identifier name) _ _ _) = error $ "nested functions not allowed: " ++ name
-tvar2C _ (TypeDeclaration (Identifier i) t) = text "type" <+> text i <+> type2C t <> text ";"
+tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name
+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
<+>
type2C t
<+>
- (hsep . punctuate (char ',') . map (\(Identifier i) -> text i) $ ids)
+ (hsep . punctuate (char ',') . map (\(Identifier i _) -> text i) $ ids)
<+>
initExpr mInitExpr
<>
@@ -127,7 +127,7 @@
initExpr Nothing = empty
initExpr (Just e) = text "=" <+> initExpr2C e
tvar2C f (OperatorDeclaration op _ ret params body) =
- tvar2C f (FunctionDeclaration (Identifier $ "<op " ++ op ++ ">") ret params body)
+ tvar2C f (FunctionDeclaration (Identifier ("<op " ++ op ++ ">") Unknown) ret params body)
initExpr2C :: InitExpression -> Doc
initExpr2C (InitBinOp op expr1 expr2) = parens $ (initExpr2C expr1) <+> op2C op <+> (initExpr2C expr2)
@@ -135,7 +135,7 @@
initExpr2C (InitFloat s) = text s
initExpr2C (InitHexNumber s) = text "0x" <> (text . map toLower $ s)
initExpr2C (InitString s) = doubleQuotes $ text s
-initExpr2C (InitReference (Identifier i)) = text i
+initExpr2C (InitReference (Identifier i _)) = text i
initExpr2C _ = text "<<expression>>"
@@ -143,7 +143,7 @@
type2C :: TypeDecl -> Doc
type2C UnknownType = text "void"
type2C (String l) = text $ "string" ++ show l
-type2C (SimpleType (Identifier i)) = text i
+type2C (SimpleType (Identifier i _)) = text i
type2C (PointerTo t) = type2C t <> text "*"
type2C (RecordType tvs union) = text "{" $+$ (nest 4 . vcat . map (tvar2C False) $ tvs) $+$ text "}"
type2C (RangeType r) = text "<<range type>>"
@@ -167,7 +167,7 @@
case2C :: ([InitExpression], Phrase) -> Doc
case2C (e, p) = text "case" <+> parens (hsep . punctuate (char ',') . map initExpr2C $ e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;")
phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p)
-phrase2C (ForCycle (Identifier i) e1 e2 p) =
+phrase2C (ForCycle (Identifier i _) e1 e2 p) =
text "for" <> (parens . hsep . punctuate (char ';') $ [text i <+> text "=" <+> expr2C e1, text i <+> text "<=" <+> expr2C e2, text "++" <> text i])
$$
phrase2C (wrapPhrase p)
@@ -195,13 +195,13 @@
ref2C :: Reference -> Doc
ref2C (ArrayElement exprs ref) = ref2C ref <> (brackets . hcat) (punctuate comma $ map expr2C exprs)
-ref2C (SimpleReference (Identifier name)) = text name
+ref2C (SimpleReference (Identifier name _)) = text name
ref2C (RecordField (Dereference ref1) ref2) = ref2C ref1 <> text "->" <> ref2C ref2
ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2
ref2C (Dereference ref) = parens $ text "*" <> ref2C ref
ref2C (FunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)
ref2C (Address ref) = text "&" <> parens (ref2C ref)
-ref2C (TypeCast (Identifier t) expr) = parens (text t) <> expr2C expr
+ref2C (TypeCast (Identifier t _) expr) = parens (text t) <> expr2C expr
ref2C (RefExpression expr) = expr2C expr
op2C "or" = text "|"