1 # A list links up multiple objects together to make them easier to manage.
  2 #
  3 # The objects must be of the same type. If you want to store multiple types in
  4 # a single list, use an exclusive-container.
  5 
  6 container list:_elem [
  7   value:_elem
  8   next:&:list:_elem
  9 ]
 10 
 11 def push x:_elem, l:&:list:_elem -> result:&:list:_elem/contained-in:l [
 12   local-scope
 13   load-inputs
 14   result <- new {(list _elem): type}
 15   *result <- merge x, l
 16 ]
 17 
 18 def first in:&:list:_elem -> result:_elem [
 19   local-scope
 20   load-inputs
 21   result <- get *in, value:offset
 22 ]
 23 
 24 def rest in:&:list:_elem -> result:&:list:_elem/contained-in:in [
 25   local-scope
 26   load-inputs
 27   result <- get *in, next:offset
 28 ]
 29 
 30 scenario list-handling [
 31   run [
 32     local-scope
 33     x:&:list:num <- push 3, 0
 34     x <- push 4, x
 35     x <- push 5, x
 36     10:num/raw <- first x
 37     x <- rest x
 38     11:num/raw <- first x
 39     x <- rest x
 40     12:num/raw <- first x
 41     20:&:list:num/raw <- rest x
 42   ]
 43   memory-should-contain [
 44     10 <- 5
 45     11 <- 4
 46     12 <- 3
 47     20 <- 0  # nothing left
 48   ]
 49 ]
 50 
 51 def length l:&:list:_elem -> result:num [
 52   local-scope
 53   load-inputs
 54   result <- copy 0
 55   {
 56     break-unless l
 57     result <- add result, 1
 58     l <- rest l
 59     loop
 60   }
 61 ]
 62 
 63 # insert 'x' after 'in'
 64 def insert x:_elem, in:&:list:_elem -> in:&:list:_elem [
 65   local-scope
 66   load-inputs
 67   new-node:&:list:_elem <- new {(list _elem): type}
 68   *new-node <- put *new-node, value:offset, x
 69   next-node:&:list:_elem <- get *in, next:offset
 70   *in <- put *in, next:offset, new-node
 71   *new-node <- put *new-node, next:offset, next-node
 72 ]
 73 
 74 scenario inserting-into-list [
 75   local-scope
 76   list:&:list:num <- push 3, 0
 77   list <- push 4, list
 78   list <- push 5, list
 79   run [
 80     list2:&:list:num <- rest list  # inside list
 81     list2 <- insert 6, list2
 82     # check structure
 83     list2 <- copy list
 84     10:num/raw <- first list2
 85     list2 <- rest list2
 86     11:num/raw <- first list2
 87     list2 <- rest list2
 88     12:num/raw <- first list2
 89     list2 <- rest list2
 90     13:num/raw <- first list2
 91   ]
 92   memory-should-contain [
 93     10 <- 5  # scanning next
 94     11 <- 4
 95     12 <- 6  # inserted element
 96     13 <- 3
 97   ]
 98 ]
 99 
