437bcfc · rowtype-yoga/purescript-native

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

on golang help sign in

C++: optimize arity 2-3 closures for use in typeclass instances

437bcfcAndy Arvanitis11 years ago

pcc/include/purescript.cc+18

compare with golang

unifiedsplit

@@ -172,6 +172,24 @@ auto any::operator()(const any& arg) const -> any {

172 return (*variant.f)(arg);

173}

174

175+auto any::operator()(const any& arg1, const any& arg2) const -> any {

176+ const any& variant = unthunkVariant(*this);

177+ if (variant.type == Type::Closure) {

178+ return (*variant.l)(arg1, arg2);

179+ }

180+ assert(variant.type == Type::Function);

181+ return (*variant.f)(arg1)(arg2);

182+}

183+

184+auto any::operator()(const any& arg1, const any& arg2, const any& arg3) const -> any {

185+ const any& variant = unthunkVariant(*this);

186+ if (variant.type == Type::Closure) {

187+ return (*variant.l)(arg1, arg2, arg3);

188+ }

189+ assert(variant.type == Type::Function);

190+ return (*variant.f)(arg1)(arg2)(arg3);

191+}

192+

175auto any::operator()(const as_thunk) const -> const any& {

193auto any::operator()(const as_thunk) const -> const any& {

176 assert(type == Type::Thunk);

194 assert(type == Type::Thunk);

177 return (*t)(unthunk);

195 return (*t)(unthunk);

pcc/include/purescript.hh+63

@@ -101,6 +101,8 @@ class any {

101 class closure {

102 public:

103 virtual auto operator()(const any&) const -> any = 0;

104+ virtual auto operator()(const any&, const any&) const -> any = 0;

105+ virtual auto operator()(const any&, const any&, const any&) const -> any = 0;

104 };

106 };

105

107

106 template <typename T>

108 template <typename T>

@@ -111,6 +113,52 @@ class any {

111 auto operator()(const any& arg) const -> any {

113 auto operator()(const any& arg) const -> any {

112 return lambda(arg);

114 return lambda(arg);

113 }

115 }

116+ auto operator()(const any& arg1, const any& arg2) const -> any {

117+ return lambda(arg1)(arg2);

118+ }

119+ auto operator()(const any& arg1, const any& arg2, const any& arg3) const -> any {

120+ return lambda(arg1)(arg2)(arg3);

121+ }

122+ };

123+

124+ template <typename T>

125+ class _closure2 : public closure {

126+ const T lambda;

127+ public:

128+ _closure2(const T& l) noexcept : lambda(l) {}

129+ auto operator()(const any& arg1) const -> any {

130+ return [=](const any& arg2) -> any {

131+ return lambda(arg1, arg2);

132+ };

133+ }

134+ auto operator()(const any& arg1, const any& arg2) const -> any {

135+ return lambda(arg1, arg2);

136+ }

137+ auto operator()(const any& arg1, const any& arg2, const any& arg3) const -> any {

138+ return lambda(arg1, arg2)(arg3);

139+ }

140+ };

141+

142+ template <typename T>

143+ class _closure3 : public closure {

144+ const T lambda;

145+ public:

146+ _closure3(const T& l) noexcept : lambda(l) {}

147+ auto operator()(const any& arg1) const -> any {

148+ return [=](const any& arg2) -> any {

149+ return [=](const any& arg3) -> any {

150+ return lambda(arg1, arg2, arg3);

151+ };

152+ };

153+ }

154+ auto operator()(const any& arg1, const any& arg2) const -> any {

155+ return [=](const any& arg3) -> any {

156+ return lambda(arg1, arg2, arg3);

157+ };

158+ }

159+ auto operator()(const any& arg1, const any& arg2, const any& arg3) const -> any {

160+ return lambda(arg1, arg2, arg3);

161+ }

114 };

162 };

115

163

116 class eff_fn {

164 class eff_fn {

@@ -194,6 +242,19 @@ class any {

194 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any(const any&)>,T>::value>::type* = 0)

242 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any(const any&)>,T>::value>::type* = 0)

195 : type(Type::Closure), l(make_shared<_closure<T>>(val)) {}

243 : type(Type::Closure), l(make_shared<_closure<T>>(val)) {}

196

244

245+ template <typename T, typename = typename std::enable_if<!std::is_same<any,T>::value &&

246+ !std::is_convertible<T,fn>::value>::type>

247+ any(const T& val, typename std::enable_if<std::is_assignable<std::function<any(const any&,

248+ const any&)>,T>::value>::type* = 0)

249+ : type(Type::Closure), l(make_shared<_closure2<T>>(val)) {}

250+

251+ template <typename T, typename = typename std::enable_if<!std::is_same<any,T>::value &&

252+ !std::is_convertible<T,fn>::value>::type>

253+ any(const T& val, typename std::enable_if<std::is_assignable<std::function<any(const any&,

254+ const any&,

255+ const any&)>,T>::value>::type* = 0)

256+ : type(Type::Closure), l(make_shared<_closure3<T>>(val)) {}

257+

197 template <typename T>

258 template <typename T>

198 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any()>,T>::value>::type* = 0)

259 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any()>,T>::value>::type* = 0)

