21477b3 · rowtype-yoga/purescript-native

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

on golang help sign in

Proper recursive let ownership handling (prev impl was temporary)

21477b3Andy Arvanitis8 years ago

runtime/purescript.h+72−29

compare with golang

unifiedsplit

@@ -40,6 +40,7 @@ namespace purescript {

41 boxed() noexcept : std::shared_ptr<void>() {}

42 boxed(const std::nullptr_t) noexcept : std::shared_ptr<void>() {}

43+ boxed(const std::shared_ptr<void>& p) : std::shared_ptr<void>::shared_ptr(p) {}

43 boxed(const int n) : std::shared_ptr<void>(std::make_shared<int>(n)) {}

44 boxed(const int n) : std::shared_ptr<void>(std::make_shared<int>(n)) {}

44 boxed(const long n) : std::shared_ptr<void>(std::make_shared<int>(static_cast<int>(n))) {

45 boxed(const long n) : std::shared_ptr<void>(std::make_shared<int>(static_cast<int>(n))) {

45#if !defined(NDEBUG) // if debug build

46#if !defined(NDEBUG) // if debug build

@@ -115,6 +116,23 @@ namespace purescript {

115 }

116 }

116#endif // !defined(NDEBUG)

117#endif // !defined(NDEBUG)

117

118

119+ class weak {

120+ std::weak_ptr<void> ptr;

121+

122+ public:

123+ weak() = delete;

124+ weak(boxed& b) : ptr(b) {}

125+

126+ operator boxed() const {

127+#if defined(NDEBUG)

128+ return ptr.lock();

129+#else

130+ return static_cast<std::shared_ptr<void>>(ptr);

131+#endif

132+ }

133+

134+ }; // class weak

135+

118 }; // class boxed

136 }; // class boxed

119

137

120 using fn_t = boxed::fn_t;

138 using fn_t = boxed::fn_t;

