cdc44ab · rowtype-yoga/purescript-native

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

C++: convert some exprs to switch and if-else

commitcdc44ab248ae1f767f5c59c6649baa92762bf78f authorAndy Arvanitis <andyarvanitis@gmail.com> dateSat 6 Feb 2016, 23:23 (11 years ago) parentccf33d6

3 files changed+63−3

compare with golang

unifiedsplit

src/Language/PureScript/CodeGen/Cpp.hs+1−1 src/Language/PureScript/CodeGen/Cpp/AST.hs+7 src/Language/PureScript/Pretty/Cpp.hs+55−2

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

@@ -439,7 +439,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

439439 return [CppIfElse (CppBinary Equal (CppVar varName) (CppNumericLiteral num)) (CppBlock done) Nothing]

440440

441441 literalToBinderCpp varName done (CharLiteral c) =

442− return [CppIfElse (CppBinary Equal (CppCast charType $ CppVar varName)

442+ return [CppIfElse (CppBinary Equal (CppVar varName)

443443 (CppCharLiteral c))

444444 (CppBlock done)

445445 Nothing]

src/Language/PureScript/CodeGen/Cpp/AST.hs+7

@@ -238,6 +238,10 @@ data Cpp

238238 --

239239 | CppIfElse Cpp Cpp (Maybe Cpp)

240240 -- |

241+ -- Switch statement

242+ --

243+ | CppSwitch Cpp [(Cpp, Cpp)]

244+ -- |

241245 -- Return statement

242246 --

243247 | CppReturn Cpp

@@ -291,6 +295,7 @@ everywhereOnCpp f = go

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

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

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

298+ go (CppSwitch cpp cpps) = f (CppSwitch (go cpp) (map (fmap go) cpps))

294299 go (CppReturn cpp) = f (CppReturn (go cpp))

295300 go (CppThrow cpp) = f (CppThrow (go cpp))

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

@@ -319,6 +324,7 @@ everywhereOnCppTopDownM f = f >=> go

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

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

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

327+ go (CppSwitch cpp cpps) = CppSwitch <$> f' cpp <*> traverse (sndM f') cpps

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

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

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

@@ -344,6 +350,7 @@ everythingOnCpp (<>) f = go

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

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

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

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

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

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

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

src/Language/PureScript/Pretty/Cpp.hs+55−2

@@ -97,13 +97,45 @@ literals = mkPattern' match

9797 return $ ' ' : cpps

9898 else return ""

9999 ]

100− match (CppBlock sts) = fmap concat $ sequence

100+ match (CppBlock sts) = concat <$> sequence

101101 [ return "{\n"

102− , withIndent $ prettyStatements sts

102+ , withIndent $ prettyStatements (compact sts)

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

104104 , currentIndent

105105 , return "}"

106106 ]

107+ where

108+ compact :: [Cpp] -> [Cpp]

109+ compact (st'@(CppIfElse (CppBinary Equal a _) _ Nothing) : sts') =

110+ if length (fst cpps') > 1

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

112+ else st' : sts'

113+ where

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

115+ compact ((CppIfElse cond1 body1 Nothing) : (CppIfElse cond2 body2 Nothing) : _)

116+ | returns body1 && returns body2 &&

117+ (CppUnary CppNot cond1 == cond2 ||

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

119+ where

120+ returns :: Cpp -> Bool

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

122+ returns CppReturn{} = True

123+ returns _ = False

124+ compact (cpp' : cpps') = cpp' : compact cpps'

125+ compact cpps' = cpps'

126+ isIntEq :: Cpp -> Cpp -> Bool

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

128+ | a == a' = True

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

130+ | a == a' = True

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

132+ | a == a' = True

133+ isIntEq _ _ = False

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

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

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

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

138+ mkCases _ = error ""

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

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

109141 [ return "\n"

@@ -208,6 +240,27 @@ literals = mkPattern' match

208240 , prettyPrintCpp' thens

209241 , maybe (return "") (fmap (" else " ++) . prettyPrintCpp') elses

210242 ]

243+ match (CppSwitch cond cases@((case1,_):_:_)) = fmap concat $ sequence

244+ [ return "switch "

245+ , return . parens $ prettyPrintCpp1 (cast case1 cond)

246+ , return " {\n"

247+ , withIndent $ do

248+ cpps <- forM cases $ \(c, s) -> do

249+ c' <- prettyPrintCpp' c

250+ s' <- prettyPrintCpp' s

251+ return $ "case " ++ c' ++ ": " ++ s' ++ ";"

252+ indentString <- currentIndent

253+ return $ intercalate "\n" $ map (indentString ++) cpps

254+ , return "\n"

255+ , currentIndent

256+ , return "}"

257+ ]

258+ where

259+ cast :: Cpp -> Cpp -> Cpp

260+ cast CppNumericLiteral{} cpp' = CppCast intType cpp'

261+ cast CppBooleanLiteral{} cpp' = CppCast boolType cpp'

262+ cast CppCharLiteral{} cpp' = CppCast charType cpp'

263+ cast _ cpp' = cpp'

211264 match (CppReturn (CppBlock (cpp:cpps))) = fmap concat $ sequence

212265 [ do s <- prettyPrintCpp' cpp

213266 return $ dropWhile isSpace s