6bb47ae · rowtype-yoga/purescript-native

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

C++: optimize data ctors (when full construction)

commit6bb47ae74c077e1612607d0167fd2f1c80dcb5af authorAndy Arvanitis <andyarvanitis@gmail.com> dateSat 13 Feb 2016, 19:27 (11 years ago) parentcdc44ab

4 files changed+31−7

compare with golang

unifiedsplit

src/Language/PureScript/CodeGen/Cpp.hs+20−6 src/Language/PureScript/CodeGen/Cpp/Common.hs+1−1 src/Language/PureScript/CodeGen/Cpp/File.hs+6 src/Language/PureScript/Pretty/Cpp.hs+4

src/Language/PureScript/CodeGen/Cpp.hs+20−6

@@ -131,11 +131,22 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

131131 block'

132132 return (CppComment com fn')

133133

134− declToCpp _ ident (Constructor _ _ (ProperName _) fields) = return $

135− CppFunction (identToCpp ident) (farg <$> f)

136− (Just $ CppAny [])

137− []

138− (CppBlock (fieldLambdas fs))

134+ declToCpp _ ident (Constructor _ _ (ProperName _) []) = return $

135+ CppFunction (identToCpp ident)

136+ [] (Just $ CppAny [])

137+ [CppInline]

138+ (CppBlock [CppReturn (CppArrayLiteral [CppStringLiteral (identToCpp ident)])])

139+

140+ declToCpp _ ident (Constructor _ _ (ProperName _) fields) = return . CppNamespace [] $

141+ [ CppFunction ('$' : identToCpp ident) (farg <$> fields')

142+ (Just $ CppAny [])

143+ [CppInline]

144+ (CppBlock fullyConstructed)

145+ , CppFunction (identToCpp ident) (farg <$> f)

146+ (Just $ CppAny [])

147+ []

148+ (CppBlock (fieldLambdas fs))

149+ ]

139150 where

140151 name = identToCpp ident

141152 fields' = identToCpp <$> fields

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

147158 CppLambda [CppCaptureAll] (farg <$> [f'])

148159 (Just $ CppAny [])

149160 (CppBlock $ fieldLambdas fs')]

150− | otherwise = [CppReturn (CppArrayLiteral (CppStringLiteral name : (CppVar <$> fields')))]

161+ | otherwise = fullyConstructed

162+ fullyConstructed = [CppReturn (CppArrayLiteral (CppStringLiteral name : (CppVar <$> fields')))]

151163

152164 declToCpp _ ident val = do

153165 val' <- valueToCpp val

@@ -290,6 +302,8 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

290302 args' <- mapM valueToCpp args

291303 case f of

292304 Var (_, _, _, Just IsNewtype) _ -> return (head args')

305+ Var (_, _, _, Just (IsConstructor _ fields)) (Qualified qual (Ident name)) | length args == length fields ->

306+ return $ CppApp (qualifiedToCpp id . Qualified qual . Ident $ '$' : name) args'

293307 Var (_, _, _, Just IsTypeClassConstructor) (Qualified mn' (Ident classname)) ->

294308 let Just (_, constraints, fns) = findClass (Qualified mn' (ProperName classname)) in

295309 return . CppObjectLiteral $ zip ((sort $ superClassDictionaryNames constraints) ++ (fst <$> fns)) args'

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

@@ -50,7 +50,7 @@ identCharToString :: Char -> String

5050identCharToString c | isAlphaNum c = [c]

5151identCharToString '_' = "_"

5252identCharToString '.' = "_dot_"

53−identCharToString '$' = "_dollar_"

53+identCharToString '$' = "$"

5454identCharToString '~' = "_tilde_"

5555identCharToString '=' = "_eq_"

5656identCharToString '<' = "_less_"

src/Language/PureScript/CodeGen/Cpp/File.hs+6

@@ -34,6 +34,8 @@ toHeader = catMaybes . map go

3434 go :: Cpp -> Maybe Cpp

3535 go (CppNamespace name cpps) = Just (CppNamespace name (toHeader cpps))

3636 go cpp@(CppUseNamespace{}) = Just cpp

37+ go (CppFunction name args rtyp qs body)

38+ | CppInline `elem` qs = Just CppNoOp

3739 go (CppFunction _ [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp _ [_])])) | atyp == Just CppAuto

3840 = Just CppNoOp

3941 go (CppFunction name args rtyp qs _) =

@@ -60,6 +62,8 @@ toHeaderFns = catMaybes . map go

6062 where

6163 go :: Cpp -> Maybe Cpp

6264 go (CppNamespace name cpps) = Just (CppNamespace name (toHeaderFns cpps))

65+ go cpp@(CppFunction _ _ _ qs _)

66+ | CppInline `elem` qs = Just cpp

6367 go (CppFunction name [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp cpp [_])]))

6468 | atyp == Just CppAuto

6569 = Just (CppVariableIntroduction (name, Nothing) [] (Just cpp))

@@ -103,6 +107,8 @@ toBody = catMaybes . map go

103107 isNoOp (CppRaw _) = True

104108 isNoOp _ = False

105109 go cpp@(CppUseNamespace{}) = Just cpp

110+ go (CppFunction name args rtyp qs body)

111+ | CppInline `elem` qs = Just CppNoOp

106112 go cpp@(CppFunction {}) = Just cpp

107113 go (CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =

108114 Nothing

src/Language/PureScript/Pretty/Cpp.hs+4

@@ -137,6 +137,10 @@ literals = mkPattern' match

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

138138 mkCases _ = error ""

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

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

141+ [ return "\n"

142+ , prettyStatements sts

143+ ]

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

141145 [ return "\n"

142146 , currentIndent