tools/pas2c.hs
changeset 6875 6528171ce36d
parent 6874 b9e2e509a42d
child 6878 0af34406b83d
equal deleted inserted replaced
6874:b9e2e509a42d 6875:6528171ce36d
   303 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name
   303 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name
   304 
   304 
   305 tvar2C _ td@(TypeDeclaration i' t) = do
   305 tvar2C _ td@(TypeDeclaration i' t) = do
   306     i <- id2CTyped t i'
   306     i <- id2CTyped t i'
   307     tp <- type2C t
   307     tp <- type2C t
   308     return $ text "typedef" <+> i <+> tp <> semi
   308     return $ text "typedef" <+> tp <+> i <> semi
   309     
   309     
   310 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
   310 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
   311     t' <- type2C t
   311     t' <- type2C t
   312     i <- mapM (id2CTyped t) ids
   312     i <- mapM (id2CTyped t) ids
   313     ie <- initExpr mInitExpr
   313     ie <- initExpr mInitExpr
   314     return $ if isConst then text "const" else empty
   314     return $ (if isConst then text "const" else empty)
   315         <+> t'
   315         <+> t'
   316         <+> (hsep . punctuate (char ',') $ i)
   316         <+> (hsep . punctuate (char ',') $ i)
   317         <+> ie
   317         <+> ie
   318         <> text ";"
   318         <> text ";"
   319     where
   319     where
   366     modify (\st -> st{lastType = rt})
   366     modify (\st -> st{lastType = rt})
   367     return r
   367     return r
   368     where
   368     where
   369     type2C' VoidType = return $ text "void"
   369     type2C' VoidType = return $ text "void"
   370     type2C' (String l) = return $ text $ "string" ++ show l
   370     type2C' (String l) = return $ text $ "string" ++ show l
   371     type2C' (PointerTo (SimpleType i)) = liftM (<> text "*") $ id2C IODeferred i
   371     type2C' (PointerTo (SimpleType i)) = liftM (\i -> text "struct" <+> i <+> text "*") $ id2C IODeferred i
   372     type2C' (PointerTo t) = liftM (<> text "*") $ type2C t
   372     type2C' (PointerTo t) = liftM (<> text "*") $ type2C t
   373     type2C' (RecordType tvs union) = do
   373     type2C' (RecordType tvs union) = do
   374         t <- withState' id $ mapM (tvar2C False) tvs
   374         t <- withState' id $ mapM (tvar2C False) tvs
   375         return $ lbrace $+$ (nest 4 . vcat $ t) $+$ rbrace
   375         return $ text "struct" <+> lbrace $+$ (nest 4 . vcat $ t) $+$ rbrace
   376     type2C' (RangeType r) = return $ text "<<range type>>"
   376     type2C' (RangeType r) = return $ text "<<range type>>"
   377     type2C' (Sequence ids) = do
   377     type2C' (Sequence ids) = do
   378         mapM_ (id2C IOInsert) ids
   378         mapM_ (id2C IOInsert) ids
   379         return $ text "<<sequence type>>"
   379         return $ text "<<sequence type>>"
   380     type2C' (ArrayDecl r t) = do
   380     type2C' (ArrayDecl r t) = do