22
33-- Standard library imports --
44local assert = assert
5+ local concat = table.concat
56local collectgarbage = collectgarbage
67local error = error
78local pairs = pairs
89local pcall = pcall
910local rawequal = rawequal
1011local remove = table.remove
1112
12- -- Modules --
13- local af = require (" arrayfire" )
14-
15- -- Forward declarations --
16- local IsArray
17-
1813-- Cookies --
1914local _command = {}
2015
@@ -30,62 +25,88 @@ local Stack = {}
3025-- --
3126local Top = 0
3227
28+ --
29+ local function Remove (lists , elem )
30+ for elem_type , list in pairs (lists ) do
31+ if list [elem ] then
32+ list [elem ] = nil
33+
34+ return elem_type
35+ end
36+ end
37+ end
38+
39+ -- --
40+ local Types = {}
41+
3342--
3443local function NewEnv ()
35- local id , list , mode , step = ID , {}
44+ local id , lists , mode , step = ID , {}
3645
3746 ID = ID + 1
3847
48+ for elem_type in pairs (Types ) do
49+ lists [elem_type ] = {}
50+ end
51+
3952 return function (a , b , c )
4053 if rawequal (a , _command ) then -- a: _command, b: what, c: arg
4154 if b == " set_mode" then
4255 mode = c
4356 elseif b == " get_id" then
4457 return id
45- elseif b == " get_list " then
46- return list
58+ elseif b == " get_lists " then
59+ return lists
4760 elseif b == " set_step" then
4861 step = c
4962 end
5063 elseif a == " get_step" then -- a: "get_step"
5164 return step
52- elseif IsArray ( a ) then -- a: array ?
65+ else -- a: element ?
5366 local env = Stack [Top ]
5467
5568 assert (env and env (_command , " get_id" ) == id , " Environment not active" ) -- is self?
5669
57- local lower_env = (mode == " parent" or mode == " parent_gc" ) and Stack [Top - 1 ]
58- -- TODO: pingpong, pingpong_gc
59- if lower_env then
60- lower_env (_command , " get_list" )[a ] = true
61- end
70+ local elem_type = Remove (lists , a )
6271
63- list [a ] = nil
72+ if elem_type then
73+ local lower_env = (mode == " parent" or mode == " parent_gc" ) and Stack [Top - 1 ]
74+ -- TODO: pingpong, pingpong_gc
75+ if lower_env then
76+ lower_env (_command , " get_lists" )[elem_type ][a ] = true
77+ end
6478
65- return a
79+ return a
80+ end
6681 end
6782 end
6883end
6984
7085--
71- local function Purge (list )
72- local nerrs = 0
86+ local function Purge (lists )
87+ local errs
7388
74- for arr in pairs (list ) do
75- local ha = arr : get ( true )
89+ for elem_type , type_info in pairs (Types ) do
90+ local elem_list , cleanup , nerrs = lists [ elem_type ], type_info . cleanup , 0
7691
77- if ha then
78- local err = af .af_release_array (ha )
79-
80- if err ~= af .AF_SUCCESS then
92+ --
93+ for elem in pairs (elem_list ) do
94+ if not cleanup (elem ) then
8195 nerrs = nerrs + 1
8296 end
97+
98+ elem_list [elem ] = nil
8399 end
84100
85- list [arr ] = nil
101+ --
102+ if nerrs > 0 then
103+ errs = errs or {}
104+
105+ errs [# errs + 1 ] = type_info .message :format (nerrs )
106+ end
86107 end
87108
88- return nerrs
109+ return errs and concat ( errs , " \n " )
89110end
90111
91112-- --
@@ -97,7 +118,7 @@ local function GetResults (env, ok, a, ...)
97118
98119 env (_command , " set_mode" , nil )
99120
100- local nerrs = Purge (env (_command , " get_list " ))
121+ local errs = Purge (env (_command , " get_lists " ))
101122-- Pingpong or normal? (How to end?)
102123 Cache [# Cache + 1 ] = env
103124 Top , Stack [Top ] = Top - 1
@@ -106,25 +127,22 @@ local function GetResults (env, ok, a, ...)
106127 collectgarbage ()
107128 end
108129-- TODO: pingpong_gc
109- if ok and nerrs == 0 then
130+ if ok and not errs then
110131 return a , ...
111132 else
112133-- Clean up if pingpong
113- error (not ok and a or ( " Errors releasing %i arrays " ): format ( nerrs ) )
134+ error (not ok and a or errs )
114135 end
115136end
116137
117138--
118139function M .Add (array_module )
119- -- Import these here since the array module is not yet registered.
120- IsArray = array_module .IsArray
121-
122140 --
123- function array_module .AddToCurrentEnvironment (arr )
141+ function array_module .AddToCurrentEnvironment (elem_type , arr )
124142 local env = Top > 0 and Stack [Top ]
125143
126144 if env then
127- env (_command , " get_list " ) [arr ] = true
145+ env (_command , " get_lists " )[ elem_type ] [arr ] = true
128146 end
129147 end
130148-- AddOneEnv
@@ -154,6 +172,13 @@ function M.Add (array_module)
154172
155173 return GetResults (env , pcall (func , env , ... ))
156174 end
175+
176+ --
177+ function array_module .RegisterEnvironmentCleanup (elem_type , cleanup , message )
178+ assert (Top == 0 and # Cache == 0 , " Attempt to register new environment type after launch" )
179+
180+ Types [elem_type ] = { cleanup = cleanup , message = message }
181+ end
157182end
158183
159184-- Export the module.
0 commit comments