4dddf7e · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

C++: convert data ctor checks to switch statements, where possible

commit4dddf7edbfa4f25906dc3d9490f52fab8ad5f9bf authorAndy Arvanitis <andyarvanitis@gmail.com> dateMon 19 Dec 2016, 21:36 (10 years ago) parent3f816d0

5 files changed+69−11

compare with golang

unifiedsplit

pcc/runtime/purescript.hh+1−1 src/Language/PureScript/CodeGen/Cpp/AST.hs+5−4 src/Language/PureScript/CodeGen/Cpp/Optimizer.hs+1 src/Language/PureScript/CodeGen/Cpp/Optimizer/Blocks.hs+32−1 src/Language/PureScript/Pretty/Cpp.hs+30−5

pcc/runtime/purescript.hh+1−1

@@ -517,7 +517,7 @@ namespace data {

517517 }

518518

519519 template <typename T>

520− inline auto ctor(const T& a) -> const any& {

520+ inline auto ctor(const T& a) -> int {

521521 return get<0>(a);

522522 }

523523}

src/Language/PureScript/CodeGen/Cpp/AST.hs+5−4

@@ -270,7 +270,7 @@ data Cpp

270270 -- |

271271 -- Switch statement

272272 --

273− | CppSwitch Cpp [(Cpp, Cpp)]

273+ | CppSwitch Cpp [(Cpp, Cpp)] (Maybe Cpp)

274274 -- |

275275 -- Return statement

276276 --

@@ -329,7 +329,7 @@ everywhereOnCpp f = go

329329 go (CppAssignment j1 j2) = f (CppAssignment (go j1) (go j2))

330330 go (CppWhile j1 j2) = f (CppWhile (go j1) (go j2))

331331 go (CppIfElse j1 j2 j3) = f (CppIfElse (go j1) (go j2) (fmap go j3))

332− go (CppSwitch cpp cpps) = f (CppSwitch (go cpp) (map (fmap go) cpps))

332+ go (CppSwitch cpp cpps d) = f (CppSwitch (go cpp) (map (fmap go) cpps) (fmap go d))

333333 go (CppReturn cpp) = f (CppReturn (go cpp))

334334 go (CppThrow cpp) = f (CppThrow (go cpp))

335335 go (CppComment com j) = f (CppComment com (go j))

@@ -362,7 +362,7 @@ everywhereOnCppTopDownM f = f >=> go

362362 go (CppAssignment j1 j2) = CppAssignment <$> f' j1 <*> f' j2

363363 go (CppWhile j1 j2) = CppWhile <$> f' j1 <*> f' j2

364364 go (CppIfElse j1 j2 j3) = CppIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3

365− go (CppSwitch cpp cpps) = CppSwitch <$> f' cpp <*> traverse (pairM f' f') cpps

365+ go (CppSwitch cpp cpps d) = CppSwitch <$> f' cpp <*> traverse (pairM f' f') cpps <*> traverse f' d

366366 go (CppReturn j) = CppReturn <$> f' j

367367 go (CppThrow j) = CppThrow <$> f' j

368368 go (CppComment com j) = CppComment com <$> f' j

@@ -392,7 +392,8 @@ everythingOnCpp (<>) f = go

392392 go j@(CppWhile j1 j2) = f j <> go j1 <> go j2

393393 go j@(CppIfElse j1 j2 Nothing) = f j <> go j1 <> go j2

394394 go j@(CppIfElse j1 j2 (Just j3)) = f j <> go j1 <> go j2 <> go j3

395− go j@(CppSwitch cpp cpps) = foldl (<>) (f j <> go cpp) ((map (go . fst) cpps) ++ (map (go . snd) cpps))

395+ go j@(CppSwitch cpp cpps Nothing) = foldl (<>) (f j <> go cpp) ((map (go . fst) cpps) ++ (map (go . snd) cpps))

396+ go j@(CppSwitch cpp cpps (Just d)) = foldl (<>) (f j <> go cpp) ((map (go . fst) cpps) ++ (map (go . snd) cpps)) <> go d

396397 go j@(CppReturn j1) = f j <> go j1

397398 go j@(CppThrow j1) = f j <> go j1

398399 go j@(CppComment _ j1) = f j <> go j1

src/Language/PureScript/CodeGen/Cpp/Optimizer.hs+1

@@ -69,6 +69,7 @@ optimize' nm cpp = do

6969 opts <- ask

