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