6bb47ae · rowtype-yoga/purescript-native

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

on golang help sign in

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

6bb47aeAndy Arvanitis11 years ago

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

compare with golang

unifiedsplit

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

131 block'

132 return (CppComment com fn')

133

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

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)

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

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

136− (Just $ CppAny [])

146+ (Just $ CppAny [])

137− []

147+ []

138− (CppBlock (fieldLambdas fs))

148+ (CppBlock (fieldLambdas fs))

149+ ]

139 where

150 where

140 name = identToCpp ident

151 name = identToCpp ident

141 fields' = identToCpp <$> fields

152 fields' = identToCpp <$> fields

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

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

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

148 (Just $ CppAny [])

159 (Just $ CppAny [])

149 (CppBlock $ fieldLambdas fs')]

160 (CppBlock $ fieldLambdas fs')]

161+ | otherwise = fullyConstructed

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

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

151

163

152 declToCpp _ ident val = do

164 declToCpp _ ident val = do

153 val' <- valueToCpp val

165 val' <- valueToCpp val

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

290 args' <- mapM valueToCpp args

302 args' <- mapM valueToCpp args

291 case f of

303 case f of

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

304 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'

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

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

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

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

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

309 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

50identCharToString c | isAlphaNum c = [c]

51identCharToString '_' = "_"

52identCharToString '.' = "_dot_"

53−identCharToString '$' = "_dollar_"

53+identCharToString '$' = "$"

54identCharToString '~' = "_tilde_"

55identCharToString '=' = "_eq_"

56identCharToString '<' = "_less_"

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

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

34 go :: Cpp -> Maybe Cpp

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

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

37+ go (CppFunction name args rtyp qs body)

38+ | CppInline `elem` qs = Just CppNoOp

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

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

38 = Just CppNoOp

40 = Just CppNoOp

39 go (CppFunction name args rtyp qs _) =

41 go (CppFunction name args rtyp qs _) =

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

60 where

62 where

61 go :: Cpp -> Maybe Cpp

63 go :: Cpp -> Maybe Cpp

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

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

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

66+ | CppInline `elem` qs = Just cpp

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

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

64 | atyp == Just CppAuto

68 | atyp == Just CppAuto

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

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

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

103 isNoOp (CppRaw _) = True

107 isNoOp (CppRaw _) = True

104 isNoOp _ = False

108 isNoOp _ = False

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

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

110+ go (CppFunction name args rtyp qs body)

111+ | CppInline `elem` qs = Just CppNoOp

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

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

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

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

108 Nothing

114 Nothing

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

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

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

138 mkCases _ = error ""

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

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

141+ [ return "\n"

142+ , prettyStatements sts

143+ ]

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

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

141 [ return "\n"

145 [ return "\n"

142 , currentIndent

146 , currentIndent