45bc08b · rowtype-yoga/purescript-native

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

on golang help sign in

C++: move IfElse compacting to Optimizer

45bc08bAndy Arvanitis11 years ago

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

compare with golang

unifiedsplit

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

69 untilFixedPoint (inlineFnComposition . applyAll

70 [ collapseNestedBlocks

71 , collapseNestedIfs

72+ , collapseIfElses

72 , tco opts

73 , tco opts

73 , magicDo opts

74 , magicDo opts

74 , removeCodeAfterReturnStatements

75 , removeCodeAfterReturnStatements

src/Language/PureScript/CodeGen/Cpp/Optimizer/Blocks.hs+39

@@ -16,6 +16,7 @@

16module Language.PureScript.CodeGen.Cpp.Optimizer.Blocks

17 ( collapseNestedBlocks

18 , collapseNestedIfs

19+ , collapseIfElses

19 ) where

20 ) where

21import Language.PureScript.CodeGen.Cpp.AST

22import Language.PureScript.CodeGen.Cpp.AST

@@ -40,3 +41,41 @@ collapseNestedIfs = everywhereOnCpp collapse

40 collapse (CppIfElse cond1 (CppBlock [CppIfElse cond2 body Nothing]) Nothing) =

41 collapse (CppIfElse cond1 (CppBlock [CppIfElse cond2 body Nothing]) Nothing) =

41 CppIfElse (CppBinary And cond1 cond2) body Nothing

42 CppIfElse (CppBinary And cond1 cond2) body Nothing

42 collapse cpp = cpp

43 collapse cpp = cpp

44+

45+collapseIfElses :: Cpp -> Cpp

46+collapseIfElses = everywhereOnCpp collapse

47+ where

48+ collapse :: Cpp -> Cpp

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

50+ where

51+ go (st'@(CppIfElse (CppBinary Equal a _) _ Nothing) : sts') =

52+ if length (fst cpps') > 1

53+ then CppSwitch a (mkCases <$> fst cpps') : snd cpps'

54+ else st' : sts'

55+ where

56+ cpps' = span (isIntEq a) (st' : sts')

57+ isIntEq :: Cpp -> Cpp -> Bool

58+ isIntEq a (CppIfElse (CppBinary Equal a' (CppNumericLiteral (Left _))) (CppBlock [CppReturn _]) Nothing)

59+ | a == a' = True

60+ isIntEq a (CppIfElse (CppBinary Equal a' (CppCharLiteral _)) (CppBlock [CppReturn _]) Nothing)

61+ | a == a' = True

62+ isIntEq a (CppIfElse (CppBinary Equal a' (CppBooleanLiteral _)) (CppBlock [CppReturn _]) Nothing)

63+ | a == a' = True

64+ isIntEq _ _ = False

65+ mkCases :: Cpp -> (Cpp, Cpp)

66+ mkCases (CppIfElse (CppBinary Equal _ b') (CppBlock [body]) Nothing) = (b', body)

67+ mkCases (CppIfElse (CppUnary CppNot _) (CppBlock [body]) Nothing) = (CppBooleanLiteral False, body)

68+ mkCases (CppIfElse _ (CppBlock [body]) Nothing) = (CppBooleanLiteral True, body)

69+ mkCases _ = error ""

70+ go ((CppIfElse cond1 body1 Nothing) : (CppIfElse cond2 body2 Nothing) : _)

71+ | returns body1 && returns body2 &&

72+ (CppUnary CppNot cond1 == cond2 ||

73+ CppUnary CppNot cond2 == cond1) = [CppIfElse cond1 body1 (Just body2)]

74+ where

75+ returns :: Cpp -> Bool

76+ returns (CppBlock rets@(_:_)) | CppReturn{} <- last rets = True

77+ returns CppReturn{} = True

78+ returns _ = False

79+ go (cpp' : cpps') = cpp' : go cpps'

80+ go cpp' = cpp'

81+ collapse cpp = cpp

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

@@ -105,47 +105,16 @@ literals = mkPattern' match

105 ]

106 match (CppBlock sts) = concat <$> sequence

107 [ return "{\n"

108− , withIndent $ prettyStatements (compact sts)

108+ , withIndent $ prettyStatements sts

109 , return $ if null sts then "" else "\n"

110 , currentIndent

111 , return "}"

112 ]

113− where

114− compact :: [Cpp] -> [Cpp]

115− compact (st'@(CppIfElse (CppBinary Equal a _) _ Nothing) : sts') =

116− if length (fst cpps') > 1

117− then CppSwitch a (mkCases <$> fst cpps') : snd cpps'

118− else st' : sts'

119− where

120− cpps' = span (isIntEq a) (st' : sts')

121− compact ((CppIfElse cond1 body1 Nothing) : (CppIfElse cond2 body2 Nothing) : _)

122− | returns body1 && returns body2 &&

123− (CppUnary CppNot cond1 == cond2 ||

124− CppUnary CppNot cond2 == cond1) = [CppIfElse cond1 body1 (Just body2)]

125− where

126− returns :: Cpp -> Bool

127− returns (CppBlock rets@(_:_)) | CppReturn{} <- last rets = True

128− returns CppReturn{} = True

129− returns _ = False

130− compact (cpp' : cpps') = cpp' : compact cpps'

131− compact cpps' = cpps'

132− isIntEq :: Cpp -> Cpp -> Bool

133− isIntEq a (CppIfElse (CppBinary Equal a' (CppNumericLiteral (Left _))) (CppBlock [CppReturn _]) Nothing)

134− | a == a' = True

135− isIntEq a (CppIfElse (CppBinary Equal a' (CppCharLiteral _)) (CppBlock [CppReturn _]) Nothing)

136− | a == a' = True

137− isIntEq a (CppIfElse (CppBinary Equal a' (CppBooleanLiteral _)) (CppBlock [CppReturn _]) Nothing)

138− | a == a' = True

139− isIntEq _ _ = False

140− mkCases :: Cpp -> (Cpp, Cpp)

141− mkCases (CppIfElse (CppBinary Equal _ b') (CppBlock [body]) Nothing) = (b', body)

142− mkCases (CppIfElse (CppUnary CppNot _) (CppBlock [body]) Nothing) = (CppBooleanLiteral False, body)

143− mkCases (CppIfElse _ (CppBlock [body]) Nothing) = (CppBooleanLiteral True, body)

144− mkCases _ = error ""

145 match (CppNamespace _ []) = return []

113 match (CppNamespace _ []) = return []

146 match (CppNamespace [] sts) = fmap concat $ sequence $

114 match (CppNamespace [] sts) = fmap concat $ sequence $

147 [ return "\n"

115 [ return "\n"

148 , prettyStatements sts

116 , prettyStatements sts

117+ , return "#"

149 ]

118 ]

150 match (CppNamespace (':':':':name) sts) = fmap concat $ sequence $

119 match (CppNamespace (':':':':name) sts) = fmap concat $ sequence $

151 [ return "\n"

120 [ return "\n"

@@ -154,7 +123,7 @@ literals = mkPattern' match

154 , withIndent $ prettyStatements sts

123 , withIndent $ prettyStatements sts

155 , return "\n"

124 , return "\n"

156 , currentIndent

125 , currentIndent

157− , return "}"

126+ , return "}#"

158 ]

127 ]

159 match (CppNamespace name sts) = fmap concat $ sequence $

128 match (CppNamespace name sts) = fmap concat $ sequence $

160 [ return "\n"

129 [ return "\n"

@@ -163,7 +132,7 @@ literals = mkPattern' match

163 , withIndent $ prettyStatements sts'

132 , withIndent $ prettyStatements sts'

164 , return "\n"

133 , return "\n"

165 , currentIndent

134 , currentIndent

166− , return "}"

135+ , return "}#"

167 ]

136 ]

168 ++ let (cpp', cpps') = fromNested nested' in

137 ++ let (cpp', cpps') = fromNested nested' in

169 map match cpp'

138 map match cpp'

@@ -426,6 +395,7 @@ prettyStatements sts = do

426 addsemi [] = []

395 addsemi [] = []

427 addsemi s | all isSpace s = []

396 addsemi s | all isSpace s = []

428 addsemi s@('#':_) = s

397 addsemi s@('#':_) = s

398+ addsemi s | last s == '#' = init s

429 addsemi s = s ++ ";"

399 addsemi s = s ++ ";"

430

400

431-- |

401-- |