100 scenario inserting-at-end-of-list [
101   local-scope
102   list:&:list:num <- push 3, 0
103   list <- push 4, list
104   list <- push 5, list
105   run [
106     list2:&:list:num <- rest list  # inside list
107     list2 <- rest list2  # now at end of list
108     list2 <- insert 6, list2
109     # check structure like before
110     list2 <- copy list
111     10:num/raw <- first list2
112     list2 <- rest list2
113     11:num/raw <- first list2
114     list2 <- rest list2
115     12:num/raw <- first list2
116     list2 <- rest list2
117     13:num/raw <- first list2
118   ]
119   memory-should-contain [
120     10 <- 5  # scanning next
121     11 <- 4
122     12 <- 3
123     13 <- 6  # inserted element
124   ]
125 ]
126 
127 scenario inserting-after-start-of-list [
128   local-scope
129   list:&:list:num <- push 3, 0
130   list <- push 4, list
131   list <- push 5, list
132   run [
133     list <- insert 6, list
134     # check structure like before
135     list2:&:list:num <- copy list
136     10:num/raw <- first list2
137     list2 <- rest list2
138     11:num/raw <- first list2
139     list2 <- rest list2
140     12:num/raw <- first list2
141     list2 <- rest list2
142     13:num/raw <- first list2
143   ]
144   memory-should-contain [
145     10 <- 5  # scanning next
146     11 <- 6  # inserted element
147     12 <- 4
148     13 <- 3
149   ]
150 ]
151 
152 # remove 'x' from its surrounding list 'in'
153 #
154 # Returns null if and only if list is empty. Beware: in that case any other
155 # pointers to the head are now invalid.
156 def remove x:&:list:_elem/contained-in:in, in:&:list:_elem -> in:&:list:_elem [
157   local-scope
158   load-inputs
159   # if 'x' is null, return
160   return-unless x
161   next-node:&:list:_elem <- rest x
162   # clear next pointer of 'x'
163   *x <- put *x, next:offset, 0
164   # if 'x' is at the head of 'in', return the new head
165   at-head?:bool <- equal x, in
166   return-if at-head?, next-node
167   # compute prev-node
168   prev-node:&:list:_elem <- copy in
169   curr:&:list:_elem <- rest prev-node
170   {
171     return-unless curr
172     found?:bool <- equal curr, x
173     break-if found?
174     prev-node <- copy curr
175     curr <- rest curr
176   }
177   # set its next pointer to skip 'x'
178   *prev-node <- put *prev-node, next:offset, next-node
179 ]
180 
181 scenario removing-from-list [
182   local-scope
183   list:&:list:num <- push 3, 0
184   list <- push 4, list
185   list <- push 5, list
186   run [
187     list2:&:list:num <- rest list  # second element
188     list <- remove list2, list
189     10:bool/raw <- equal list2, 0
190     # check structure like before
191     list2 <- copy list
192     11:num/raw <- first list2
193     list2 <- rest list2
194     12:num/raw <- first list2
195     20:&:list:num/raw <- rest list2
196   ]
197   memory-should-contain [
198     10 <- 0  # remove returned non-null
199     11 <- 5  # scanning next, skipping deleted element
200     12 <- 3
201     20 <- 0  # no more elements
202   ]
203 ]
204 
205 scenario removing-from-start-of-list [
206   local-scope
207   list:&:list:num <- push 3, 0
208   list <- push 4, list
209   list <- push 5, list
210   run [
211     list <- remove list, list
212     # check structure like before
213     list2:&:list:num <- copy list
214     10:num/raw <- first list2
215     list2 <- rest list2
216     11:num/raw <- first list2
217     20:&:list:num/raw <- rest list2
218   ]
219   memory-should-contain [
220     10 <- 4  # scanning next, skipping deleted element
221     11 <- 3
222     20 <- 0  # no more elements
223   ]
224 ]
225 
226 scenario removing-from-end-of-list [
227   local-scope
228   list:&:list:num <- push 3, 0
229   list <- push 4, list
230   list <- push 5, list
231   run [
232     # delete last element
233     list2:&:list:num <- rest list
234     list2 <- rest list2
235     list <- remove list2, list
236     10:bool/raw <- equal list2, 0
237     # check structure like before
238     list2 <- copy list
239     11:num/raw <- first list2
240     list2 <- rest list2
241     12:num/raw <- first list2
242     20:&:list:num/raw <- rest list2
243   ]
244   memory-should-contain [
245     10 <- 0  # remove returned non-null
246     11 <- 5  # scanning next, skipping deleted element
247     12 <- 4
248     20 <- 0  # no more elements
249   ]
250 ]
251 
252 scenario removing-from-singleton-list [
253   local-scope
254   list:&:list:num <- push 3, 0
255   run [
256     list <- remove list, list
257     1:num/raw <- copy list
258   ]
259   memory-should-contain [
260     1 <- 0  # back to an empty list
261   ]
262 ]
263 
264 # reverse the elements of a list
265 # (contributed by Caleb Couch)
266 def reverse list:&:list:_elem temp:&:list:_elem/contained-in:result -> result:&:list:_elem [
267   local-scope
268   load-inputs
269   return-unless list, temp
270   object:_elem <- first, list
271   list <- rest list
272   temp <- push object, temp
273   result <- reverse list, temp
274 ]
275 
276 scenario reverse-list [
277   local-scope
278   list:&:list:num <- push 1, 0
279   list <- push 2, list
280   list <- push 3, list
281   run [
282     stash [list:], list
283     list <- reverse list
284     stash [reversed:], list
285   ]
286   trace-should-contain [
287     app: list: 3 -> 2 -> 1
288     app: reversed: 1 -> 2 -> 3
289   ]
290 ]
291 
292 scenario stash-list [
293   local-scope
294   list:&:list:num <- push 1, 0
295   list <- push 2, list
296   list <- push 3, list
297   run [
298     stash [list:], list
299   ]
300   trace-should-contain [
301     app: list: 3 -> 2 -> 1
302   ]
303 ]
304 
305 def to-text in:&:list:_elem -> result:text [
306   local-scope
307   load-inputs
308   buf:&:buffer:char <- new-buffer 80
309   buf <- to-buffer in, buf
310   result <- buffer-to-array buf
311 ]
312 
313 # variant of 'to-text' which stops printing after a few elements (and so is robust to cycles)
314 def to-text-line in:&:list:_elem -> result:text [
315   local-scope
316   load-inputs
317   buf:&:buffer:char <- new-buffer 80
318   buf <- to-buffer in, buf, 6  # max elements to display
319   result <- buffer-to-array buf
320 ]
321 
322 def to-buffer in:&:list:_elem, buf:&:buffer:char -> buf:&:buffer:char [
323   local-scope
324   load-inputs
325   {
326     break-if in
327     buf <- append buf, [[]]
328     return
329   }
330   # append in.value to buf
331   val:_elem <- get *in, value:offset
332   buf <- append buf, val
333   # now prepare next
334   next:&:list:_elem <- rest in
335   nextn:num <- copy next
336   return-unless next
337   buf <- append buf, [ -> ]
338   # and recurse
339   remaining:num, optional-input-found?:bool <- next-input
340   {
341     break-if optional-input-found?
342     # unlimited recursion
343     buf <- to-buffer next, buf
344     return
345   }
346   {
347     break-unless remaining
348     # limited recursion
349     remaining <- subtract remaining, 1
350     buf <- to-buffer next, buf, remaining
351     return
352   }
353   # past recursion depth; insert ellipses and stop
354   append buf, [...]
355 ]
356 
357 scenario stash-empty-list [
358   local-scope
359   x:&:list:num <- copy 0
360   run [
361     stash x
362   ]
363   trace-should-contain [
364     app: []
365   ]
366 ]