git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
C++: optimize arity 2-3 closures for use in typeclass instances
commit437bcfce5c5b95f6ea3581fc9b44fe17e6a4cb21 authorAndy Arvanitis <andyarvanitis@gmail.com> dateSat 27 Feb 2016, 14:30 (11 years ago) parentf93d365
5 files changed+129−25
pcc/include/purescript.cc+18 pcc/include/purescript.hh+63 src/Language/PureScript/CodeGen/Cpp.hs+34−6 src/Language/PureScript/CodeGen/Cpp/File.hs+12−19 src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+2
pcc/include/purescript.cc+18
@@ -172,6 +172,24 @@ auto any::operator()(const any& arg) const -> any {
172172 return (*variant.f)(arg);
173173}
174174
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+
175193auto any::operator()(const as_thunk) const -> const any& {
176194 assert(type == Type::Thunk);
177195 return (*t)(unthunk);
pcc/include/purescript.hh+63
@@ -101,6 +101,8 @@ class any {
101101 class closure {
102102 public:
103103 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;
104106 };
105107
106108 template <typename T>
@@ -111,6 +113,52 @@ class any {
111113 auto operator()(const any& arg) const -> any {
112114 return lambda(arg);
113115 }
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+ }
114162 };
115163
116164 class eff_fn {
@@ -194,6 +242,19 @@ class any {
194242 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any(const any&)>,T>::value>::type* = 0)
195243 : type(Type::Closure), l(make_shared<_closure<T>>(val)) {}
196244
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+
197258 template <typename T>
198259 any(const T& val, typename std::enable_if<std::is_assignable<std::function<any()>,T>::value>::type* = 0)
199260 : type(Type::EffFunction), e(make_shared<_eff_fn<T>>(val)) {}
@@ -252,6 +313,8 @@ class any {
252313 }
253314
254315 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;
255318
256319 auto operator()(const as_thunk) const -> const any&;
257320
src/Language/PureScript/CodeGen/Cpp.hs+34−6
@@ -132,14 +132,13 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
132132 nullAnn
133133 (snd abs')
134134 (Var nullAnn . Qualified Nothing . Ident $ head argNames)))
135− let block' = convertNestedLambdas block
136135 return $ CppNamespace ""
137136 [ CppFunction
138137 name
139138 (arg' : args' ++ args'')
140139 rty
141− vqs
142− block'
140+ (vqs ++ if isAccessor (snd abs') then [CppInline] else [])
141+ (convertNestedLambdas block)
143142 , CppFunction
144143 (curriedName name)
145144 [arg']
@@ -152,8 +151,13 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
152151 (CppVar . fst <$> (arg' : args' ++ args''))))
153152 ]
154153 else do
155− block <- asReturnBlock <$> valueToCpp body
156− return $ CppFunction name [arg'] rty vqs (convertNestedLambdas block)
154+ block <- valueToCpp body
155+ return $ CppFunction
156+ name
157+ [arg']
158+ rty
159+ (vqs ++ if isIndexer block then [CppInline] else [])
160+ (convertNestedLambdas $ asReturnBlock block)
157161 return (CppComment com fn)
158162 where
159163 argcnt = maybe 0 countArgs ty
@@ -163,6 +167,12 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
163167 arg' = (identToCpp arg, aty)
164168 args' = (\i -> (identToCpp i, aty)) <$> fst abs'
165169 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
166176
167177 declToCpp _ ident (Constructor _ _ (ProperName _) []) =
168178 return $
@@ -420,7 +430,21 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
420430 return $ CppApp (uncurried' $ qualifiedToCpp id ident) args'
421431 Var (_, _, _, Just IsTypeClassConstructor) (Qualified mn' (Ident classname)) ->
422432 let Just (_, constraints, fns) = findClass (Qualified mn' (ProperName classname)) in
423− return . CppObjectLiteral $ zip ((sort $ superClassDictionaryNames constraints) ++ (fst <$> fns)) args'
433+ return . CppObjectLiteral $
434+ zip
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'
424448 Var ann (Qualified (Just mn') ident)
425449 | argcnt <- maybe 0 countArgs ty,
426450 argcnt > 1 -> do
@@ -438,6 +462,10 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
438462 ty | (_, _, Just t, _) <- ann = Just t
439463 | Just (t, _, _) <- M.lookup (mn', ident) (E.names env) = Just t
440464 | 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'
441469 _ ->
442470 flip (foldl (\fn a -> CppApp fn [a])) args' <$> valueToCpp f
443471
src/Language/PureScript/CodeGen/Cpp/File.hs+12−19
@@ -31,12 +31,14 @@ toHeader :: [Cpp] -> [Cpp]
3131toHeader = catMaybes . map go
3232 where
3333 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
3537 go cpp@(CppUseNamespace{}) = Just cpp
3638 go (CppFunction _ _ _ qs _)
37− | CppInline `elem` qs = Just CppNoOp
39+ | CppInline `elem` qs = Nothing
3840 go (CppFunction _ [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp _ [_])])) | atyp == Just CppAuto
39− = Just CppNoOp
41+ = Nothing
4042 go (CppFunction name args rtyp qs _) =
4143 let args' = (\(_,t) -> ("", t)) <$> args in
4244 Just (CppFunction name args' rtyp qs CppNoOp)
@@ -60,13 +62,14 @@ toHeaderFns :: [Cpp] -> [Cpp]
6062toHeaderFns = catMaybes . map go
6163 where
6264 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
6468 go cpp@(CppFunction _ _ _ qs _)
6569 | CppInline `elem` qs = Just cpp
6670 go (CppFunction name [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp cpp [_])]))
6771 | atyp == Just CppAuto
6872 = Just (CppVariableIntroduction (name, Nothing) [] (Just cpp))
69−
7073 go cpp@(CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =
7174 Just cpp
7275 go cpp@(CppVariableIntroduction _ _ (Just CppStringLiteral {})) =
@@ -92,22 +95,12 @@ toBody :: [Cpp] -> [Cpp]
9295toBody = catMaybes . map go
9396 where
9497 go :: Cpp -> Maybe Cpp
95− go (CppNamespace name cpps) =
96− let cpps' = toBody cpps in
97− if all isNoOp cpps'
98− then 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
98+ go (CppNamespace name cpps)
99+ | cpps'@(_:_) <- toBody cpps = Just (CppNamespace name cpps')
100+ | otherwise = Nothing
108101 go cpp@(CppUseNamespace{}) = Just cpp
109102 go (CppFunction _ _ _ qs _)
110− | CppInline `elem` qs = Just CppNoOp
103+ | CppInline `elem` qs = Nothing
111104 go cpp@(CppFunction {}) = Just cpp
112105 go (CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =
113106 Nothing
src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+2
@@ -195,6 +195,8 @@ inlineCommonOperators = applyAll $
195195 binary dict opString op = everywhereOnCpp convert
196196 where
197197 convert :: Cpp -> Cpp
198+ convert (CppApp fn [dict', CppStringLiteral x, CppStringLiteral y])
199+ | isDict dict dict' && isPreludeFn opString fn = CppStringLiteral (x ++ y)
198200 convert (CppApp fn [dict', x, y]) | isDict dict dict' && isPreludeFn opString fn = CppBinary op x y
199201 convert (CppApp (CppApp (CppApp fn [dict']) [CppStringLiteral x]) [CppStringLiteral y])
200202 | isDict dict dict' && isPreludeFn opString fn = CppStringLiteral (x ++ y)