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