5e025c4 · rowtype-yoga/purescript-native

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

on golang help sign in

C++: reduce num of thunks with funcs where possible

5e025c4Andy Arvanitis11 years ago

src/Language/PureScript/CodeGen/Cpp.hs+32−5

compare with golang

unifiedsplit

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

68 delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $

69 imps

70 let cppImports' = "PureScript" : cppImports

71− cppDecls <- concat <$> mapM bindToCpp decls

71+ cppDecls <- concat <$> mapM (bindToCpp [CppTopLevel]) decls

72 optimized <- traverse optimize cppDecls

73 let moduleHeader =

74 fileBegin mn "HH" ++

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

101 -- Generate code in the simplified C++1x intermediate representation for a declaration

102 --

103 -------------------------------------------------------------------------------------------------

104− bindToCpp :: Bind Ann -> m [Cpp]

104+ bindToCpp :: [CppValueQual] -> Bind Ann -> m [Cpp]

105 -------------------------------------------------------------------------------------------------

106− bindToCpp (NonRec ident val) = return <$> declToCpp [] ident val

106+ bindToCpp qs (NonRec ident val) = return <$> declToCpp qs ident val

107− bindToCpp (Rec vals) = forM vals (uncurry $ declToCpp [CppRecursive])

107+ bindToCpp qs (Rec vals) = forM vals (uncurry $ declToCpp (CppRecursive:qs))

108

109 -- |

110 -- Desugar a declaration into a variable introduction or named function

@@ -177,6 +177,33 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

177 | otherwise = fullyConstructed

178 fullyConstructed = [CppReturn (CppDataLiteral (CppStringLiteral name : (CppVar <$> fields')))]

179

180+ declToCpp qs ident e@(App (_, _, Just ty, _) _ _)

181+ | CppTopLevel `elem` qs,

182+ count <- countArgs ty,

183+ count > 0 = do

184+ argNames <- replicateM count freshName

185+ block <- flip (foldl (\fn a -> CppApp fn [a])) (CppVar <$> argNames) <$> valueToCpp e

186+ return $ CppFunction

187+ (identToCpp ident)

188+ [(head argNames, Just $ CppAny [CppConst, CppRef])]

189+ (Just $ CppAny [])

190+ []

191+ (asReturnBlock $ curried (tail argNames) block)

192+ where

193+ curried :: [String] -> Cpp -> Cpp

194+ curried args vals = foldl (\val arg -> CppLambda

195+ [CppCaptureAll]

196+ [(arg, Just $ CppAny [CppConst, CppRef])]

197+ (Just $ CppAny [])

198+ (asReturnBlock val)

199+ ) vals args

200+ countArgs :: T.Type -> Int

201+ countArgs = go 0

202+ where

203+ go argcnt (T.ForAll _ t _) = go argcnt t

204+ go argcnt (T.TypeApp (T.TypeApp fn _) t) | fn == E.tyFunction = go (argcnt + 1) t

205+ go argcnt _ = argcnt

206+

180 declToCpp _ ident val = do

207 declToCpp _ ident val = do

181 val' <- valueToCpp val

208 val' <- valueToCpp val

182 return $

209 return $

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

351 bindersToCpp maybeSpan ty binders vals

378 bindersToCpp maybeSpan ty binders vals

352

379

353 valueToCpp (Let _ ds val) = do

380 valueToCpp (Let _ ds val) = do

354− ds' <- concat <$> mapM bindToCpp ds

381+ ds' <- concat <$> mapM (bindToCpp []) ds

355 ret <- valueToCpp val

382 ret <- valueToCpp val

356 let ds'' = tco defaultOptions <$> ds'

383 let ds'' = tco defaultOptions <$> ds'

357 let rs = if hasRecursion ds''

384 let rs = if hasRecursion ds''

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

@@ -19,7 +19,6 @@

19module Language.PureScript.CodeGen.Cpp.Types where

21import Data.List

22−import Data.Data

24import Language.PureScript.CodeGen.Cpp.Common

23import Language.PureScript.CodeGen.Cpp.Common

25import Language.PureScript.Names

24import Language.PureScript.Names

@@ -57,6 +56,10 @@ data CppValueQual

57 -- Function or lambda is involved in recursion

56 -- Function or lambda is involved in recursion

58 --

57 --

59 | CppRecursive

58 | CppRecursive

59+ -- |

60+ -- Function or lambda is involved in recursion

61+ --

62+ | CppTopLevel

60 deriving (Show, Read, Eq)

63 deriving (Show, Read, Eq)

62-- |

65-- |

@@ -79,6 +82,7 @@ runValueQual CppInline = "inline"

79runValueQual CppConstExpr = "constexpr"

82runValueQual CppConstExpr = "constexpr"

80runValueQual CppExtern = "extern"

83runValueQual CppExtern = "extern"

81runValueQual CppRecursive = ""

84runValueQual CppRecursive = ""

85+runValueQual CppTopLevel = ""

83runCaptureType :: CppCaptureType -> String

87runCaptureType :: CppCaptureType -> String

84runCaptureType CppCaptureAll = "="

88runCaptureType CppCaptureAll = "="