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

Semi-working version

parent 9e2c99b7
No related branches found
No related tags found
No related merge requests found
Showing
with 480 additions and 210 deletions
--failure-report .hspec-failures
--fail-fast
--rerun-all-on-success
......@@ -11,15 +11,25 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module ReduceC where
module ReduceC (
defaultReduceC,
reduceCTranslUnit,
-- * Context
Context (..),
defaultContext,
-- * Helpers
prettyIdent,
) where
import Control.Monad.Reader
import Control.Monad.Reduce
import Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
import Data.Data
import Data.Foldable
import Data.Function
import Data.Functor
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.Set as Set
import Data.Vector.Internal.Check (HasCallStack)
import qualified Language.C as C
......@@ -36,12 +46,13 @@ data Keyword
| DoNoops
| NoSemantics
| AllowEmptyDeclarations
| DisallowVariableInlining
deriving (Show, Read, Enum, Eq, Ord)
type CM m = (MonadReduce (String, C.Position) m, MonadReader Context m, MonadFail m)
type Lab = (String, C.Position)
defaultReduceC :: (CReducible a, MonadReduce (String, C.Position) m) => a -> m (Maybe a)
defaultReduceC a = runMaybeT (runReaderT (reduceC a) defaultContext)
defaultReduceC :: (MonadReduce (String, C.Position) m) => C.CTranslUnit -> m C.CTranslUnit
defaultReduceC a = reduceCTranslUnit a defaultContext
addTypeDefs :: [C.Ident] -> [C.CDeclarationSpecifier C.NodeInfo] -> Context -> Context
addTypeDefs ids cs Context{..} =
......@@ -58,6 +69,20 @@ addInlineExpr i e Context{..} =
, ..
}
addKeyword :: Keyword -> Context -> Context
addKeyword k Context{..} =
Context
{ keywords = Set.insert k keywords
, ..
}
-- deleteKeyword :: Keyword -> Context -> Context
-- deleteKeyword k Context{..} =
-- Context
-- { keywords = Set.delete k keywords
-- , ..
-- }
defaultContext :: Context
defaultContext =
Context
......@@ -66,28 +91,37 @@ defaultContext =
, inlineExprs = Map.empty
}
keyword :: (MonadReader Context m) => Keyword -> m Bool
keyword s = asks (Set.member s . keywords)
isIn :: Keyword -> Context -> Bool
isIn k = Set.member k . keywords
class CReducible a where
reduceC :: (CM m) => a -> m a
prettyIdent :: C.Identifier C.NodeInfo -> [Char]
prettyIdent (C.Ident s _ a) = s ++ " at " ++ show (C.posOfNode a)
instance CReducible C.CTranslUnit where
reduceC (C.CTranslUnit es ni) = do
es' <- foldr reduceCExternalDeclaration (pure []) es
reduceCTranslUnit
:: (MonadReduce Lab m)
=> C.CTranslationUnit C.NodeInfo
-> Context
-> m (C.CTranslationUnit C.NodeInfo)
reduceCTranslUnit (C.CTranslUnit es ni) ctx = do
es' <- foldr reduceCExternalDeclaration (\_ -> pure []) es ctx
pure $ C.CTranslUnit es' ni
where
reduceCExternalDeclaration r cont = do
shouldKeepMain <- keyword KeepMain
case r of
reduceCExternalDeclaration
:: (MonadReduce Lab m)
=> C.CExternalDeclaration C.NodeInfo
-> (Context -> m [C.CExternalDeclaration C.NodeInfo])
-> Context
-> m [C.CExternalDeclaration C.NodeInfo]
reduceCExternalDeclaration r cont ctx = do
case inlineTypeDefs r ctx of
C.CFDefExt fun
| shouldKeepMain && maybe False (("main" ==) . C.identToString) (functionName fun) -> do
r' <- C.CFDefExt <$> reduceC fun
(r' :) <$> cont
| KeepMain `isIn` ctx && maybe False (("main" ==) . C.identToString) (functionName fun) -> do
r' <- C.CFDefExt <$> reduceCFunDef fun ctx
(r' :) <$> cont ctx
| otherwise ->
split ("remove function " <> maybe "" C.identToString (functionName fun), C.posOf r) cont do
r' <- C.CFDefExt <$> reduceC fun
(r' :) <$> cont
split ("remove function " <> maybe "" C.identToString (functionName fun), C.posOf r) (cont ctx) do
r' <- C.CFDefExt <$> reduceCFunDef fun ctx
(r' :) <$> cont ctx
C.CDeclExt result ->
case result of
-- A typedef
......@@ -95,97 +129,202 @@ instance CReducible C.CTranslUnit where
let [ids] = identifiers decl
split
("inline typedef " <> C.identToString ids, C.posOf r)
(local (addTypeDefs [ids] rst) cont)
((r :) <$> local (addTypeDefs [ids] [C.CTypeSpec (C.CTypeDef ids n)]) cont)
(cont (addTypeDefs [ids] rst ctx))
((r :) <$> cont (addTypeDefs [ids] [C.CTypeSpec (C.CTypeDef ids n)] ctx))
-- A const
C.CDecl rec decl ni' -> do
(decl', cont') <- foldr reduceCDeclarationItem (pure ([], cont)) decl
allow <- keyword AllowEmptyDeclarations
(decl', ctx') <- foldr reduceCDeclarationItem (pure ([], ctx)) decl
case decl' of
[]
| allow ->
split ("remove empty declaration", C.posOf r) cont' do
(C.CDeclExt (C.CDecl rec decl' ni') :) <$> cont'
| otherwise -> cont'
_ow -> (C.CDeclExt (C.CDecl rec decl' ni') :) <$> cont'
| AllowEmptyDeclarations `isIn` ctx' ->
split ("remove empty declaration", C.posOf r) (cont ctx') do
(C.CDeclExt (C.CDecl rec decl' ni') :) <$> cont ctx'
| otherwise -> cont ctx'
_ow -> (C.CDeclExt (C.CDecl rec decl' ni') :) <$> cont ctx'
a -> don'tHandle a
_r -> don'tHandle r
reduceCDeclarationItem
:: (CM m)
=> C.CDeclarationItem C.NodeInfo
-> m ([C.CDeclarationItem C.NodeInfo], m a)
-> m ([C.CDeclarationItem C.NodeInfo], m a)
reduceCDeclarationItem d ma = case d of
C.CDeclarationItem
(C.CDeclr (Just i) [] Nothing [] ni)
(Just (C.CInitExpr c _))
Nothing -> do
(ds, cont) <- ma
split
("inline variable " <> C.identToString i, C.posOf ni)
(pure (ds, local (addInlineExpr i c) cont))
(pure (d : ds, local (addInlineExpr i (C.CVar i ni)) cont))
a -> don'tHandle a
prettyIdent :: C.Identifier C.NodeInfo -> [Char]
prettyIdent (C.Ident s _ a) = s ++ " at " ++ show (C.posOfNode a)
instance CReducible C.CFunDef where
reduceC r = do
C.CFunDef spc dec cdecls smt ni <- inlineTypeDefs r
smt' <- reduceC smt
reduceCFunDef
:: (MonadReduce Lab m)
=> C.CFunctionDef C.NodeInfo
-> Context
-> m (C.CFunctionDef C.NodeInfo)
reduceCFunDef (C.CFunDef spc dec cdecls smt ni) ctx = do
smt' <- reduceCStatementOrEmptyBlock smt ctx
pure $ C.CFunDef spc dec cdecls smt' ni
reduceCCompoundBlockItem
:: (CM m)
:: (MonadReduce Lab m)
=> C.CCompoundBlockItem C.NodeInfo
-> (Context -> m [C.CCompoundBlockItem C.NodeInfo])
-> Context
-> m [C.CCompoundBlockItem C.NodeInfo]
-> m [C.CCompoundBlockItem C.NodeInfo]
reduceCCompoundBlockItem r cont = case r of
reduceCCompoundBlockItem r cont ctx = do
case r of
C.CBlockStmt smt -> do
split ("remove statement", C.posOf r) cont do
smt' <- reduceC smt
(C.CBlockStmt smt' :) <$> cont
case reduceCStatement smt ctx of
Just rsmt -> split ("remove statement", C.posOf r) (cont ctx) do
smt' <- rsmt
case smt' of
C.CCompound [] ss _ -> do
split ("expand compound statment", C.posOf r) ((ss <>) <$> cont ctx) do
(C.CBlockStmt smt' :) <$> cont ctx
_ow -> do
(C.CBlockStmt smt' :) <$> cont ctx
Nothing -> cont ctx
C.CBlockDecl declr -> do
case declr of
C.CDecl rec decl ni' -> do
(decl', cont') <- foldr reduceCDeclarationItem (pure ([], cont)) decl
allow <- keyword AllowEmptyDeclarations
(decl', ctx') <- foldr reduceCDeclarationItem (pure ([], ctx)) decl
case decl' of
[]
| allow ->
split ("remove empty declaration", C.posOf r) cont' do
(C.CBlockDecl (C.CDecl rec decl' ni') :) <$> cont'
| otherwise -> cont'
_ow -> (C.CBlockDecl (C.CDecl rec decl' ni') :) <$> cont'
| AllowEmptyDeclarations `isIn` ctx' ->
split ("remove empty declaration", C.posOf r) (cont ctx') do
(C.CBlockDecl (C.CDecl rec decl' ni') :) <$> cont ctx'
| otherwise -> cont ctx'
_ow -> (C.CBlockDecl (C.CDecl rec decl' ni') :) <$> cont ctx'
d -> don'tHandle d
a -> don'tHandle a
instance CReducible (C.CStatement C.NodeInfo) where
reduceC smt = case smt of
C.CCompound is cbi ni -> do
cbi' <- foldr reduceCCompoundBlockItem (pure []) cbi
reduceCDeclarationItem
:: (MonadReduce Lab m)
=> C.CDeclarationItem C.NodeInfo
-> m ([C.CDeclarationItem C.NodeInfo], Context)
-> m ([C.CDeclarationItem C.NodeInfo], Context)
reduceCDeclarationItem d ma = case d of
C.CDeclarationItem
dr@(C.CDeclr (Just i) [] Nothing [] ni)
(Just (C.CInitExpr c ni'))
Nothing -> do
(ds, ctx) <- ma
c' <- fromMaybe (pure zeroExpr) (reduceCExpr c ctx)
split
("inline variable " <> C.identToString i, C.posOf ni)
(pure (ds, addInlineExpr i c' ctx))
( pure
( C.CDeclarationItem dr (Just (C.CInitExpr c' ni')) Nothing : ds
, addInlineExpr i (C.CVar i ni) ctx
)
)
C.CDeclarationItem (C.CDeclr (Just i) [] Nothing [] ni) Nothing Nothing -> do
(ds, ctx) <- ma
split
("remove variable " <> C.identToString i, C.posOf ni)
(pure (ds, ctx))
(pure (d : ds, addInlineExpr i (C.CVar i ni) ctx))
a -> don'tHandle a
reduceCStatementOrEmptyBlock
:: (MonadReduce Lab m)
=> C.CStatement C.NodeInfo
-> Context
-> m (C.CStatement C.NodeInfo)
reduceCStatementOrEmptyBlock stmt ctx = do
case reduceCStatement stmt ctx of
Just ex -> do
ex
Nothing -> do
pure emptyBlock
where
emptyBlock = C.CCompound [] [] C.undefNode
reduceCStatement
:: (MonadReduce Lab m)
=> C.CStatement C.NodeInfo
-> Context
-> Maybe (m (C.CStatement C.NodeInfo))
reduceCStatement smt ctx = case smt of
C.CCompound is cbi ni -> Just do
cbi' <- foldr reduceCCompoundBlockItem (\_ -> pure []) cbi ctx
pure $ C.CCompound is cbi' ni
C.CWhile e s dow ni -> do
e' <- reduceCExprOrZero e
s' <- reduceC s
rs <- reduceCStatement s ctx
Just do
e' <- reduceCExprOrZero e ctx
s' <- rs
pure $ C.CWhile e' s' dow ni
C.CExpr me ni -> do
case me of
Just e ->
splitOn DoNoops ("change to noop", C.posOf smt) (pure $ C.CExpr Nothing ni) do
e' <- reduceC e
Just e -> do
if DoNoops `isIn` ctx
then Just do
e' <- maybeSplit ("change to noop", C.posOf smt) $ reduceCExpr e ctx
pure $ C.CExpr e' ni
else do
re <- reduceCExpr e ctx
Just do
e' <- re
pure $ C.CExpr (Just e') ni
Nothing ->
pure $ C.CExpr Nothing ni
C.CReturn me ni ->
Just $ pure $ C.CExpr Nothing ni
C.CReturn me ni -> Just do
case me of
Just e -> do
e' <- reduceCExprOrZero e
e' <- reduceCExprOrZero e ctx
pure $ C.CReturn (Just e') ni
Nothing ->
pure $ C.CReturn Nothing ni
C.CIf e s els ni -> Just do
e' <- maybeSplit ("remove condition", C.posOf e) $ reduceCExpr e ctx
els' <- case els of
Just els' -> do
maybeSplit ("remove else branch", C.posOf els') do
reduceCStatement els' ctx
Nothing -> pure Nothing
s' <- reduceCStatementOrEmptyBlock s ctx
case (e', els') of
(Nothing, Nothing) -> pure s'
(Just e'', Nothing) -> pure $ C.CIf e'' s' Nothing ni
(Nothing, Just x) -> pure $ C.CIf zeroExpr s' (Just x) ni
(Just e'', Just x) -> pure $ C.CIf e'' s' (Just x) ni
C.CFor e1 e2 e3 s ni -> Just $ do
(me1', ctx') <- case e1 of
C.CForDecl (C.CDecl rec decl ni') -> do
(decl', ctx') <- foldr reduceCDeclarationItem (pure ([], ctx)) decl
res <-
if null decl'
then
whenSplit
(AllowEmptyDeclarations `isIn` ctx')
("remove empty declaration", C.posOf ni')
(pure Nothing)
(pure $ Just $ C.CForDecl (C.CDecl rec decl' ni'))
else pure $ Just $ C.CForDecl (C.CDecl rec decl' ni')
pure (res, ctx')
C.CForInitializing e ->
whenSplit
(AllowEmptyDeclarations `isIn` ctx)
("remove empty declaration", C.posOf ni)
(pure (Nothing, ctx))
(pure (Just $ C.CForInitializing e, ctx))
d -> don'tHandle d
s' <- reduceCStatementOrEmptyBlock s ctx'
case me1' of
Nothing -> do
split ("remove the for loop", C.posOf smt) (pure s') do
e2' <- case e2 of
Just e2' -> maybeSplit ("remove check", C.posOf e2') (reduceCExpr e2' ctx')
Nothing -> pure Nothing
e3' <- case e3 of
Just e3' -> maybeSplit ("remove iterator", C.posOf e3') (reduceCExpr e3' ctx')
Nothing -> pure Nothing
pure $ C.CFor (C.CForInitializing Nothing) e2' e3' s' ni
Just e1' -> do
e2' <- case e2 of
Just e2' -> maybeSplit ("remove check", C.posOf e2') (reduceCExpr e2' ctx')
Nothing -> pure Nothing
e3' <- case e3 of
Just e3' -> maybeSplit ("remove iterator", C.posOf e3') (reduceCExpr e3' ctx')
Nothing -> pure Nothing
pure $ C.CFor e1' e2' e3' s' ni
C.CBreak ni -> Just do
pure (C.CBreak ni)
C.CLabel i s [] ni -> Just do
s' <- reduceCStatementOrEmptyBlock s ctx
pure $ C.CLabel i s' [] ni
C.CGoto i ni -> Just do
pure $ C.CGoto i ni
a -> don'tHandle a
-- C.CCompound is cbi ni -> do
......@@ -196,29 +335,9 @@ instance CReducible (C.CStatement C.NodeInfo) where
-- e' <- liftMaybe e
-- reduce @C.CExpression e'
-- pure $ C.CExpr e' ni
-- C.CIf e s els ni -> do
-- s' <- reduce s
-- e' <- optional do
-- reduce @C.CExpression e
-- els' <- optional do
-- els' <- liftMaybe els
-- given >> reduce els'
-- case (e', els') of
-- (Nothing, Nothing) -> pure s'
-- (Just e'', Nothing) -> pure $ C.CIf e'' s' Nothing ni
-- (Nothing, Just x) -> pure $ C.CIf zeroExp s' (Just x) ni
-- (Just e'', Just x) -> pure $ C.CIf e'' s' (Just x) ni
-- C.CFor e1 e2 e3 s ni -> do
-- reduce s <| do
-- e1' <- reduce @C.CForInit e1
-- e2' <- optional $ liftMaybe e2 >>= reduce @C.CExpression
-- e3' <- optional $ liftMaybe e3 >>= reduce @C.CExpression
-- s' <- reduce s
-- pure $ C.CFor e1' e2' e3' s' ni
-- C.CReturn e ni -> do
-- e' <- traverse (fmap orZero reduce) e
-- pure $ C.CReturn e' ni
-- C.CBreak ni -> pure (C.CBreak ni)
-- C.CCont ni -> pure (C.CCont ni)
-- C.CLabel i s [] ni -> do
-- -- todo fix attrs
......@@ -226,41 +345,78 @@ instance CReducible (C.CStatement C.NodeInfo) where
-- withFallback s' do
-- givenThat (Val.is i)
-- pure $ C.CLabel i s' [] ni
-- C.CGoto i ni ->
-- withFallback (C.CExpr Nothing ni) do
-- givenThat (Val.is i)
-- pure $ C.CGoto i ni
-- C.CWhile e s dow ni -> do
-- e' <- orZero (reduce @C.CExpression e)
-- s' <- reduce s
-- pure $ C.CWhile e' s' dow ni
-- | If the condition is statisfied try to reduce to the a.
whenSplit :: (MonadReduce Lab m) => Bool -> Lab -> m a -> m a -> m a
whenSplit cn lab a b
| cn = split lab a b
| otherwise = b
maybeSplit :: (MonadReduce Lab m) => Lab -> Maybe (m a) -> m (Maybe a)
maybeSplit lab = \case
Just r -> do
split lab (pure Nothing) (Just <$> r)
Nothing -> do
pure Nothing
zeroExpr :: C.CExpression C.NodeInfo
zeroExpr = C.CConst (C.CIntConst (C.cInteger 0) C.undefNode)
reduceCExprOrZero :: (CM m) => C.CExpr -> m C.CExpr
reduceCExprOrZero expr =
splitOn NoSemantics ("replace by zero", C.posOf expr) (pure zeroExpr) do
reduceC expr
instance CReducible C.CExpr where
reduceC expr = case expr of
C.CBinary o elhs erhs ni ->
splitOn NoSemantics ("reduce to left", C.posOf elhs) (reduceC elhs) do
splitOn NoSemantics ("reduce to right", C.posOf erhs) (reduceC erhs) do
elhs' <- reduceC elhs
erhs' <- reduceC erhs
pure $ C.CBinary o elhs' erhs' ni
C.CVar i _ -> do
asks (Map.lookup i . inlineExprs) >>= \case
Just mx -> pure mx
reduceCExprOrZero :: (MonadReduce Lab m) => C.CExpr -> Context -> m C.CExpr
reduceCExprOrZero expr ctx = do
case reduceCExpr expr ctx of
Just ex -> do
split ("replace by zero", C.posOf expr) (pure zeroExpr) ex
Nothing -> do
pure zeroExpr
reduceCExpr :: (MonadReduce Lab m) => C.CExpr -> Context -> Maybe (m C.CExpr)
reduceCExpr expr ctx = case expr of
C.CBinary o elhs erhs ni -> do
case reduceCExpr elhs ctx of
Just elhs' -> case reduceCExpr erhs ctx of
Just erhs' -> pure do
split ("reduce to left", C.posOf elhs) elhs' do
split ("reduce to right", C.posOf erhs) erhs' do
l' <- elhs'
r' <- erhs'
pure $ C.CBinary o l' r' ni
Nothing ->
fail "could not reduce right hand side"
Nothing
| otherwise -> fail "could not reduce left hand side"
C.CAssign o elhs erhs ni ->
case reduceCExpr elhs (addKeyword DisallowVariableInlining ctx) of
Just elhs' -> case reduceCExpr erhs ctx of
Just erhs' -> pure do
split ("reduce to left", C.posOf elhs) elhs' do
split ("reduce to right", C.posOf erhs) erhs' do
l' <- elhs'
r' <- erhs'
pure $ C.CAssign o l' r' ni
Nothing ->
fail "could not reduce right hand side"
Nothing
| otherwise -> fail "could not reduce left hand side"
C.CVar i _ ->
case Map.lookup i . inlineExprs $ ctx of
Just mx -> case mx of
C.CVar _ _ -> pure (pure mx)
_
| DisallowVariableInlining `isIn` ctx -> Nothing
| otherwise -> pure (pure mx)
Nothing -> fail ("Could not find " <> show i)
C.CConst x -> do
C.CConst x -> Just do
pure $ C.CConst x
C.CUnary o elhs ni -> do
elhs' <- reduceC elhs
splitOn NoSemantics ("reduce to operant", C.posOf expr) (pure elhs') do
pure $ C.CUnary o elhs' ni
elhs' <- reduceCExpr elhs (addKeyword DisallowVariableInlining ctx)
Just $ split ("reduce to operant", C.posOf expr) elhs' do
e <- elhs'
pure $ C.CUnary o e ni
a -> error (show a)
-- C.CCall e es ni -> do
......@@ -287,8 +443,6 @@ instance CReducible C.CExpr where
-- cd' <- reduce @C.CDeclaration cd
-- e' <- reduce e
-- pure $ C.CCast cd' e' ni
-- C.CAssign op e1 e2 ni -> onBothExpr e1 e2 \e1' e2' ->
-- pure $ C.CAssign op e1' e2' ni
-- C.CIndex e1 e2 ni -> do
-- e1' <- reduce e1
-- e2' <- orZero (reduce e2)
......@@ -303,29 +457,58 @@ instance CReducible C.CExpr where
-- where
-- onBothExpr elhs erhs = onBoth (reduce elhs) (reduce erhs)
splitIf :: (MonadReduce l m) => Bool -> l -> m a -> m a -> m a
splitIf True s a b = split s a b
splitIf False _ _ b = b
splitOn :: (MonadReduce l m, MonadReader Context m) => Keyword -> l -> m a -> m a -> m a
splitOn k s a b = do
con <- keyword k
splitIf con s a b
inlineTypeDefs :: forall d m. (Data d, MonadFail m, MonadReader Context m) => d -> m d
inlineTypeDefs r = do
-- splitIf :: (MonadReduce l m) => Bool -> l -> m a -> m a -> m a
-- splitIf True s a b = split s a b
-- splitIf False _ _ b = b
--
-- splitOn :: (MonadReduce l m, MonadReader Context m) => Keyword -> l -> m a -> m a -> m a
-- splitOn k s a b = do
-- con <- keyword k
-- splitIf con s a b
--
-- maybeSplit
-- :: (MonadReduce l m)
-- => l
-- -> Maybe (m a)
-- -> Maybe (m a)
-- -> Maybe (m a)
-- maybeSplit s a b = case a of
-- Just a' -> case b of
-- Just b' -> Just do
-- split s a' b'
-- Nothing -> Just a'
-- Nothing -> b
--
-- maybeSplitOn
-- :: (MonadReduce l m)
-- => Keyword
-- -> l
-- -> ReaderT Context Maybe (m a)
-- -> ReaderT Context Maybe (m a)
-- -> ReaderT Context Maybe (m a)
-- maybeSplitOn k s a b = do
-- con <- keyword k
-- if con
-- then b
-- else ReaderT \ctx ->
-- case runReaderT a ctx of
-- Just a' -> case runReaderT b ctx of
-- Just b' -> Just $ split s a' b'
-- Nothing -> Just a'
-- Nothing -> runReaderT b ctx
inlineTypeDefs :: forall d. (Data d) => d -> Context -> d
inlineTypeDefs r ctx = do
case eqT @d @[C.CDeclarationSpecifier C.NodeInfo] of
Just Refl -> do
res' :: [[C.CDeclarationSpecifier C.NodeInfo]] <- forM r \case
Just Refl ->
r & concatMap \case
C.CTypeSpec (C.CTypeDef idx _) -> do
res <- asks (Map.lookup idx . typeDefs)
case res of
Just args -> pure args
Nothing -> fail ("could not find typedef:" <> show idx)
a -> pure [a]
pure (fold res')
case Map.lookup idx . typeDefs $ ctx of
Just args -> args
Nothing -> error ("could not find typedef:" <> show idx)
a -> [a]
Nothing ->
gmapM inlineTypeDefs r
gmapT (`inlineTypeDefs` ctx) r
-- instance CReducible C.CExtDecl where
-- reduceC (C.CFunDef spc dec cdecls smt ni) = do
......@@ -340,10 +523,10 @@ functionName :: C.CFunctionDef C.NodeInfo -> Maybe C.Ident
functionName = \case
C.CFunDef _ (C.CDeclr ix _ _ _ _) _ _ _ -> ix
isMain :: C.CFunctionDef C.NodeInfo -> Bool
isMain (C.CFunDef _ (C.CDeclr (Just i) _ _ _ _) _ _ _) =
C.identToString i == "main"
isMain _ow = False
-- isMain :: C.CFunctionDef C.NodeInfo -> Bool
-- isMain (C.CFunDef _ (C.CDeclr (Just i) _ _ _ _) _ _ _) =
-- C.identToString i == "main"
-- isMain _ow = False
don'tHandle :: (HasCallStack, Functor f, Show (f ())) => f C.NodeInfo -> b
don'tHandle f = error (show (f $> ()))
......@@ -548,6 +731,7 @@ don'tHandle f = error (show (f $> ()))
-- (Just e'', Just x) -> pure $ C.CIf e'' s' (Just x) ni
-- C.CFor e1 e2 e3 s ni -> do
-- reduce s <| do
--
-- e1' <- reduce @C.CForInit e1
-- e2' <- optional $ liftMaybe e2 >>= reduce @C.CExpression
-- e3' <- optional $ liftMaybe e3 >>= reduce @C.CExpression
......
// From https://dl.acm.org/doi/pdf/10.1145/3586049
typedef signed int8_t;
typedef short int16_t;
typedef int int32_t;
typedef unsigned uint32_t;
int8_t g_100;
int16_t func_33() {
int8_t l_790;
int32_t l_919 = 0x24F96B7BL;
uint32_t l_1052;
if (l_790)
for (;;)
break;
else for (; l_919; --l_919);
int32_t l_1081 = 1L;
int32_t B4o4obl_919 = l_919;
int8_t B4o4ocg_100 = g_100;
int32_t B4o4odl_1369 = B4o4ocg_100;
uint32_t B4o4ofl_1433 = B4o4odl_1369;
LABEL_4o4og:;
l_1052 = l_1052 >> l_1081;
l_790 = B4o4ofl_1433;
if (l_790) {
l_1052 = l_1052 << B4o4obl_919;
goto LABEL_4o4og;
}
}
int main() {}
File moved
File moved
File moved
int x = 10;
int main()
{
int y = 25;
return x + y;
}
0 remove statement at ("test/cases/constant.c": line 5)
0 inline variable y at ("test/cases/constant.c": line 4)
0 inline variable x at ("test/cases/constant.c": line 1)
// 0 inline variable x at ("test/cases/small/constant.c": line 1)
// 0 inline variable y at ("test/cases/small/constant.c": line 4)
// 0 remove statement at ("test/cases/small/constant.c": line 5)
// 0 replace by zero at ("test/cases/small/constant.c": line 5)
// 0 reduce to left at ("test/cases/small/constant.c": line 5)
// 0 reduce to right at ("test/cases/small/constant.c": line 5)
int x = 10;
int main()
{
int y = 25;
return x + y;
}
// 0 inline variable x at ("test/cases/small/constant.c": line 1)
// 0 inline variable y at ("test/cases/small/constant.c": line 4)
// 0 remove statement at ("test/cases/small/constant.c": line 5)
// 0 replace by zero at ("test/cases/small/constant.c": line 5)
// 0 reduce to left at ("test/cases/small/constant.c": line 5)
// 1 reduce to right at ("test/cases/small/constant.c": line 5)
int x = 10;
int main()
{
int y = 25;
return y;
}
// 0 inline variable x at ("test/cases/small/constant.c": line 1)
// 0 inline variable y at ("test/cases/small/constant.c": line 4)
// 0 remove statement at ("test/cases/small/constant.c": line 5)
// 0 replace by zero at ("test/cases/small/constant.c": line 5)
// 1 reduce to left at ("test/cases/small/constant.c": line 5)
int x = 10;
int main()
{
int y = 25;
return x;
}
// 0 inline variable x at ("test/cases/small/constant.c": line 1)
// 0 inline variable y at ("test/cases/small/constant.c": line 4)
// 0 remove statement at ("test/cases/small/constant.c": line 5)
// 1 replace by zero at ("test/cases/small/constant.c": line 5)
int x = 10;
int main()
{
int y = 25;
return 0;
}
// 0 inline variable x at ("test/cases/small/constant.c": line 1)
// 0 inline variable y at ("test/cases/small/constant.c": line 4)
// 1 remove statement at ("test/cases/small/constant.c": line 5)
int x = 10;
int main()
{
......
1 remove statement at ("test/cases/constant.c": line 5)
0 inline variable y at ("test/cases/constant.c": line 4)
0 inline variable x at ("test/cases/constant.c": line 1)
int x = 10;
int main()
{
return x + 25;
}
0 remove statement at ("test/cases/constant.c": line 5)
1 inline variable y at ("test/cases/constant.c": line 4)
0 inline variable x at ("test/cases/constant.c": line 1)
// 0 inline variable x at ("test/cases/small/constant.c": line 1)
// 1 inline variable y at ("test/cases/small/constant.c": line 4)
// 0 remove statement at ("test/cases/small/constant.c": line 5)
// 0 replace by zero at ("test/cases/small/constant.c": line 5)
// 0 reduce to left at ("test/cases/small/constant.c": line 5)
// 0 reduce to right at ("test/cases/small/constant.c": line 5)
int x = 10;
int main()
{
return x + 25;
}
// 0 inline variable x at ("test/cases/small/constant.c": line 1)
// 1 inline variable y at ("test/cases/small/constant.c": line 4)
// 0 remove statement at ("test/cases/small/constant.c": line 5)
// 0 replace by zero at ("test/cases/small/constant.c": line 5)
// 0 reduce to left at ("test/cases/small/constant.c": line 5)
// 1 reduce to right at ("test/cases/small/constant.c": line 5)
int x = 10;
int main()
{
return 25;
}
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment