Skip to content
Snippets Groups Projects
Commit d100697f authored by chrg's avatar chrg
Browse files

Acceptable changes

parent 211f5ac9
No related branches found
No related tags found
No related merge requests found
...@@ -142,6 +142,7 @@ reduceCTranslUnit (C.CTranslUnit es ni) ctx = do ...@@ -142,6 +142,7 @@ reduceCTranslUnit (C.CTranslUnit es ni) ctx = do
let builtins = let builtins =
[ ("fabsf", FunType (NonVoid TNum) (Params [Just TNum] False)) [ ("fabsf", FunType (NonVoid TNum) (Params [Just TNum] False))
, ("fabs", FunType (NonVoid TNum) (Params [Just TNum] False)) , ("fabs", FunType (NonVoid TNum) (Params [Just TNum] False))
, ("__builtin_abort", FunType Void (Params [] False))
] ]
let functions''' = let functions''' =
...@@ -450,9 +451,21 @@ reduceCExternalDeclaration r = case r of ...@@ -450,9 +451,21 @@ reduceCExternalDeclaration r = case r of
-- Type definitions -- Type definitions
C.CDeclExt (C.CDecl (C.CStorageSpec (C.CTypedef nif) : rst) [item] ni) -> runMaybeT do C.CDeclExt (C.CDecl (C.CStorageSpec (C.CTypedef nif) : rst) [item] ni) -> runMaybeT do
(ix, dd) <- case item of (ix, dd, wrap) <- case item of
C.CDeclarationItem (C.CDeclr (Just ix) dd Nothing _ _) Nothing Nothing -> C.CDeclarationItem (C.CDeclr (Just ix) dd Nothing extras _) Nothing Nothing ->
pure (ix, dd) 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 i -> notSupportedYet (void i) ni
modify' (addTypeDef ix ITDelete) modify' (addTypeDef ix ITDelete)
...@@ -463,10 +476,10 @@ reduceCExternalDeclaration r = case r of ...@@ -463,10 +476,10 @@ reduceCExternalDeclaration r = case r of
(t, _) <- updateCDerivedDeclarators bt (repeat True) dd (t, _) <- updateCDerivedDeclarators bt (repeat True) dd
unless keep do 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) 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 pure $ C.CDeclExt $ C.CDecl (C.CStorageSpec (C.CTypedef nif) : rst') [item] ni
-- The rest. -- The rest.
...@@ -661,14 +674,29 @@ reduceCInitializer :: ...@@ -661,14 +674,29 @@ reduceCInitializer ::
m (C.CInitializer C.NodeInfo, Maybe C.CExpr) m (C.CInitializer C.NodeInfo, Maybe C.CExpr)
reduceCInitializer t einit ctx = case einit of reduceCInitializer t einit ctx = case einit of
C.CInitExpr e ni2 -> do C.CInitExpr e ni2 -> do
e' <- fromMaybe (pure zeroExpr) $ reduceCExpr e (exactly t) ctx let me = reduceCExpr e (exactly t) ctx
pure case (me, t) of
( C.CInitExpr e' ni2 (Just es, _) -> do
, case e' of e' <- es
C.CConst _ -> Just e' pure
C.CVar _ _ -> Just e' ( C.CInitExpr e' ni2
_ow -> Nothing , 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 C.CInitList (C.CInitializerList items) ni2 -> do
items' <- case t of items' <- case t of
TStruct stct -> do TStruct stct -> do
...@@ -1040,6 +1068,7 @@ inferType ctx = \case ...@@ -1040,6 +1068,7 @@ inferType ctx = \case
t2 <- inferType ctx x t2 <- inferType ctx x
case (t1, t2) of case (t1, t2) of
(NonVoid (TPointer x'), NonVoid TNum) -> pure x' (NonVoid (TPointer x'), NonVoid TNum) -> pure x'
(NonVoid (TVector _ x'), NonVoid TNum) -> pure x'
_ow -> error (show ("index", t1, t2)) _ow -> error (show ("index", t1, t2))
C.CMember a l t _ -> do C.CMember a l t _ -> do
t1 <- inferType ctx a t1 <- inferType ctx a
...@@ -1467,6 +1496,7 @@ data Type ...@@ -1467,6 +1496,7 @@ data Type
= TNum = TNum
| TStruct !(Either C.Ident StructType) | TStruct !(Either C.Ident StructType)
| TPointer !Voidable | TPointer !Voidable
| TVector !Int !Voidable
| TFun !FunType | TFun !FunType
deriving (Show, Eq) deriving (Show, Eq)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment