/pliant/language/type/set/array.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	scope "/pliant/language/" "/pliant/install/"
17	module "/pliant/install/ring2.pli"
18	submodule "/pliant/language/basic/setfield.pli"
19	submodule "common.pli"
20
21
22	gvar Relation 'pliant array types'
23	export 'pliant array types'
24
25	function Array value -> t
26	arg Type value ; arg_R Type t
27	has_no_side_effect
28
29	var Address adr := 'pliant array types' query addressof:value null
30	if adr<>null
31	return (adr map Type)
32
33	runtime_compile  Value value  Array (cast "(Array "+value:name+")" Ident)
34	type Array
35	field Address items
36	field Int nb
37
38	function build  a
39	arg_w Array a
40	a items := null
41	a nb := 0
42
43	function destroy a
44	arg_w Array a
45	if (Value:flags .and. type_flag_scalar)=0
46	for (var Int i) 0 a:nb-1
47	Value destroy_instance (a:items translate Value i)
48	memory_free a:items
49
50	method a '' k -> v
51	arg Array a ; arg Int k ; arg_C Value v
52	check k>=0 and k<a:nb "out of range array index"
53	# v :> (a:items translate Value k) map Value
54	(addressof Pointer:Value v) map Address := a:items translate Value k
55
56	method a size -> n
57	arg Array a ; arg Int n
58	n := a nb
59
60	method a 'size :=' s
61	arg_rw Array a ; arg Int s
62	check s>=0 "negative array size"
63	if s>a:nb
64	a items := memory_resize a:items s*Value:size addressof:a
65	if (Value:flags .and. type_flag_scalar)=0
66	for (var Int i) a:nb s-1
67	Value build_instance (a:items translate Value i)
68	if s<a:nb
69	if (Value:flags .and. type_flag_scalar)=0
70	for (var Int i) s a:nb-1
71	Value destroy_instance (a:items translate Value i)
72	a items := memory_resize a:items s*Value:size addressof:a
73	a nb := s
74
75	function copy src dest
76	arg Array src ; arg_w Array dest
77	dest 'size :=' src:nb
78	if (Value:flags .and. type_flag_scalar)=0
79	for (var Int i) 0 src:nb-1
80	# dest i := src i
81	Value copy_instance (src:items translate Value i) (dest:items translate Value i)
82	else
83	memory_copy src:items dest:items src:nb*Value:size
84
85	function '+=' a v
86	arg_rw Array a ; arg Value v
87	var Int i := a size
88	a 'size :=' i+1
89	# a i := v
90	Value copy_instance (addressof Value v) (a:items translate Value i)
91
92	method a exists k -> c
93	arg Array a ; arg Int k ; arg CBool c
94	c := k>=0 and k<a:size
95
96	method a key v -> k
97	arg Array a ; arg_r Value v ; arg Int k
98	k := ( (cast (addressof Value v) Int) .-. (cast a:items Int) ) \ Value:size
99
100	method a first -> v
101	arg Array a ; arg_C Value v
102	if a:size>0
103	# v :> a 0
104	(addressof Pointer:Value v) map Address := a items
105	else
106	# v :> null map Value
107	(addressof Pointer:Value v) map Address := null
108
109	method a next v1 -> v2
110	arg Array a ; arg_r Value v1 ; arg_C Value v2
111	var Int i := (a key v1)+1
112	if a:size>i
113	# v2 :> a i
114	(addressof Pointer:Value v2) map Address := a:items translate Value i
115	else
116	# v2 :> null map Value
117	(addressof Pointer:Value v2) map Address := null
118
119	method a first k -> v
120	arg Array a ; arg Int k ; arg_C Value v
121	if k>=0 and k<a:size
122	# v :> a k
123	(addressof Pointer:Value v) map Address := a:items translate Value k
124	else
125	# v :> null map Value
126	(addressof Pointer:Value v) map Address := null
127
128	method a next k v1 -> v2
129	arg Array a; arg Int k ; arg_r Value v1 ; arg_C Value v2
130	# v2 :> null map Value
131	(addressof Pointer:Value v2) map Address := null
132
133	method a check
134	arg Array a
135
136	export Array '' '. size' '. size :=' '+=' '. exists' '. key' '. first' '. next' '. check'
137	'pliant array types' define addressof:Value null addressof:Array
138	'pliant set types' define addressof:Array addressof:Array addressof:(new Str "Array")
139	'pliant set types' define addressof:Array null addressof:Int
140	'pliant set types' define null addressof:Array addressof:Value
141
142	var Address adr := 'pliant array types' query addressof:value null
143	check adr<>null
144	return (adr map Type)
145
146	export Array
147