7070 untilFixedPoint (liftM toAutoVars . inlineFnComposition . applyAll

7171 [ collapseNestedBlocks

72+ , collapseCtorChecksToSwitch

7273 , collapseNestedIfs

7374 , collapseIfElses

7475 , removeCurrying nm

src/Language/PureScript/CodeGen/Cpp/Optimizer/Blocks.hs+32−1

@@ -17,11 +17,14 @@ module Language.PureScript.CodeGen.Cpp.Optimizer.Blocks

1717 ( collapseNestedBlocks

1818 , collapseNestedIfs

1919 , collapseIfElses

20+ , collapseCtorChecksToSwitch

2021 ) where

2122

2223import Prelude.Compat

24+import Control.Monad (foldM)

2325

2426import Language.PureScript.CodeGen.Cpp.AST

27+import Language.PureScript.CodeGen.Cpp.Types

2528import qualified Language.PureScript.Constants as C

2629

2730-- |

@@ -53,7 +56,7 @@ collapseIfElses = everywhereOnCpp collapse

5356 where

5457 go (st'@(CppIfElse (CppBinary EqualTo lhs _) _ Nothing) : sts') =

5558 if length (fst cpps') > 1

56− then CppSwitch lhs (mkCases <$> fst cpps') : snd cpps'

59+ then CppSwitch lhs (mkCases <$> fst cpps') Nothing : snd cpps'

5760 else st' : sts'

5861 where

5962 cpps' = span (isIntEq lhs) (st' : sts')

@@ -83,3 +86,31 @@ collapseIfElses = everywhereOnCpp collapse

8386 go cpp' = cpp'

8487 collapse (CppIfElse (CppAccessor (CppVar "otherwise") (CppVar mn')) body _) | mn' == C.prelude = body

8588 collapse cpp = cpp

89+

90+collapseCtorChecksToSwitch :: Cpp -> Cpp

91+collapseCtorChecksToSwitch = everywhereOnCpp collapse

92+ where

93+ collapse :: Cpp -> Cpp

94+ collapse (CppBlock cpps) = CppBlock (go cpps)

95+ 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'

104+ go cpp' = cpp'

105+ fromif :: Cpp -> Maybe (Cpp, Cpp, Cpp)

106+ fromif (CppIfElse (CppBinary EqualTo lhs rhs) stmt Nothing)

107+ | 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

116+ collapse cpp = cpp

src/Language/PureScript/Pretty/Cpp.hs+30−5

@@ -276,15 +276,17 @@ literals = mkPattern' match

276276 , prettyPrintCpp' thens

277277 , maybe (return "") (fmap (" else " <>) . prettyPrintCpp') elses

278278 ]

279− match (CppSwitch cond cases@((case1,_):_:_)) = mconcat <$> sequence

279+ match (CppSwitch cond cases@((case1,_):_:_) default') = mconcat <$> sequence

280280 [ return "switch "

281281 , return . parensT $ prettyPrintCpp1 (cast case1 cond)

282282 , return " {\n"

283283 , withIndent $ do

284− cpps <- forM cases $ \(c, s) -> do

285− c' <- prettyPrintCpp' c

286− s' <- prettyPrintCpp' s

287− return $ "case " <> c' <> ": " <> s' <> ";"

284+ cpps <- forM (normalizeBlocks $

285+ cases ++ maybe [] (\c -> [(CppNoOp,c)]) default')

286+ $ \(c, s) -> do

287+ c' <- prettyPrintCpp' c

288+ s' <- prettyPrintCpp' s

289+ return $ label c <> c' <> ": " <> s' <> caseEnd s

288290 indentString <- currentIndent

289291 return $ T.intercalate "\n" $ map (indentString <>) cpps

290292 , return "\n"

@@ -297,6 +299,25 @@ literals = mkPattern' match

297299 cast CppBooleanLiteral {} cpp' = CppCast boolType cpp'

298300 cast CppCharLiteral {} cpp' = CppCast charType cpp'

299301 cast _ cpp' = cpp'

302+ normalizeBlocks :: [(Cpp,Cpp)] -> [(Cpp,Cpp)]

303+ normalizeBlocks cpps

304+ | any (isBlock . snd) cpps = addBlock <$> cpps

305+ | otherwise = cpps

306+ where

307+ addBlock (cpp1, cpp2@(CppBlock _)) = (cpp1, cpp2)

308+ addBlock (cpp1, cpp2) = (cpp1, CppBlock [cpp2])

309+ label :: Cpp -> Text

310+ label CppNoOp = "default"

311+ label _ = "case "

312+ caseEnd :: Cpp -> Text

313+ caseEnd (CppReturn {}) = ";"

314+ caseEnd (CppThrow {}) = ";"

315+ caseEnd (CppContinue) = ";"

316+ caseEnd (CppBlock stmts@(_:_))

317+ | (CppReturn {}) <- last stmts = ""

318+ | (CppThrow {}) <- last stmts = ""

319+ | CppContinue <- last stmts = ""

320+ caseEnd _ = " break;"

300321 match (CppReturn (CppBlock (cpp:cpps))) = mconcat <$> sequence

301322 [ do s <- prettyPrintCpp' cpp

302323 return $ T.dropWhile isSpace s

@@ -538,6 +559,10 @@ isNoOp CppNoOp = True

538559isNoOp (CppComment [] CppNoOp) = True

539560isNoOp _ = False

540561

562+isBlock :: Cpp -> Bool

563+isBlock (CppBlock {}) = True

564+isBlock _ = False

565+

541566renderName :: Text -> Text

542567renderName name

543568 | Just ('*', name') <- T.uncons name = '$' `T.cons` name'