/pliant/storage/database/pointer.pli
1	abstract
2	[This module will define the 'Data' and 'Database' generic data types that the application will use in order to access a database, and that will completely hide the undertlying implementation.]
3
4	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
5	#
6	# This program is free software; you can redistribute it and/or
7	# modify it under the terms of the GNU General Public License version 2
8	# as published by the Free Software Foundation.
9	#
10	# This program is distributed in the hope that it will be useful,
11	# but WITHOUT ANY WARRANTY; without even the implied warranty of
12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13	# GNU General Public License for more details.
14	#
15	# You should have received a copy of the GNU General Public License
16	# version 2 along with this program; if not, write to the Free Software
17	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
18
19	scope "/pliant/storage/" "/pliant/appli/"
20	module "/pliant/language/compiler.pli"
21	module "/pliant/language/data/string_cast.pli"
22	module "/pliant/util/encoding/html.pli"
23	module "set.pli"
24	module "prototype.pli"
25	module "inmemory.pli"
26	module "io.pli"
27	module "file.pli"
28	module "mount.pli"
29	module "interface.pli"
30
31
32
33
34	doc
35	['Data' is very much like 'Pointer', but it's dedicated to pointing objects in the database and ensure nice properties such as automatic locking, so you can use them safely in a multithreaded environment (the HTTP server), and not crashing if accessing a non existing data.] ; eol
36	[It will map objects implemented in ] ; link "inmemory.pli" "inmemory.pli"
37
38
39	gvar Relation 'pliant data types'
40	export 'pliant data types'
41
42	function Data t -> tt
43	arg Type t ; arg_R Type tt
44	has_no_side_effect
45
46	var Address adr := 'pliant data types' query addressof:t null
47	if adr<>null
48	return (adr map Type)
49
50	runtime_compile  Value t  Data (cast "(Data "+t:name+")" Ident)  getdata (cast "cast "+t:name Ident)  is_field (cast (shunt data_kind:t=data_field "true" "false") Ident)  default (cast "default "+t:name Ident)
51
52	type Data
53	field Data_ data
54
55	if is_field
56
57	from_string addressof:(gvar Value default) Value "" "db"
58
59	function getdata d -> v
60	arg Data d ; arg Value v
61	implicit
62	if (d:data:interface get d:data addressof:v Value)=failure
63	v := default
64
65	export Data '. data'
66	if is_field
67	export getdata
68	'pliant data types' define addressof:Value null addressof:Data
69	'pliant data types' define null addressof:Data addressof:Value
70	(addressof:'pliant star types' map Relation) define addressof:Data null addressof:Value
71
72	var Address adr := 'pliant data types' query addressof:t null
73	check adr<>null
74	return (adr map Type)
75
76	export Data
77	alias Anything Anything from "/pliant/storage/database/inmemory.pli"
78	export Anything
79
80
81
82
83	doc
84	['Database' is the generic data type that will store in memory all the data of a database, enable to load or store them to the disk using a single command, and update the log so that in case of an application crash, no data will be lost.] ; eol
85	[A 'Database' object is the visible part (the one the application uses) or an underlying '] ; link "DatabaseFile" "file.pli" ; [' object.]
86
87
88	gvar Relation 'pliant database types'
89	export 'pliant database types'
90
91	function Database t -> tt
92	arg Type t ; arg_R Type tt
93	has_no_side_effect
94
95	var Address adr := 'pliant database types' query addressof:t null
96	if adr<>null
97	return (adr map Type)
98
99	Data t
100	runtime_compile  Value t  Database (cast "(Database "+t:name+")" Ident)  Data (cast "(Data "+t:name+")" Ident)  casttodata (cast "cast (Data "+t:name+")" Ident)  interface_arrow (cast "interface "+t:name Ident)
101
102	type Database
103	field DatabaseFile file
104	field Value value
105
106	DatabaseFile maybe Database
107
108	constant interface_arrow (cast (addressof data_interface:Value) Arrow)
109	function build db
110	arg_w Database db
111	db:file:root_interface :> interface_arrow omap DataInterface_
112	function destroy db # Must be defined, else (function destroy DatabaseFile) will be inherited, so called twice
113	arg_w Database db
114
115	method db data -> d
116	oarg Database db ; arg Data d
117	(addressof:db omap Database_) get_root (addressof:d map Data_)
118	((the_function '. data' Database -> Data) arg 1) access += access_result_consistent
119
120	export '. data'
121	'pliant database types' define addressof:Value null addressof:Database
122	'pliant database types' define null addressof:Database addressof:Value
123
124	var Address adr := 'pliant database types' query addressof:t null
125	check adr<>null
126	return (adr map Type)
127
128
129	method a is_data -> c
130	arg Type a ; arg CBool c
131	has_no_side_effect
132	c := ('pliant data types' query null addressof:a)<>null
133
134	method e is_data -> c
135	arg_rw Expression e ; arg CBool c
136	c := false
137	e compile ?
138	e uncast
139	var Link:Type t :> e:result type
140	while not t:is_data
141	if not t:is_pointer
142	return
143	t :> unpointerto t
144	if not (e cast t)
145	return
146	c := true
147
148
149	meta '. load' e
150	if e:size<2 or not (e:0 cast DatabaseFile) or not (e:1 cast Str)
151	return
152	var Link:Argument log :> e:1:result
153	var Link:Argument mount :> argument constant Str ""
154	var Int i := 2
155	while i<e:size
156	if e:i:ident="log" and i+1<e:size and (e:(i+1) cast Str)
157	e suckup e:(i+1)
158	log :> e:(i+1):result
159	i += 2
160	eif e:i:ident="mount" and i+1<e:size and (e:(i+1) cast Str)
161	e suckup e:(i+1)
162	mount :> e:(i+1):result
163	i += 2
164	eif e:i:ident="nolog"
165	log :> argument constant Str ""
166	i += 1
167	else
168	return
169	e suckup e:0 ; e suckup e:1
170	e add (instruction (the_function '. setup' DatabaseFile Str Str Str) e:0:result e:1:result log mount)
171	e set_void_result
172
173	meta '. store' e
174	if e:size=1 and (e:0 cast DatabaseFile)
175	var Link:Argument s :> argument local Status
176	e suckup e:0
177	e add (instruction (the_function '. store' DatabaseFile -> Status) e:0:result s)
178	e set_result s access_read
179
180	meta '. query' e
181	if e:size=2 and (e:0 cast DatabaseFile) and (e:1 cast Str)
182	var Link:Argument a :> argument local Str
183	e suckup e:0 ; e suckup e:1
184	e add (instruction (the_function '. query' Database_ Str -> Str) e:0:result e:1:result a)
185	e set_result a access_read
186
187	meta '. configure' e
188	if e:size=2 and (e:0 cast DatabaseFile) and (e:1 cast Str)
189	var Link:Argument s :> argument local Status
190	e suckup e:0 ; e suckup e:1
191	e add (instruction (the_function '. configure' Database_ Str -> Status) e:0:result e:1:result s)
192	e set_result s access_read
193
194
195	export Database
196	export '. is_data'
197	export '. load' '. store' '. query' '. configure'
198
199	alias data_store data_store from "/pliant/storage/database/file.pli"
200	alias data_file_switch data_file_switch from "/pliant/storage/database/file.pli"
201	export data_store data_file_switch
202
203
204
205
206
207	doc
208	[Sets a Data pointer.]
209
210	meta ':>' e
211	if e:size<>2
212	return
213	if not e:0:is_data or (e:0:access .and. access_write)=0
214	return
215	var Pointer:Type t :> unpointerto e:0:result:type
216	e:1 compile ?
217	if addressof:(e:1 cast e:1:result e:1:access Data:t function_flag_implicit .or. function_flag_extension .or. function_flag_reduction)=null
218	return
219	e suckup e:1
220	e suckup e:0
221	e add (instruction (the_function 'copy Universal' Universal Universal Type) e:1:result e:0:result (argument mapped_constant Type Data_))
222	e set_void_result
223
224
225	doc
226	[Set the value of a field.]
227
228	function data_set d v t
229	arg_rw Data_ d ; arg Universal v ; arg Type t
230	d:base:sem request "database set "+d:path
231	d:interface set d addressof:v t
232	d:base:sem release
233
234	meta ':=' e
235	if e:size<>2 or not e:0:is_data or (e:0:access .and. access_write)=0
236	return
237	var Link:Type t :> unpointerto e:0:result:type
238	if data_kind:t<>data_field
239	return
240	e:1 compile ?
241	if addressof:(e:1 cast e:1:result e:1:access t function_flag_implicit .or. function_flag_extension .or. function_flag_reduction)=null
242	return
243	e suckup e:1
244	e suckup e:0
245	e add (instruction (the_function data_set Data_ Universal Type) e:0:result e:1:result (argument mapped_constant Type t))
246	e set_void_result
247
248
249	doc
250	[Get a field in a record.]
251
252	function map_field r def -> f
253	arg_rw Data_ r ; arg DataRecordFieldDef def ; arg Data_ f
254	if (addressof r:interface)=(addressof def:record_interface)
255	def apply r f
256	else
257	r:base:sem rd_request "database map field "+r:path+def:path
258	f := r:interface search r html_decode:(def:path 1 def:path:len) false
259	r:base:sem rd_release
260	if f:adr=null
261	f object := def default
262
263	meta '' e
264	if e:size<>2 or not e:1:is_pure_ident or not e:0:is_data
265	return
266	var Link:Type t :> unpointerto e:0:result:type
267	if entry_type:(addressof data_interface:t)<>DataRecord
268	return
269	var Pointer:DataRecord r :> (addressof data_interface:t) map DataRecord
270	for (var Int i) 0 t:nb_fields-1
271	var Pointer:TypeField f :> t field i
272	if f:name=e:1:ident
273	var Link:Type dt :> Data f:type
274	var Link:Argument a :> argument local dt
275	e suckup e:0
276	var Pointer:DataRecordFieldDef def :> (r:fields first f:name) map DataRecordFieldDef
277	e add (instruction (the_function map_field Data_ DataRecordFieldDef -> Data_) e:0:result (argument mapped_constant DataRecordFieldDef def) a)
278	e set_result a access_read+(e:0:access .and. access_write)
279	return
280
281
282	doc
283	[Get a record in a set.]
284
285	function map_record s key -> r
286	arg_rw Data_ s ; arg Str key ; arg Data_ r
287	s:base:sem rd_request "database map record "+s:path+"/"+html_decode:key
288	r := s:interface search s key false
289	s:base:sem rd_release
290
291	meta '' e
292	if e:size<>2 or not (e:1 cast Str) or not e:0:is_data
293	return
294	var Link:Type t :> unpointerto e:0:result:type
295	if data_kind:t<>data_set
296	return
297	var Link:Argument a :> argument local (Data t:value_type)
298	e suckup e:0 ; e suckup e:1
299	e add (instruction (the_function map_record Data_ Str -> Data_) e:0:result e:1:result a)
300	e set_result a access_read+(e:0:access .and. access_write)
301
302
303	doc
304	[Get the number of records in a set.]
305
306	function data_size s -> n
307	arg_rw Data_ s ; arg Int n
308	s:base:sem rd_request "database get size "+s:path
309	n := s:interface count s "" ""
310	s:base:sem rd_release
311
312	meta '. size' e
313	if e:size<>1 or not e:0:is_data
314	return
315	var Link:Type t :> unpointerto e:0:result:type
316	if data_kind:t<>data_set
317	return
318	var Link:Argument a :> argument local Int
319	e suckup e:0
320	e add (instruction (the_function data_size Data_ -> Int) e:0:result a)
321	e set_result a access_read
322
323
324	doc
325	[Create a record in a set.]
326
327	function data_create s key -> status
328	arg_rw Data_ s ; arg Str key ; arg Status status
329	s:base:sem request "database create "+s:path+"/"+html_encode:key
330	status := s:interface create s key
331	s:base:sem release
332
333	function data_create s key record -> status
334	arg_rw Data_ s ; arg Str key ; arg Type record ; arg Status status
335	s:base:sem request "database create "+s:path+"/"+html_encode:key
336	status := s:interface create s key
337	if status=success
338	var Data_ r := s:interface search s key
339	for (var Int i) 0 record:nb_fields-1
340	r:interface create r (record field i):name
341	s:base:sem release
342
343	meta '. create' e
344	if e:size<>2 or not (e:1 cast Str) or not e:0:is_data
345	return
346	var Link:Type t :> unpointerto e:0:result:type
347	if data_kind:t<>data_set
348	return
349	var Link:Type v :> t value_type
350	var Link:Argument a :> argument local Status
351	e suckup e:0 ; e suckup e:1
352	if exists:v and data_kind:v=data_record
353	e add (instruction (the_function data_create Data_ Str Type -> Status) e:0:result e:1:result (argument mapped_constant Type v) a)
354	else
355	e add (instruction (the_function data_create Data_ Str -> Status) e:0:result e:1:result a)
356	e set_result a access_read
357
358
359	doc
360	[Delete a record in a set.]
361
362	function data_delete s key -> status
363	arg_rw Data_ s ; arg Str key ; arg Status status
364	s:base:sem request "database delete "+s:path+"/"+html_encode:key
365	status := s:interface delete s key
366	s:base:sem release
367
368	meta '. delete' e
369	if e:size<>2 or not (e:1 cast Str) or not e:0:is_data
370	return
371	var Link:Type t :> unpointerto e:0:result:type
372	if data_kind:t<>data_set
373	return
374	var Link:Argument a :> argument local Status
375	e suckup e:0 ; e suckup e:1
376	e add (instruction (the_function data_delete Data_ Str -> Status) e:0:result e:1:result a)
377	e set_result a access_read
378
379
380
381
382
383	doc
384	[Test if we are pointing to a data that already exists.]
385
386	function data_exists d -> c
387	arg_rw Data_ d ; arg CBool c
388	c := d:adr<>null
389
390	meta exists e
391	if e:size<>1 or not e:0:is_data
392	return
393	var Link:Type t :> unpointerto e:0:result:type
394	var Link:Argument a :> argument local CBool
395	e suckup e:0
396	e add (instruction (the_function data_exists Data_ -> CBool) e:0:result a)
397	e set_result a access_read
398
399
400	doc
401	[Get the key of the data. The key is the last level in the data path.]
402
403	meta keyof e
404	if e:size<>1 or not e:0:is_data
405	return
406	var Link:Type t :> unpointerto e:0:result:type
407	var Link:Argument a :> argument local Str
408	e suckup e:0
409	e add (instruction (the_function '. key' Data_ -> Str) e:0:result a)
410	e set_result a access_read
411
412
413	doc
414	[Get the all path to the data.]
415
416	meta pathof e
417	if e:size<>1 or not e:0:is_data
418	return
419	var Link:Type t :> unpointerto e:0:result:type
420	var Link:Argument a :> argument local Str
421	e suckup e:0
422	e add (instruction (the_function '. path' Data_ -> Str) e:0:result a)
423	e set_result a access_read
424
425
426	doc
427	[Get a pointer to a data specifyed using it's path.]
428
429	method d1 search_path path createit -> d2
430	arg Data_ d1 ; arg Str path ; arg CBool createit ; arg Data_ d2
431	var Pointer:Database_ b :> d1 base
432	b:sem rd_request "database search path "+d1:path+" "+path
433	var CBool rw := false
434	d2 := d1
435	var Str p := path
436	while (p parse "/" any:(var Str k) "/" any:(var Str remain))
437	if (addressof d2:base:sem)<>(addressof b:sem)
438	if rw
439	b:sem release
440	else
441	b:sem rd_release
442	b :> d2 base
443	if rw
444	b:sem request "database search path "+d1:path+" "+path
445	else
446	b:sem rd_request "database search path "+d1:path+" "+path
447	var Data_ temp := d2:interface search d2 html_decode:k
448	if temp:adr=null and createit
449	if not rw
450	b:sem rd_release
451	b:sem request "database search path "+d1:path+" "+path
452	rw := true
453	if (d2:interface create d2 html_decode:k)=success
454	temp := d2:interface search d2 html_decode:k
455	d2 := temp ; p := "/"+remain
456	if (p parse "/" any:(var Str k))
457	if (addressof d2:base:sem)<>(addressof b:sem)
458	if rw
459	b:sem release
460	else
461	b:sem rd_release
462	b :> d2 base
463	if rw
464	b:sem request "database search path "+d1:path+" "+path
465	else
466	b:sem rd_request "database search path "+d1:path+" "+path
467	var Data_ temp := d2:interface search d2 html_decode:k
468	if temp:adr=null and createit
469	if not rw
470	b:sem rd_release
471	b:sem request "database search path "+d1:path+" "+path
472	rw := true
473	if (d2:interface create d2 html_decode:k)=success
474	temp := d2:interface search d2 html_decode:k
475	d2 := temp
476	if rw
477	b:sem release
478	else
479	b:sem rd_release
480
481	meta '. pmap' e
482	if e:size=2 and (e:0 cast Str) and (e:1 constant Type)<>null
483	var Pointer:Type t :> (e:1 constant Type) map Type
484	var Link:Argument a :> argument local Data:t
485	e suckup e:0
486	e add (instruction (the_function '. search_path' Data_ Str CBool -> Data_) (argument mapped_constant Data_ data_root) e:0:result (argument constant CBool false) a)
487	e set_result a access_read+access_write
488	eif e:size=3 and e:0:is_data and (e:1 cast Str) and (e:2 constant Type)<>null
489	var Pointer:Type t :> (e:2 constant Type) map Type
490	var Link:Argument a :> argument local Data:t
491	e suckup e:0 ; e suckup e:1
492	e add (instruction (the_function '. search_path' Data_ Str CBool -> Data_) e:0:result e:1:result (argument constant CBool false) a)
493	e set_result a access_read+(e:0:access .and. access_write)
494
495
496	function data_reset d
497	arg_rw Data_ d
498	d:base:sem request "database reset "+d:path
499	d:interface reset d
500	d:base:sem release
501
502	meta data_reset e
503	if e:size<>1 or not e:0:is_data or (e:0:access .and. access_write)=0
504	return
505	e suckup e:0
506	e add (instruction (the_function data_reset Data_) e:0:result)
507	e set_void_result
508
509
510	doc
511	['data_copy' will allow you to copy datas that have completely different type, the mapping beeing performed though matching subpath.]
512
513	function data_rec_copy src dest
514	arg_rw Data_ src dest
515	var Pointer:Type t :> src:interface type src
516	if t<>Void
517	var Arrow a := entry_new t
518	if (src:interface get src a t)=success
519	dest:interface set dest a t
520	var Data_ src2 := src:interface first src "" "" (var DataScanBuffer buf)
521	while src2:adr<>null
522	var Data_ dest2 := dest:interface search dest src2:key true
523	if dest2:adr<>null
524	data_rec_copy src2 dest2
525	src2 := src:interface next src "" "" buf
526
527	function data_copy src dest
528	arg_rw Data_ src dest
529	part copy "database copy "+src:path+" -> "+dest:path
530	dest:base:sem request
531	if (addressof src:base:sem)<>(addressof dest:base:sem)
532	src:base:sem rd_request
533	dest:interface reset dest
534	data_rec_copy src dest
535	if (addressof src:base:sem)<>(addressof dest:base:sem)
536	src:base:sem rd_release
537	dest:base:sem release
538
539	meta data_copy e
540	if e:size<>2 or not e:0:is_data or not e:1:is_data or (e:1:access .and. access_write)=0
541	return
542	e suckup e:0 ; e suckup e:1
543	e add (instruction (the_function data_copy Data_ Data_) e:0:result e:1:result)
544	e set_void_result
545
546
547
548
549
550	doc
551	[And now the big 'each' meta that will allow to scan all the elements of a set, filter them, and sort them.]
552
553	function scan_first d c buf -> some
554	arg Data_ d ; arg_w Data_ c ; arg_w DataScanBuffer buf ; arg CBool some
555	var Pointer:Database_ db :> d base
556	db:sem rd_request "database search first "+d:path
557	c := d:interface first d "" "" buf
558	db:sem rd_release
559	some := c:adr<>null
560
561	function scan_next d c buf -> some
562	arg Data_ d ; arg_w Data_ c ; arg_rw DataScanBuffer buf ; arg CBool some
563	var Pointer:Database_ db :> d base
564	db:sem rd_request "database search next "+d:path
565	c := d:interface next d "" "" buf
566	db:sem rd_release
567	some := c:adr<>null
568
569	function is_null a -> c
570	arg Address a ; arg CBool c
571	c := a=null
572
573	function pick_function id t0 t1 t2 t3 n r m -> f
574	arg Str id ; arg Type t0 t1 t2 t3 ; arg Int n r ; arg Module m ; arg_R Function f
575	for (var Int lap) 0 1
576	var Link:Module module
577	if lap=0
578	module :> m
579	else
580	module :> the_module "/pliant/language/type/set/index.pli"
581	var Pointer:Arrow c :> module first id
582	while c<>null
583	if entry_type:c=Function
584	f :> c map Function
585	if f:nb_args=n and f:nb_args_with_result=r and (not exists:t0 or (f arg 0):type=t0) and (not exists:t1 or (f arg 1):type=t1) and (not exists:t2 or (f arg 2):type=t2) and (not exists:t3 or (f arg 3):type=t3)
586	return
587	c :> module next id c
588	f :> null map Function
589	error error_id_compile "failed to pick function "+id
590
591	meta each e
592	if e:size<3 or not e:0:is_pure_ident
593	return
594	var Pointer:Expression filter :> null map Expression
595	var Pointer:Expression sort :> null map Expression
596	var CBool reversed := false
597	var Int i := 2
598	while i<e:size-1
599	if e:i:ident="filter" and i+1<e:size-1
600	filter :> e i+1
601	i += 2
602	eif e:i:ident="sort" and i+1<e:size-1
603	sort :> e i+1
604	i += 2
605	eif e:i:ident="reversed" and exists:sort
606	reversed := true
607	i += 1
608	else
609	return
610	e:1 compile ?
611	var Pointer:Type set :> e:1:result:type:real_data_type
612	if set:category<>"Set"
613	return
614	var Link:Argument buf :> argument local DataScanBuffer
615	var Link:Argument some :> argument local CBool
616	var Link:Argument item :> e local_variable e:0 (Data set:value_type)
617	if not exists:item
618	return
619	if addressof:filter<>null and not (filter cast CBool)
620	return
621	if addressof:sort<>null
622	sort compile ?
623	var Pointer:Type key :> sort:result:type real_data_type
624	if not (sort cast key)
625	return
626	var Link:Argument idx :> argument local (Index key Data_)
627	var Link:Argument adr :> argument local Address
628	e add (instruction (the_function 'address Universal' Universal -> Address) idx adr)
629	e add (instruction (the_function '. destroy_instance' Type Address) (argument mapped_constant Type (Index key Data_)) adr)
630	e add (instruction (the_function '. build_instance' Type Address) (argument mapped_constant Type (Index key Data_)) adr)
631	(e e:size-1) compile ?
632	e:1 cast Data:set ; e suckup e:1
633	var Link:Instruction next :> instruction the_function:'do nothing'
634	var Link:Instruction end :> instruction the_function:'do nothing'
635	e add (instruction (the_function scan_first Data_ Data_ DataScanBuffer -> CBool) e:1:result item buf some)
636	e add (instruction (the_function 'jump if not' CBool) some jump end)
637	var Link:Instruction body :> instruction the_function:'do nothing'
638	e add body
639	if addressof:filter<>null
640	e suckup filter
641	e add (instruction (the_function 'jump if not' CBool) filter:result jump next)
642	if addressof:sort=null
643	e suckup (e e:size-1)
644	else
645	e suckup sort
646	var Link:Function f :>pick_function ". insert" (Index key Data_) key Data_ Data_ 3 4 e:module ?
647	e add (instruction f idx sort:result item (argument indirect Data_ (argument local Address) 0))
648	if addressof:filter<>null
649	e add next
650	e add (instruction (the_function scan_next Data_ Data_ DataScanBuffer -> CBool) e:1:result item buf some)
651	e add (instruction (the_function 'jump if' CBool) some jump body)
652	e add end
653	if addressof:sort<>null
654	var Link:Argument ptr :> argument local Address
655	var Link:Argument cursor :> argument indirect Data_ ptr 0
656	var Link:Argument cond :> argument local CBool
657	var Link:Instruction stop :> instruction the_function:'do nothing'
658	var Link:Function f :> pick_function (shunt reversed ". last" ". first") (Index key Data_) Data_ (null map Type) (null map Type) 1 2 e:module ?
659	e add (instruction f idx cursor)
660	e add (instruction (the_function is_null Address -> CBool) ptr cond)
661	e add (instruction (the_function 'jump if' CBool) cond jump stop)
662	var Link:Instruction again :> instruction the_function:'do nothing'
663	e add again
664	e add (instruction (the_function 'copy Universal' Universal Universal Type) cursor item (argument mapped_constant Type Data_))
665	e suckup (e e:size-1)
666	var Link:Function f :>pick_function (shunt reversed ". previous" ". next") (Index key Data_) Data_ Data_ (null map Type) 2 3 e:module ?
667	e add (instruction f idx cursor cursor)
668	e add (instruction (the_function is_null Address -> CBool) ptr cond)
669	e add (instruction (the_function 'jump if not' CBool) cond jump again)
670	e add stop
671	e set_void_result
672
673
674	export '. search_path'
675
676	export ':>' ':=' '' '. size' '. create' '. delete' keyof pathof exists
677	export '. pmap' data_reset data_copy
678	export each