199 : type(Type::EffFunction), e(make_shared<_eff_fn<T>>(val)) {}

260 : type(Type::EffFunction), e(make_shared<_eff_fn<T>>(val)) {}

@@ -252,6 +313,8 @@ class any {

252 }

313 }

253

314

254 auto operator()(const any&) const -> any;

315 auto operator()(const any&) const -> any;

316+ auto operator()(const any&, const any&) const -> any;

317+ auto operator()(const any&, const any&, const any&) const -> any;

255

318

256 auto operator()(const as_thunk) const -> const any&;

319 auto operator()(const as_thunk) const -> const any&;

257

320

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

@@ -132,14 +132,13 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

132 nullAnn

133 (snd abs')

134 (Var nullAnn . Qualified Nothing . Ident $ head argNames)))

135− let block' = convertNestedLambdas block

136 return $ CppNamespace ""

135 return $ CppNamespace ""

137 [ CppFunction

136 [ CppFunction

138 name

137 name

139 (arg' : args' ++ args'')

138 (arg' : args' ++ args'')

140 rty

139 rty

141− vqs

140+ (vqs ++ if isAccessor (snd abs') then [CppInline] else [])

142− block'

141+ (convertNestedLambdas block)

143 , CppFunction

142 , CppFunction

144 (curriedName name)

143 (curriedName name)

145 [arg']

144 [arg']

@@ -152,8 +151,13 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

152 (CppVar . fst <$> (arg' : args' ++ args''))))

151 (CppVar . fst <$> (arg' : args' ++ args''))))

153 ]

152 ]

154 else do

153 else do

155− block <- asReturnBlock <$> valueToCpp body

154+ block <- valueToCpp body

155+ return $ CppFunction

156+ name

