From d100697f14255f4774a6d86100f4ed18f275a688 Mon Sep 17 00:00:00 2001
From: Christian Gram Kalhauge <chrg@dtu.dk>
Date: Tue, 18 Mar 2025 16:13:16 +0100
Subject: [PATCH] Acceptable changes
---
rtree-c/src/ReduceC.hs | 56 ++++++++++++++++++++++++++++++++----------
1 file changed, 43 insertions(+), 13 deletions(-)
diff --git a/rtree-c/src/ReduceC.hs b/rtree-c/src/ReduceC.hs
index dcd3def..136b917 100644
--- a/rtree-c/src/ReduceC.hs
+++ b/rtree-c/src/ReduceC.hs
@@ -142,6 +142,7 @@ reduceCTranslUnit (C.CTranslUnit es ni) ctx = do
let builtins =
[ ("fabsf", FunType (NonVoid TNum) (Params [Just TNum] False))
, ("fabs", FunType (NonVoid TNum) (Params [Just TNum] False))
+ , ("__builtin_abort", FunType Void (Params [] False))
]
let functions''' =
@@ -450,9 +451,21 @@ reduceCExternalDeclaration r = case r of
-- Type definitions
C.CDeclExt (C.CDecl (C.CStorageSpec (C.CTypedef nif) : rst) [item] ni) -> runMaybeT do
- (ix, dd) <- case item of
- C.CDeclarationItem (C.CDeclr (Just ix) dd Nothing _ _) Nothing Nothing ->
- pure (ix, dd)
+ (ix, dd, wrap) <- case item of
+ C.CDeclarationItem (C.CDeclr (Just ix) dd Nothing extras _) Nothing Nothing ->
+ case extras of
+ [] -> pure (ix, dd, id)
+ [C.CAttr (C.Ident "__vector_size__" _ _) [a] _] -> do
+ case a of
+ C.CBinary C.CMulOp (C.CConst (C.CIntConst (C.CInteger n _ _) _)) (C.CSizeofType _ _) _ ->
+ -- todo assuming this is a checked size
+ pure
+ ( ix
+ , dd
+ , NonVoid . TVector (fromInteger n)
+ )
+ _ -> notSupportedYet a ni
+ a -> notSupportedYet (map void a) ni
i -> notSupportedYet (void i) ni
modify' (addTypeDef ix ITDelete)
@@ -463,10 +476,10 @@ reduceCExternalDeclaration r = case r of
(t, _) <- updateCDerivedDeclarators bt (repeat True) dd
unless keep do
- modify' (addTypeDef ix (ITInline t rst'))
+ modify' (addTypeDef ix (ITInline (wrap t) rst'))
exceptIf ("inline typedef " <> C.identToString ix, C.posOf ni)
- modify' (addTypeDef ix (ITKeep t))
+ modify' (addTypeDef ix (ITKeep (wrap t)))
pure $ C.CDeclExt $ C.CDecl (C.CStorageSpec (C.CTypedef nif) : rst') [item] ni
-- The rest.
@@ -661,14 +674,29 @@ reduceCInitializer ::
m (C.CInitializer C.NodeInfo, Maybe C.CExpr)
reduceCInitializer t einit ctx = case einit of
C.CInitExpr e ni2 -> do
- e' <- fromMaybe (pure zeroExpr) $ reduceCExpr e (exactly t) ctx
- pure
- ( C.CInitExpr e' ni2
- , case e' of
- C.CConst _ -> Just e'
- C.CVar _ _ -> Just e'
- _ow -> Nothing
- )
+ let me = reduceCExpr e (exactly t) ctx
+ case (me, t) of
+ (Just es, _) -> do
+ e' <- es
+ pure
+ ( C.CInitExpr e' ni2
+ , case e' of
+ C.CConst _ -> Just e'
+ C.CVar _ _ -> Just e'
+ _ow -> Nothing
+ )
+ (Nothing, TVector n _) -> do
+ let items' = [([], C.CInitExpr zeroExpr ni2) | _ <- replicate n ()]
+ pure (C.CInitList (C.CInitializerList items') ni2, Nothing)
+ (Nothing, _) -> do
+ let e' = zeroExpr
+ pure
+ ( C.CInitExpr e' ni2
+ , case e' of
+ C.CConst _ -> Just e'
+ C.CVar _ _ -> Just e'
+ _ow -> Nothing
+ )
C.CInitList (C.CInitializerList items) ni2 -> do
items' <- case t of
TStruct stct -> do
@@ -1040,6 +1068,7 @@ inferType ctx = \case
t2 <- inferType ctx x
case (t1, t2) of
(NonVoid (TPointer x'), NonVoid TNum) -> pure x'
+ (NonVoid (TVector _ x'), NonVoid TNum) -> pure x'
_ow -> error (show ("index", t1, t2))
C.CMember a l t _ -> do
t1 <- inferType ctx a
@@ -1467,6 +1496,7 @@ data Type
= TNum
| TStruct !(Either C.Ident StructType)
| TPointer !Voidable
+ | TVector !Int !Voidable
| TFun !FunType
deriving (Show, Eq)
--
GitLab