--- a/tools/PascalUnitSyntaxTree.hs Sat Mar 24 19:57:06 2012 +0400
+++ b/tools/PascalUnitSyntaxTree.hs Sat Mar 24 21:19:50 2012 +0400
@@ -108,4 +108,5 @@
| BTSet BaseType
| BTEnum [String]
| BTVoid
+ | BTUnit
deriving Show
--- a/tools/pas2c.hs Sat Mar 24 19:57:06 2012 +0400
+++ b/tools/pas2c.hs Sat Mar 24 21:19:50 2012 +0400
@@ -124,10 +124,13 @@
typesAndVars2C :: Bool -> TypesAndVars -> State RenderState Doc
typesAndVars2C b (TypesAndVars ts) = liftM vcat $ mapM (tvar2C b) ts
+setBaseType :: BaseType -> Identifier -> Identifier
+setBaseType bt (Identifier i _) = Identifier i bt
+
uses2C :: Uses -> State RenderState Doc
uses2C uses@(Uses unitIds) = do
mapM_ injectNamespace (Identifier "pas2cSystem" undefined : unitIds)
- mapM_ (id2C IOInsert) unitIds
+ mapM_ (id2C IOInsert . setBaseType BTUnit) unitIds
return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses
where
injectNamespace (Identifier i _) = do
@@ -147,11 +150,10 @@
let i' = map toLower i
v <- gets $ find (\(a, _) -> a == i') . currentScope
ns <- gets currentScope
- modify (\s -> s{lastType = t})
if isNothing v then
error $ "Not defined: '" ++ i' ++ "'\n" -- ++ show ns
else
- return . text . fst . snd . fromJust $ v
+ let vv = snd $ fromJust v in modify (\s -> s{lastType = snd vv}) >> (return . text . fst $ vv)
id2C IODeferred (Identifier i t) = do
let i' = map toLower i
v <- gets $ find (\(a, _) -> a == i') . currentScope
@@ -383,8 +385,10 @@
ref2C rf@(RecordField ref1 ref2) = do
r1 <- ref2C ref1
t <- gets lastType
+ ns <- gets currentScope
case t of
r@(BTRecord _) -> error $ show r
+ r@(BTUnit) -> error $ show r
a -> error $ "dereferencing from " ++ show a ++ " - " ++ show rf
r2 <- ref2C ref2
return $