/pliant/language/type/set/list.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 "common.pli"
19
20
21	type ListNode_
22	field Pointer:ListNode_ next previous
23
24	method n value -> a
25	arg ListNode_ n ; arg Address a
26	a := addressof:n translate ListNode_ 1
27
28	method n zvalue -> a
29	arg ListNode_ n ; arg Address a
30	if exists:n
31	a := addressof:n translate ListNode_ 1
32	else
33	a := null
34
35	method a 'pliant list node' -> n
36	arg Address a ; arg_RW ListNode_ n
37	n :> (a translate ListNode_ -1) map ListNode_
38
39	method a 'pliant list znode' -> n
40	arg Address a ; arg_RW ListNode_ n
41	if a<>null
42	n :> (a translate ListNode_ -1) map ListNode_
43	else
44	n :> null map ListNode_
45
46
47	type List_
48	field Pointer:ListNode_ first last
49
50	function build l
51	arg_w List_ l
52	l first :> null map ListNode_ ; l last :> null map ListNode_
53
54	method l reset valuetype
55	arg_w List_ l ; arg Type valuetype
56	var Pointer:ListNode_ n :> l first
57	while exists:n
58	var Pointer:ListNode_ n2 :> n next
59	valuetype destroy_instance n:value
60	memory_free addressof:n
61	n :> n2
62	l first :> null map ListNode_ ; l last :> null map ListNode_
63
64	method l insert_before p n
65	arg_rw List_ l ; arg_rw ListNode_ p n
66	if exists:p
67	n previous :> p previous
68	n next :> p
69	if (exists p:previous)
70	p:previous next :> n
71	else
72	l first :> n
73	p previous :> n
74	else # append = inserts as very last
75	n previous :> l last
76	n next :> null map ListNode_
77	if (addressof l:last)<>null
78	l:last next :> n
79	else
80	l first :> n
81	l last :> n
82
83	method l insert_after p n
84	arg_rw List_ l ; arg_rw ListNode_ p n
85	if exists:p
86	n previous :> p
87	n next :> p next
88	if (exists p:next)
89	p:next previous :> n
90	else
91	l last :> n
92	p next :> n
93	else # inserts as very first
94	n previous :> null map ListNode_
95	n next :> l first
96	if (addressof l:first)<>null
97	l:first previous :> n
98	else
99	l last :> n
100	l first :> n
101
102	method l append n
103	arg_rw List_ l ; arg_rw ListNode_ n
104	l insert_before (null map ListNode_) n
105
106	method l remove n -> n2
107	arg_rw List_ l ; arg_rw ListNode_ n ; arg_RW ListNode_ n2
108	if (exists n:next)
109	n:next previous :> n previous
110	n2 :> n next
111	else
112	check (addressof l:last)=addressof:n
113	l last :> n previous
114	n2 :> null map ListNode_
115	if (exists n:previous)
116	n:previous next :> n next
117	else
118	check (addressof l:first)=addressof:n
119	l first :> n next
120
121	method l size -> count
122	arg List_ l ; arg Int count
123	count := 0
124	var Pointer:ListNode_ n :> l first
125	while exists:n
126	count := count+1
127	n :> n next
128
129	method l check
130	arg List_ l
131	if pliant_debugging_level>=2
132	var Pointer:ListNode_ n :> l first
133	while exists:n
134	if (exists n:previous)
135	check (addressof n:previous:next)=addressof:n
136	else
137	check (addressof l:first)=addressof:n
138	if (exists n:next)
139	check (addressof n:next:previous)=addressof:n
140	else
141	check (addressof l:last)=addressof:n
142	n :> n next
143
144
145	export ListNode_ '. next' '. previous'
146	export '. value' '. zvalue' '. pliant list node' '. pliant list znode'
147	export List_ '. first' '. last'
148	export '. reset' '. insert_before' '. insert_after' '. append' '. remove'
149	export '. size' '. check'
150
151
152
153
154
155	gvar Relation 'pliant list types'
156	export 'pliant list types'
157
158	function List value -> t
159	arg Type value ; arg_R Type t
160	has_no_side_effect
161
162	var Address adr := 'pliant list types' query null addressof:value
163	if adr<>null
164	return (adr map Type)
165
166	runtime_compile  Value value  List (cast "(List "+value:name+")" Ident)
167
168	type List
169	field List_ list
170
171	function destroy l
172	arg_w List l
173	l:list reset Value
174
175	method l first -> v
176	arg List l ; arg_C Value v
177	(addressof Pointer:Value v) map Address := l:list:first zvalue
178
179	method l last -> v
180	arg List l ; arg_C Value v
181	(addressof Pointer:Value v) map Address := l:list:last zvalue
182
183	method l next v1 -> v2
184	arg List l ; arg_r Value v1 ; arg_C Value v2
185	check (addressof Value v1)<>null
186	var Pointer:ListNode_ n :> (addressof Value v1) 'pliant list node'
187	(addressof Pointer:Value v2) map Address := n:next zvalue
188
189	method l previous v1 -> v2
190	arg List l ; arg_r Value v1 ; arg_C Value v2
191	check (addressof Value v1)<>null
192	var Pointer:ListNode_ n :> (addressof Value v1) 'pliant list node'
193	(addressof Pointer:Value v2) map Address := n:previous zvalue
194
195	method l insert_before v1 v -> v2
196	arg_rw List l ; arg_r Value v1 ; arg Value v ; arg_C Value v2
197	var Pointer:ListNode_ n :> (memory_allocate ListNode_:size+Value:size addressof:l) map ListNode_
198	Value build_instance n:value
199	Value copy_instance (addressof Value v) n:value
200	l:list insert_before (addressof Value v1):'pliant list znode' n
201	(addressof Pointer:Value v2) map Address := n value
202
203	method l insert_after v1 v -> v2
204	arg_rw List l ; arg_r Value v1 ; arg Value v ; arg_C Value v2
205	var Pointer:ListNode_ n :> (memory_allocate ListNode_:size+Value:size addressof:l) map ListNode_
206	Value build_instance n:value
207	Value copy_instance (addressof Value v) n:value
208	l:list insert_after (addressof Value v1):'pliant list znode' n
209	(addressof Pointer:Value v2) map Address := n value
210
211	method l remove v1 -> v2
212	arg_rw List l ; arg_r Value v1 ; arg_C Value v2
213	check (addressof Value v1)<>null
214	var Pointer:ListNode_ n :> (addressof Value v1) 'pliant list node'
215	(addressof Pointer:Value v2) map Address := (l:list remove n) zvalue
216	Value destroy_instance n:value
217	memory_free addressof:n
218
219	function '+=' l v
220	arg_rw List l ; arg Value v
221	l insert_before (null map Value) v
222
223	function '-=' l v
224	arg_rw List l ; arg_r Value v
225	l remove v
226
227	method l size -> count
228	arg List l ; arg Int count
229	count := l:list size
230
231	method l check
232	arg List l
233	l:list check
234
235	function copy src dest
236	arg List src ; arg_w List dest
237	dest:list reset Value
238	var Pointer:ListNode_ n :> src:list first
239	while exists:n
240	dest += n:value map Value
241	n :> n next
242
243	export List '. first' '. next' '. last' '. previous' '. insert_before' '. insert_after' '. remove' '+=' '-=' '. size' '. check'
244	'pliant list types' define null addressof:Value addressof:List
245	'pliant set types' define addressof:List addressof:List addressof:(new Str "List")
246	'pliant set types' define addressof:List null addressof:Void
247	'pliant set types' define null addressof:List addressof:Value
248
249	var Address adr := 'pliant list types' query null addressof:value
250	check adr<>null
251	return (adr map Type)
252
253	export List