extra/spider/unique-deque/unique-deque.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs deques dlists kernel ;
   4 IN: spider.unique-deque
   5
   6 TUPLE: todo-url url depth ;
   7
   8 : <todo-url> ( url depth -- todo-url )
   9     todo-url new
  10         swap >>depth
  11         swap >>url ;
  12
  13 TUPLE: unique-deque assoc deque ;
  14
  15 : <unique-deque> ( -- unique-deque )
  16     H{ } clone <dlist> unique-deque boa ;
  17
  18 : url-exists? ( url unique-deque -- ? )
  19     [ url>> ] [ assoc>> ] bi* key? ;
  20
  21 : push-url ( url depth unique-deque -- )
  22     [ <todo-url> ] dip 2dup url-exists? [
  23         2drop
  24     ] [
  25         [ [ [ t ] dip url>> ] [ assoc>> ] bi* set-at ]
  26         [ deque>> push-back ] 2bi
  27     ] if ;
  28
  29 : pop-url ( unique-deque -- todo-url ) deque>> pop-front ;
  30
  31 : peek-url ( unique-deque -- todo-url ) deque>> peek-front ;
  32
  33 :: slurp-deque-when ( deque quot1: ( value -- ) quot2: ( value -- ) -- )
  34     deque deque-empty? [
  35         deque pop-front dup quot1 call
  36         [ quot2 call t ] [ drop f ] if
  37         [ deque quot1 quot2 slurp-deque-when ] when
  38     ] unless ; inline recursive