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

Add a don't repair flag

parent 68f384cd
No related branches found
No related tags found
No related merge requests found
...@@ -1137,9 +1137,14 @@ etUnPointer t = ...@@ -1137,9 +1137,14 @@ etUnPointer t =
checkNotAssignable :: (MonadPlus m) => EType -> m () checkNotAssignable :: (MonadPlus m) => EType -> m ()
checkNotAssignable = guard . not . etAssignable checkNotAssignable = guard . not . etAssignable
msplit :: (MonadReduce Lab m) => Lab -> Maybe (m a) -> Maybe (m a) -> Maybe (m a) msplit :: (MonadReduce Lab m) => Context -> Lab -> Maybe (m a) -> Maybe (m a) -> Maybe (m a)
msplit l m1 m2 = do msplit ctx l m1 m2
case m1 of | DontRepairExpressions `isIn` ctx = do
b <- m2
Just $ case m1 of
Just a -> split l a b
Nothing -> b
| otherwise = case m1 of
Just a -> Just $ case m2 of Just a -> Just $ case m2 of
Just b -> split l a b Just b -> split l a b
Nothing -> a Nothing -> a
...@@ -1218,8 +1223,8 @@ reduceCExpr :: ...@@ -1218,8 +1223,8 @@ reduceCExpr ::
Maybe (m C.CExpr) Maybe (m C.CExpr)
reduceCExpr expr t ctx = case expr of reduceCExpr expr t ctx = case expr of
C.CBinary o elhs erhs ni -> do C.CBinary o elhs erhs ni -> do
msplit ("reduce to left", C.posOf elhs) (reduceCExpr elhs t ctx) do msplit ctx ("reduce to left", C.posOf elhs) (reduceCExpr elhs t ctx) do
msplit ("reduce to right", C.posOf erhs) (reduceCExpr erhs t ctx) do msplit ctx ("reduce to right", C.posOf erhs) (reduceCExpr erhs t ctx) do
checkNotAssignable t checkNotAssignable t
when (o `elem` [C.CNeqOp, C.CEqOp, C.CGeqOp, C.CLeqOp, C.CGrOp, C.CLeOp]) do when (o `elem` [C.CNeqOp, C.CEqOp, C.CGeqOp, C.CLeqOp, C.CGrOp, C.CLeOp]) do
checkExpectedType ctx (NonVoid TNum) t checkExpectedType ctx (NonVoid TNum) t
...@@ -1242,8 +1247,8 @@ reduceCExpr expr t ctx = case expr of ...@@ -1242,8 +1247,8 @@ reduceCExpr expr t ctx = case expr of
_ow -> r' _ow -> r'
pure $ C.CBinary o l' r'' ni pure $ C.CBinary o l' r'' ni
C.CAssign o elhs erhs ni -> C.CAssign o elhs erhs ni ->
msplit ("reduce to left", C.posOf elhs) (reduceCExpr elhs t ctx) do msplit ctx ("reduce to left", C.posOf elhs) (reduceCExpr elhs t ctx) do
msplit ("reduce to right", C.posOf erhs) (reduceCExpr erhs t ctx) do msplit ctx ("reduce to right", C.posOf erhs) (reduceCExpr erhs t ctx) do
c <- inferType ctx elhs c <- inferType ctx elhs
checkExpectedType ctx c t checkExpectedType ctx c t
let t' = fromVoid etAny exactly c let t' = fromVoid etAny exactly c
...@@ -1284,7 +1289,7 @@ reduceCExpr expr t ctx = case expr of ...@@ -1284,7 +1289,7 @@ reduceCExpr expr t ctx = case expr of
checkExpectedType ctx (NonVoid TNum) t checkExpectedType ctx (NonVoid TNum) t
Just (pure expr) Just (pure expr)
C.CUnary o eopr ni -> do C.CUnary o eopr ni -> do
msplit ("reduce to operant", C.posOf eopr) (reduceCExpr eopr t ctx) do msplit ctx ("reduce to operant", C.posOf eopr) (reduceCExpr eopr t ctx) do
case o of case o of
C.CIndOp -> do C.CIndOp -> do
ropr <- case etSet t of ropr <- case etSet t of
...@@ -1309,10 +1314,7 @@ reduceCExpr expr t ctx = case expr of ...@@ -1309,10 +1314,7 @@ reduceCExpr expr t ctx = case expr of
reduceCExpr eopr t ctx <&> \ropr -> do reduceCExpr eopr t ctx <&> \ropr -> do
eopr' <- ropr eopr' <- ropr
pure $ C.CUnary o eopr' ni pure $ C.CUnary o eopr' ni
C.CCall ef args ni -> do C.CCall ef args ni -> orHoistSubExpression do
(\fn a -> foldr fn a args)
(\e -> msplit ("reduce to expression", C.posOf e) (reduceCExpr e t ctx))
do
ct <- inferType ctx ef ct <- inferType ctx ef
case ct of case ct of
NonVoid ft@(TFun (FunType rt fargs)) -> do NonVoid ft@(TFun (FunType rt fargs)) -> do
...@@ -1337,10 +1339,13 @@ reduceCExpr expr t ctx = case expr of ...@@ -1337,10 +1339,13 @@ reduceCExpr expr t ctx = case expr of
<> show ow <> show ow
<> " at " <> " at "
<> show (C.posOf ef) <> show (C.posOf ef)
where
orHoistSubExpression a =
foldr (\e -> msplit ctx ("reduce to expression", C.posOf e) (reduceCExpr e t ctx)) a args
C.CCond et (Just ec) ef ni -> do C.CCond et (Just ec) ef ni -> do
msplit ("reduce to true branch", C.posOf et) (reduceCExpr et t ctx) do msplit ctx ("reduce to true branch", C.posOf et) (reduceCExpr et t ctx) do
msplit ("reduce to false branch", C.posOf ef) (reduceCExpr ef t ctx) do msplit ctx ("reduce to false branch", C.posOf ef) (reduceCExpr ef t ctx) do
msplit ("reduce to condtion", C.posOf ef) (reduceCExpr ec t ctx) do msplit ctx ("reduce to condtion", C.posOf ef) (reduceCExpr ec t ctx) do
checkNotAssignable t checkNotAssignable t
ret <- reduceCExpr et t ctx ret <- reduceCExpr et t ctx
ref <- reduceCExpr ef t ctx ref <- reduceCExpr ef t ctx
...@@ -1351,7 +1356,7 @@ reduceCExpr expr t ctx = case expr of ...@@ -1351,7 +1356,7 @@ reduceCExpr expr t ctx = case expr of
ec' <- rec ec' <- rec
pure $ C.CCond et' (Just ec') ef' ni pure $ C.CCond et' (Just ec') ef' ni
C.CCast (C.CDecl spec items ni2) e ni -> do C.CCast (C.CDecl spec items ni2) e ni -> do
msplit ("do not cast", C.posOf ni) (reduceCExpr e t ctx) do msplit ctx ("do not cast", C.posOf ni) (reduceCExpr e t ctx) do
fn <- updateCDeclarationSpecifiers keepAll ctx spec fn <- updateCDeclarationSpecifiers keepAll ctx spec
hole <- case items of hole <- case items of
[C.CDeclarationItem (C.CDeclr Nothing dd Nothing [] a) b c] -> do [C.CDeclarationItem (C.CDeclr Nothing dd Nothing [] a) b c] -> do
...@@ -1372,8 +1377,8 @@ reduceCExpr expr t ctx = case expr of ...@@ -1372,8 +1377,8 @@ reduceCExpr expr t ctx = case expr of
(spec', items', e') <- hole (spec', items', e') <- hole
pure (C.CCast (C.CDecl spec' items' ni2) e' ni) pure (C.CCast (C.CDecl spec' items' ni2) e' ni)
C.CIndex e1 e2 ni -> do C.CIndex e1 e2 ni -> do
msplit ("reduce to indexee", C.posOf e1) (reduceCExpr e1 t ctx) do msplit ctx ("reduce to indexee", C.posOf e1) (reduceCExpr e1 t ctx) do
msplit ("reduce to index", C.posOf e2) (reduceCExpr e2 t ctx) do msplit ctx ("reduce to index", C.posOf e2) (reduceCExpr e2 t ctx) do
re1 <- reduceCExpr e1 t{etSet = ETPointer (etSet t), etAssignable = True} ctx re1 <- reduceCExpr e1 t{etSet = ETPointer (etSet t), etAssignable = True} ctx
Just do Just do
e1' <- re1 e1' <- re1
...@@ -1384,7 +1389,7 @@ reduceCExpr expr t ctx = case expr of ...@@ -1384,7 +1389,7 @@ reduceCExpr expr t ctx = case expr of
C.CComma items ni -> do C.CComma items ni -> do
(x, rst) <- List.uncons (reverse items) (x, rst) <- List.uncons (reverse items)
(\fn a -> foldr fn a (reverse items)) (\fn a -> foldr fn a (reverse items))
(\e -> msplit ("reduce to expression", C.posOf e) (reduceCExpr e t ctx)) (\e -> msplit ctx ("reduce to expression", C.posOf e) (reduceCExpr e t ctx))
do do
rx <- reduceCExpr x t ctx rx <- reduceCExpr x t ctx
Just do Just do
...@@ -1480,6 +1485,7 @@ data Keyword ...@@ -1480,6 +1485,7 @@ data Keyword
| AllowEmptyDeclarations | AllowEmptyDeclarations
| DontReduceArrays | DontReduceArrays
| DontRemoveStatic | DontRemoveStatic
| DontRepairExpressions
| DisallowVariableInlining | DisallowVariableInlining
| AllowInfiniteForLoops | AllowInfiniteForLoops
deriving (Show, Read, Enum, Eq, Ord) deriving (Show, Read, Enum, Eq, Ord)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment