Add a don't repair flag

rtree-c/src/ReduceC.hs

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