@@ -122,35 +140,6 @@ namespace purescript {

122 using dict_t = boxed::dict_t;

140 using dict_t = boxed::dict_t;

123 using array_t = boxed::array_t;

141 using array_t = boxed::array_t;

124

142

125− class boxed_r : private std::shared_ptr<void> {

126− public:

127− boxed_r() : std::shared_ptr<void>(std::make_shared<boxed>()) {}

128−

129− operator const boxed&() const {

130− return *static_cast<const boxed*>(get());

131− }

132−

133− auto operator()(const boxed& arg) const -> boxed {

134− auto& b = *static_cast<boxed*>(get());

135− auto& f = *static_cast<fn_t*>(b.get());

136− return f(arg);

137− }

138−

139− auto operator()() const -> boxed {

140− auto& b = *static_cast<boxed*>(get());

141− auto& f = *static_cast<eff_fn_t*>(b.get());

142− return f();

143− }

144−

145− template <typename T>

146− auto operator=(T&& right) -> boxed_r& {

147− auto& b = *static_cast<boxed*>(get());

148− b = std::forward<T>(right);

149− return *this;

150− }

151−

152− }; // class boxed_r

153−

154 template <typename T, typename... Args>

143 template <typename T, typename... Args>

155 inline auto box(Args&&... args) -> boxed {

144 inline auto box(Args&&... args) -> boxed {

156 return std::make_shared<T>(std::forward<Args>(args)...);

145 return std::make_shared<T>(std::forward<Args>(args)...);

@@ -177,6 +166,60 @@ namespace purescript {

177 return value;

166 return value;

178 }

167 }

179

168

169+ class boxed_r {

170+ friend class boxed_weak_r;

171+ std::shared_ptr<boxed> ptr;

172+ std::shared_ptr<boxed::weak> wptr;

173+

174+ public:

175+ boxed_r() : ptr(std::make_shared<boxed>())

176+ , wptr(std::make_shared<boxed::weak>(*ptr)) {}

177+

178+ operator const boxed&() const {

179+ return *ptr;

180+ }

181+

182+ operator boxed&() {

183+ return *ptr;

184+ }

185+

186+ auto operator()() const -> boxed {

187+ return (*ptr)();

188+ }

189+

190+ auto operator()(const boxed& arg) const -> boxed {

191+ return (*ptr)(arg);

192+ }

193+

194+ template <typename T>

195+ auto operator=(T&& right) -> boxed_r& {

196+ *ptr = std::forward<T>(right);

197+ *wptr = *ptr;

198+ return *this;

199+ }

200+

201+ }; // class boxed_r

202+

203+ class boxed_weak_r {

204+ std::shared_ptr<boxed::weak> wptr;

205+

206+ public:

207+ boxed_weak_r(const boxed_r& r) : wptr(r.wptr) {}

208+

209+ operator boxed() const {

210+ return *wptr;

211+ }

212+

213+ auto operator()() const -> boxed {

214+ return static_cast<boxed>(*wptr)();

215+ }

216+

217+ auto operator()(const boxed& arg) const -> boxed {

218+ return static_cast<boxed>(*wptr)(arg);

219+ }

220+

221+ }; // class boxed_weak_r

222+

180 inline auto array_length(const boxed& a) -> boxed::array_t::size_type {

223 inline auto array_length(const boxed& a) -> boxed::array_t::size_type {

181 return unbox<boxed::array_t>(a).size();

224 return unbox<boxed::array_t>(a).size();

182 }

225 }

src/CodeGen/Cpp.hs+35−10

@@ -13,7 +13,7 @@ import Control.Arrow ((&&&))

13import Control.Monad (forM, liftM, replicateM, void)

14import Control.Monad.Supply.Class

16−import Data.List ((\\), delete, intersect)

16+import Data.List ((\\), delete, intersect, nub)

17import qualified Data.Foldable as F

18import qualified Data.Map as M

19import Data.Maybe (fromMaybe, isNothing, mapMaybe)

@@ -157,20 +157,35 @@ moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

157 pure $

158 let retainedName = identToCpp ident

159 retained = AST.Var Nothing $ retainedName

160− -- unretained = AST.Var Nothing $ retainedName <> unretainedSuffix

160+ unretainedName = retainedName <> unretainedSuffix

161+ unretained = AST.Var Nothing $ unretainedName

161− -- alias = AST.Var Nothing . -- Note: prevents optimizer from eliminating this

162+ boxed = AST.Var Nothing . -- Note: prevents optimizer from eliminating this

162− -- prettyPrintCpp1 $

163+ prettyPrintCpp1 $

163− -- AST.VariableIntroduction Nothing retainedName (Just unretained)

164+ AST.VariableIntroduction

165+ Nothing

166+ retainedName

167+ (Just unretained)

168+ alias = AST.Var Nothing $ "auto& " <> retainedName <> " = " <> unretainedName

164 in

169 in

165 case cpp of

170 case cpp of

166 AST.Function _ name args (AST.Block Nothing cpps) ->

171 AST.Function _ name args (AST.Block Nothing cpps) ->

167 AST.Assignment Nothing

172 AST.Assignment Nothing

168− (retained)

173+ retained

169 (AST.Function Nothing

174 (AST.Function Nothing

170 name

175 name

171 args

176 args

172− (AST.Block Nothing cpps))

177+ (AST.Block Nothing (boxed : cpps)))

178+ _ ->

173− _ -> AST.Assignment Nothing retained cpp

179+ AST.Assignment Nothing

180+ retained

181+ (AST.App Nothing

182+ (AST.Function Nothing

183+ Nothing

184+ []

185+ (AST.Block Nothing ([ alias

186+ , AST.Return Nothing cpp

187+ ])))

188+ [])

174 nonRecToCpp _ (ss, _, _, _) ident val = do

189 nonRecToCpp _ (ss, _, _, _) ident val = do

175 cpp <- valueToCpp val

190 cpp <- valueToCpp val

176 pure $ AST.VariableIntroduction Nothing (identToCpp ident) (Just cpp)

191 pure $ AST.VariableIntroduction Nothing (identToCpp ident) (Just cpp)

@@ -241,6 +256,13 @@ moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

241 valueToCpp (Let _ ds val) = do

256 valueToCpp (Let _ ds val) = do

242 let recurs = concatMap getNames $ filter isRec ds

257 let recurs = concatMap getNames $ filter isRec ds

243 recurDs = (\v -> AST.Var Nothing $ "boxed_r " <> identToCpp v) <$> recurs

258 recurDs = (\v -> AST.Var Nothing $ "boxed_r " <> identToCpp v) <$> recurs

259+ recurDsWeak = (\v -> AST.Var

260+ Nothing

261+ ("boxed_weak_r " <> identToCpp v <> unretainedSuffix <> "(" <> identToCpp v <> ")")

262+ ) <$> recurs

263+ mutualRecurWarning = if any isMutRec $ filter isRec ds

264+ then [AST.Var Nothing "#pragma message(\"Mutually recursive lets will cause retain cycles (memory leaks)\") //"]

265+ else []

244 ds' <- concat <$> mapM (bindToCpp LetDecl) ds

266 ds' <- concat <$> mapM (bindToCpp LetDecl) ds

245 ret <- valueToCpp val

267 ret <- valueToCpp val

246 return $

268 return $

@@ -248,12 +270,15 @@ moduleToCpp (Module _ coms mn _ imps _ foreigns decls) _ =

248 (AST.Function Nothing

270 (AST.Function Nothing

249 Nothing

271 Nothing

250 []

272 []

251− (AST.Block Nothing (recurDs ++ ds' ++ [AST.Return Nothing ret])))

273+ (AST.Block Nothing (recurDs ++ recurDsWeak ++ mutualRecurWarning ++ ds' ++ [AST.Return Nothing ret])))

252 []

274 []

253 where

275 where

254 isRec :: Bind Ann -> Bool

276 isRec :: Bind Ann -> Bool

255 isRec (Rec _) = True

277 isRec (Rec _) = True

256− isRec _ = False

278+ isRec _ = False

279+ isMutRec :: Bind Ann -> Bool

280+ isMutRec b | (length . nub $ getNames b) > 1 = True

281+ | otherwise = False

257 valueToCpp (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) = error "IsNewtype"

282 valueToCpp (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) = error "IsNewtype"

258 valueToCpp (Constructor _ _ (ProperName ctor) fields) =

283 valueToCpp (Constructor _ _ (ProperName ctor) fields) =

259 let body = AST.ObjectLiteral Nothing $ (mkString ctor, AST.BooleanLiteral Nothing True) :

284 let body = AST.ObjectLiteral Nothing $ (mkString ctor, AST.BooleanLiteral Nothing True) :

src/CodeGen/Cpp/Common.hs+3

@@ -216,5 +216,8 @@ unbox t = "unbox<" <> t <> ">"

216arrayLengthFn :: Text

217arrayLengthFn = "array_length"

218

219+unretainedSuffix :: Text

220+unretainedSuffix = "$weak"

221+

219tcoLoop :: Text

222tcoLoop :: Text

220tcoLoop = "$TCO_loop$"

223tcoLoop = "$TCO_loop$"