@@ -21,7 +21,7 @@ module Language.PureScript.CodeGen.Cpp.Optimizer.Blocks
2121 ) where
2222
2323import Prelude.Compat
24−import Control.Monad (foldM)
24+import Data.Either
2525
2626import Language.PureScript.CodeGen.Cpp.AST
2727import Language.PureScript.CodeGen.Cpp.Types
@@ -91,26 +91,19 @@ collapseCtorChecksToSwitch :: Cpp -> Cpp
9191collapseCtorChecksToSwitch = everywhereOnCpp collapse
9292 where
9393 collapse :: Cpp -> Cpp
94− collapse (CppBlock cpps) = CppBlock (go cpps)
94+ collapse (CppBlock cpps@(_:_:_)) = CppBlock (go cpps)
9595 where
96− go cpps'
97− | length cpps' > 2
98− , ifs <- init cpps'
99− , def@(CppThrow _) <- last cpps'
100− , Just (cond, _, _) <- fromif $ head ifs
101− , Just (cond', cases) <- foldM builder (cond, []) ifs
102− = [CppSwitch cond' cases (Just def)]
103− go (cpp' : cpps') = cpp' : go cpps'
96+ go cpps'@(cpp:_)
97+ | Right (lhs, _, _) <- fromif Nothing cpp
98+ , (otherCpps, ifs@(_:_:_)) <- partitionEithers $ fromif (Just lhs) <$> cpps'
99+ = CppSwitch lhs ((\(_,b,c) -> (b,c)) <$> ifs) Nothing : otherCpps
100+ go (cpp':cpps') = cpp' : go cpps'
104101 go cpp' = cpp'
105− fromif :: Cpp -> Maybe (Cpp, Cpp, Cpp)
106− fromif (CppIfElse (CppBinary EqualTo lhs rhs) stmt Nothing)
102+ fromif :: Maybe Cpp -> Cpp -> Either Cpp (Cpp, Cpp, Cpp)
103+ fromif cond (CppIfElse (CppBinary EqualTo lhs rhs) stmt Nothing)
107104 | CppApp (CppVar f) _ <- lhs
108− , f == getCtor = Just (lhs, rhs, stmt)
109− fromif _ = Nothing
110− builder :: (Cpp, [(Cpp, Cpp)]) -> Cpp -> Maybe (Cpp, [(Cpp, Cpp)])
111− builder (cond, cases) cpp
112− | Just (lhs, rhs, stmt) <- fromif cpp
113− , lhs == cond
114− = Just (cond, cases ++ [(rhs, stmt)])
115− builder _ _ = Nothing
105+ , f == getCtor
106+ , maybe True (lhs==) cond
107+ = Right (lhs, rhs, stmt)
108+ fromif _ cpp = Left cpp
116109 collapse cpp = cpp