4dddf7e · rowtype-yoga/purescript-native

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

on golang help sign in

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

4dddf7eAndy Arvanitis10 years ago

pcc/runtime/purescript.hh+1−1

compare with golang

unifiedsplit

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

517 }

518

519 template <typename T>

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

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

521 return get<0>(a);

522 }

523}

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

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

270 -- |

271 -- Switch statement

272 --

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

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

274 -- |

275 -- Return statement

276 --

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

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

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

331 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))

333 go (CppReturn cpp) = f (CppReturn (go cpp))

334 go (CppThrow cpp) = f (CppThrow (go cpp))

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

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

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

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

364 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

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

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

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

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

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

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

394 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

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

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

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

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

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

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

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

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

69 opts <- ask

70 untilFixedPoint (liftM toAutoVars . inlineFnComposition . applyAll

71 [ collapseNestedBlocks

72+ , collapseCtorChecksToSwitch

72 , collapseNestedIfs

73 , collapseNestedIfs

73 , collapseIfElses

74 , collapseIfElses

74 , removeCurrying nm

75 , removeCurrying nm

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

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

17 ( collapseNestedBlocks

18 , collapseNestedIfs

19 , collapseIfElses

20+ , collapseCtorChecksToSwitch

20 ) where

21 ) where

22import Prelude.Compat

23import Prelude.Compat

24+import Control.Monad (foldM)

24import Language.PureScript.CodeGen.Cpp.AST

26import Language.PureScript.CodeGen.Cpp.AST

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

25import qualified Language.PureScript.Constants as C

28import qualified Language.PureScript.Constants as C

27-- |

30-- |

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

53 where

56 where

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

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

55 if length (fst cpps') > 1

58 if length (fst cpps') > 1

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

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

57 else st' : sts'

60 else st' : sts'

58 where

61 where

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

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

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

83 go cpp' = cpp'

86 go cpp' = cpp'

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

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

85 collapse cpp = cpp

88 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

276 , prettyPrintCpp' thens

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

278 ]

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

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

280 [ return "switch "

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

282 , return " {\n"

283 , withIndent $ do

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

284+ cpps <- forM (normalizeBlocks $

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

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

285− c' <- prettyPrintCpp' c

287+ c' <- prettyPrintCpp' c

286− s' <- prettyPrintCpp' s

288+ s' <- prettyPrintCpp' s

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

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

288 indentString <- currentIndent

290 indentString <- currentIndent

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

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

290 , return "\n"

292 , return "\n"

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

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

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

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

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

299 cast _ cpp' = cpp'

301 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;"

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

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

301 [ do s <- prettyPrintCpp' cpp

322 [ do s <- prettyPrintCpp' cpp

302 return $ T.dropWhile isSpace s

323 return $ T.dropWhile isSpace s

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

538isNoOp (CppComment [] CppNoOp) = True

559isNoOp (CppComment [] CppNoOp) = True

539isNoOp _ = False

560isNoOp _ = False

540

561

562+isBlock :: Cpp -> Bool

563+isBlock (CppBlock {}) = True

564+isBlock _ = False

565+

541renderName :: Text -> Text

566renderName :: Text -> Text

542renderName name

567renderName name

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

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