157+ [arg']

158+ rty

159+ (vqs ++ if isIndexer block then [CppInline] else [])

156− return $ CppFunction name [arg'] rty vqs (convertNestedLambdas block)

160+ (convertNestedLambdas $ asReturnBlock block)

157 return (CppComment com fn)

161 return (CppComment com fn)

158 where

162 where

159 argcnt = maybe 0 countArgs ty

163 argcnt = maybe 0 countArgs ty

@@ -163,6 +167,12 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

163 arg' = (identToCpp arg, aty)

167 arg' = (identToCpp arg, aty)

164 args' = (\i -> (identToCpp i, aty)) <$> fst abs'

168 args' = (\i -> (identToCpp i, aty)) <$> fst abs'

165 abs' = unAbs body []

169 abs' = unAbs body []

170+ isAccessor :: Expr Ann -> Bool

171+ isAccessor Accessor{} = True

172+ isAccessor _ = False

173+ isIndexer :: Cpp -> Bool

174+ isIndexer (CppIndexer (CppStringLiteral _) (CppVar _)) = True

175+ isIndexer _ = False

166

176

167 declToCpp _ ident (Constructor _ _ (ProperName _) []) =

177 declToCpp _ ident (Constructor _ _ (ProperName _) []) =

168 return $

178 return $

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

420 return $ CppApp (uncurried' $ qualifiedToCpp id ident) args'

430 return $ CppApp (uncurried' $ qualifiedToCpp id ident) args'

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

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

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

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

433+ return . CppObjectLiteral $

434+ zip

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

435+ ((sort $ superClassDictionaryNames constraints) ++ (fst <$> fns))

436+ (arity2or3 <$> args')

437+ where

438+ -- For arity 2/3 optimization

439+ arity2or3 :: Cpp -> Cpp

440+ arity2or3 (CppLambda cs [a1] rty

441+ (CppBlock [CppReturn (CppLambda _ [a2] _

442+ (CppBlock [CppReturn (CppLambda _ [a3] _ ret)]))])) =

443+ CppLambda cs [a1, a2, a3] rty ret

444+ arity2or3 (CppLambda cs [a1] rty

445+ (CppBlock [CppReturn (CppLambda _ [a2] _ ret)])) =

446+ CppLambda cs [a1, a2] rty ret

447+ arity2or3 cpp' = cpp'

424 Var ann (Qualified (Just mn') ident)

448 Var ann (Qualified (Just mn') ident)

425 | argcnt <- maybe 0 countArgs ty,

449 | argcnt <- maybe 0 countArgs ty,

426 argcnt > 1 -> do

450 argcnt > 1 -> do

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

438 ty | (_, _, Just t, _) <- ann = Just t

462 ty | (_, _, Just t, _) <- ann = Just t

439 | Just (t, _, _) <- M.lookup (mn', ident) (E.names env) = Just t

463 | Just (t, _, _) <- M.lookup (mn', ident) (E.names env) = Just t

440 | otherwise = Nothing

464 | otherwise = Nothing

465+ Accessor (_, _, Nothing, Nothing) _ (Var _ (Qualified Nothing (Ident _)))

466+ | length args' == 2 || length args' == 3 -> do -- arity 2 optimization

467+ f' <- valueToCpp f

468+ return $ CppApp f' args'

441 _ ->

469 _ ->

442 flip (foldl (\fn a -> CppApp fn [a])) args' <$> valueToCpp f

470 flip (foldl (\fn a -> CppApp fn [a])) args' <$> valueToCpp f

443

471

src/Language/PureScript/CodeGen/Cpp/File.hs+12−19

@@ -31,12 +31,14 @@ toHeader :: [Cpp] -> [Cpp]

31toHeader = catMaybes . map go

32 where

33 go :: Cpp -> Maybe Cpp

34− go (CppNamespace name cpps) = Just (CppNamespace name (toHeader cpps))

34+ go (CppNamespace name cpps)

35+ | cpps'@(_:_) <- toHeader cpps = Just (CppNamespace name cpps')

36+ | otherwise = Nothing

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

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

36 go (CppFunction _ _ _ qs _)

38 go (CppFunction _ _ _ qs _)

37− | CppInline `elem` qs = Just CppNoOp

39+ | CppInline `elem` qs = Nothing

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

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

39− = Just CppNoOp

41+ = Nothing

40 go (CppFunction name args rtyp qs _) =

42 go (CppFunction name args rtyp qs _) =

41 let args' = (\(_,t) -> ("", t)) <$> args in

43 let args' = (\(_,t) -> ("", t)) <$> args in

42 Just (CppFunction name args' rtyp qs CppNoOp)

44 Just (CppFunction name args' rtyp qs CppNoOp)

@@ -60,13 +62,14 @@ toHeaderFns :: [Cpp] -> [Cpp]

60toHeaderFns = catMaybes . map go

62toHeaderFns = catMaybes . map go

61 where

63 where

62 go :: Cpp -> Maybe Cpp

64 go :: Cpp -> Maybe Cpp

63− go (CppNamespace name cpps) = Just (CppNamespace name (toHeaderFns cpps))

65+ go (CppNamespace name cpps)

66+ | cpps'@(_:_) <- toHeaderFns cpps = Just (CppNamespace name cpps')

67+ | otherwise = Nothing

64 go cpp@(CppFunction _ _ _ qs _)

68 go cpp@(CppFunction _ _ _ qs _)

65 | CppInline `elem` qs = Just cpp

69 | CppInline `elem` qs = Just cpp

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

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

67 | atyp == Just CppAuto

71 | atyp == Just CppAuto

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

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

69−

70 go cpp@(CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =

73 go cpp@(CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =

71 Just cpp

74 Just cpp

72 go cpp@(CppVariableIntroduction _ _ (Just CppStringLiteral {})) =

75 go cpp@(CppVariableIntroduction _ _ (Just CppStringLiteral {})) =

@@ -92,22 +95,12 @@ toBody :: [Cpp] -> [Cpp]

92toBody = catMaybes . map go

95toBody = catMaybes . map go

93 where

96 where

94 go :: Cpp -> Maybe Cpp

97 go :: Cpp -> Maybe Cpp

95− go (CppNamespace name cpps) =

98+ go (CppNamespace name cpps)

96− let cpps' = toBody cpps in

99+ | cpps'@(_:_) <- toBody cpps = Just (CppNamespace name cpps')

97− if all isNoOp cpps'

98− then Nothing

100+ | otherwise = Nothing

99− else Just (CppNamespace name cpps')

100− where

101− isNoOp :: Cpp -> Bool

102− isNoOp CppNoOp = True

103− isNoOp (CppComment _ cpp) | isNoOp cpp = True

104− isNoOp (CppUseNamespace{}) = True

105− isNoOp (CppNamespace _ cpps') = all isNoOp cpps'

106− isNoOp (CppRaw _) = True

107− isNoOp _ = False

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

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

109 go (CppFunction _ _ _ qs _)

102 go (CppFunction _ _ _ qs _)

110− | CppInline `elem` qs = Just CppNoOp

103+ | CppInline `elem` qs = Nothing

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

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

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

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

113 Nothing

106 Nothing

src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+2

@@ -195,6 +195,8 @@ inlineCommonOperators = applyAll $

195 binary dict opString op = everywhereOnCpp convert

196 where

197 convert :: Cpp -> Cpp

198+ convert (CppApp fn [dict', CppStringLiteral x, CppStringLiteral y])

199+ | isDict dict dict' && isPreludeFn opString fn = CppStringLiteral (x ++ y)

198 convert (CppApp fn [dict', x, y]) | isDict dict dict' && isPreludeFn opString fn = CppBinary op x y

200 convert (CppApp fn [dict', x, y]) | isDict dict dict' && isPreludeFn opString fn = CppBinary op x y

199 convert (CppApp (CppApp (CppApp fn [dict']) [CppStringLiteral x]) [CppStringLiteral y])

201 convert (CppApp (CppApp (CppApp fn [dict']) [CppStringLiteral x]) [CppStringLiteral y])

200 | isDict dict dict' && isPreludeFn opString fn = CppStringLiteral (x ++ y)

202 | isDict dict dict' && isPreludeFn opString fn = CppStringLiteral (x ++ y)