diff -r b043665dea3d -r d45b6dbd2ad6 tools/pas2c.hs --- a/tools/pas2c.hs Tue Feb 07 22:39:36 2012 -0500 +++ b/tools/pas2c.hs Wed Feb 08 15:49:55 2012 +0400 @@ -148,11 +148,14 @@ else return . text . fst . snd . fromJust $ v -id2CTyped :: BaseType -> Identifier -> State RenderState Doc -id2CTyped BTUnknown i = do +id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc +id2CTyped t (Identifier i _) = do + tb <- resolveType t + id2C True (Identifier i tb) +{--id2CTyped BTUnknown i = do ns <- gets currentScope error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\n" ++ show ns -id2CTyped bt (Identifier i _) = id2C True (Identifier i bt) +id2CTyped bt (Identifier i _) = id2C True (Identifier i bt)--} resolveType :: TypeDecl -> State RenderState BaseType @@ -168,7 +171,7 @@ f "char" = BTChar f "string" = BTString f _ = error $ "Unknown system type: " ++ show st -resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t +resolveType (PointerTo t) = return $ BTPointerTo BTUnknown -- can't resolveType for t here resolveType (RecordType tv mtvs) = do tvs <- mapM f (concat $ tv : fromMaybe [] mtvs) return . BTRecord . concat $ tvs @@ -180,6 +183,9 @@ resolveType (FunctionType _ _) = return BTFunction resolveType (DeriveType _) = return BTInt resolveType (String _) = return BTString +resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids +resolveType (RangeType _) = return $ BTInt +resolveType (Set t) = liftM BTSet $ resolveType t --resolveType UnknownType = return BTUnknown resolveType a = error $ "resolveType: " ++ show a @@ -211,15 +217,13 @@ tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name tvar2C _ td@(TypeDeclaration i' t) = do - tb <- resolveType t - i <- id2CTyped tb i' + i <- id2CTyped t i' tp <- type2C t return $ text "type" <+> i <+> tp <> text ";" tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do t' <- type2C t - tb <- resolveType t - i <- mapM (id2CTyped tb) ids + i <- mapM (id2CTyped t) ids ie <- initExpr mInitExpr return $ if isConst then text "const" else empty <+> t'