! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces arrays sequences io debugger
-words fry continuations vocabs assocs dlists definitions math
-threads graphs generic combinators deques search-deques
+words fry continuations vocabs assocs dlists definitions
+math threads graphs generic combinators deques search-deques
prettyprint io stack-checker stack-checker.state
stack-checker.inlining compiler.errors compiler.units
compiler.tree.builder compiler.tree.optimizer
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors namespaces assocs deques search-deques
-kernel sequences sequences.deep words sets stack-checker.branches
-compiler.tree compiler.tree.def-use compiler.tree.combinators ;
+dlists kernel sequences sequences.deep words sets
+stack-checker.branches compiler.tree compiler.tree.def-use
+compiler.tree.combinators ;
IN: compiler.tree.dead-code.liveness
SYMBOL: work-list
swap >>node
V{ } clone >>uses ;
+ERROR: no-def-error value ;
+
: def-of ( value -- definition )
- def-use get at* [ "No def" throw ] unless ;
+ dup def-use get at* [ nip ] [ no-def-error ] if ;
+
+ERROR: multiple-defs-error ;
: def-value ( node value -- )
def-use get 2dup key? [
- "Multiple defs" throw
+ multiple-defs-error
] [
[ [ <definition> ] keep ] dip set-at
] if ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel assocs arrays namespaces accessors sequences deques
-search-deques compiler.tree compiler.tree.combinators ;
+search-deques dlists compiler.tree compiler.tree.combinators ;
IN: compiler.tree.recursive
! Collect label info
HELP: deque-empty?
{ $values { "deque" deque } { "?" "a boolean" } }
-{ $description "Returns true if a deque is empty." }
+{ $contract "Returns true if a deque is empty." }
{ $notes "This operation is O(1)." } ;
HELP: clear-deque
{ "deque" deque } }
{ $description "Removes all elements from a deque." } ;
-HELP: deque-length
-{ $values
- { "deque" deque }
- { "n" integer } }
-{ $description "Returns the number of elements in a deque." } ;
-
HELP: deque-member?
{ $values
{ "value" object } { "deque" deque }
HELP: push-front*
{ $values { "obj" object } { "deque" deque } { "node" "a node" } }
-{ $description "Push the object onto the front of the deque and return the newly created node." }
+{ $contract "Push the object onto the front of the deque and return the newly created node." }
{ $notes "This operation is O(1)." } ;
HELP: push-back
HELP: push-back*
{ $values { "obj" object } { "deque" deque } { "node" "a node" } }
-{ $description "Push the object onto the back of the deque and return the newly created node." }
+{ $contract "Push the object onto the back of the deque and return the newly created node." }
{ $notes "This operation is O(1)." } ;
HELP: push-all-back
HELP: peek-front
{ $values { "deque" deque } { "obj" object } }
-{ $description "Returns the object at the front of the deque." } ;
+{ $contract "Returns the object at the front of the deque." } ;
HELP: pop-front
{ $values { "deque" deque } { "obj" object } }
HELP: pop-front*
{ $values { "deque" deque } }
-{ $description "Pop the object off the front of the deque." }
+{ $contract "Pop the object off the front of the deque." }
{ $notes "This operation is O(1)." } ;
HELP: peek-back
{ $values { "deque" deque } { "obj" object } }
-{ $description "Returns the object at the back of the deque." } ;
+{ $contract "Returns the object at the back of the deque." } ;
HELP: pop-back
{ $values { "deque" deque } { "obj" object } }
HELP: pop-back*
{ $values { "deque" deque } }
-{ $description "Pop the object off the back of the deque." }
+{ $contract "Pop the object off the back of the deque." }
{ $notes "This operation is O(1)." } ;
HELP: delete-node
{ $values
{ "node" object } { "deque" deque } }
-{ $description "Deletes the node from the deque." } ;
+{ $contract "Deletes the node from the deque." } ;
HELP: deque
{ $description "A data structure that has constant-time insertion and removal of elements at both ends." } ;
"Querying the deque:"
{ $subsection peek-front }
{ $subsection peek-back }
-{ $subsection deque-length }
+{ $subsection deque-empty? }
{ $subsection deque-member? }
"Adding and removing elements:"
{ $subsection push-front* }
{ $subsection delete-node }
{ $subsection node-value }
"Utility operations built in terms of the above:"
-{ $subsection deque-empty? }
{ $subsection push-front }
{ $subsection push-all-front }
{ $subsection push-back }
GENERIC: pop-front* ( deque -- )
GENERIC: pop-back* ( deque -- )
GENERIC: delete-node ( node deque -- )
-GENERIC: deque-length ( deque -- n )
GENERIC: deque-member? ( value deque -- ? )
GENERIC: clear-deque ( deque -- )
GENERIC: node-value ( node -- value )
-
-: deque-empty? ( deque -- ? )
- deque-length zero? ;
+GENERIC: deque-empty? ( deque -- ? )
: push-front ( obj deque -- )
push-front* drop ;
USING: help.markup help.syntax kernel quotations
-deques ;
+deques search-deques hashtables ;
IN: dlists
ARTICLE: "dlists" "Double-linked lists"
{ $subsection dlist-contains? }
"Deleting a node matching a predicate:"
{ $subsection delete-node-if* }
-{ $subsection delete-node-if } ;
+{ $subsection delete-node-if }
+"Search deque implementation:"
+{ $subsection <hashed-dlist> } ;
ABOUT: "dlists"
+HELP: <hashed-dlist> ( -- search-deque )
+{ $values { "search-deque" search-deque } }
+{ $description "Creates a new " { $link search-deque } " backed by a " { $link dlist } ", with a " { $link hashtable } " for fast membership tests." } ;
+
HELP: dlist-find
{ $values { "dlist" { $link dlist } } { "quot" quotation } { "obj/f" "an object or " { $link f } } { "?" "a boolean" } }
{ $description "Applies the quotation to each element of the " { $link dlist } " in turn, until it outputs a true value or the end of the " { $link dlist } " is reached. Outputs either the object it found or " { $link f } ", and a boolean which is true if an object is found." }
[ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
-[ 0 ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-length ] unit-test
-[ 1 ] [ <dlist> 1 over push-back 2 over push-back dup [ 1 = ] delete-node-if drop deque-length ] unit-test
-[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 1 = ] delete-node-if drop deque-length ] unit-test
-[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 2 = ] delete-node-if drop deque-length ] unit-test
-[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back dup [ 3 = ] delete-node-if drop deque-length ] unit-test
-
-[ 0 ] [ <dlist> deque-length ] unit-test
-[ 1 ] [ <dlist> 1 over push-front deque-length ] unit-test
-[ 0 ] [ <dlist> 1 over push-front dup pop-front* deque-length ] unit-test
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node drop class dlist-node = ] unit-test
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node drop class dlist-node = ] unit-test
! Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators kernel math sequences accessors deques
-summary ;
+search-deques summary hashtables ;
IN: dlists
-TUPLE: dlist front back length ;
+<PRIVATE
-: <dlist> ( -- obj )
- dlist new
- 0 >>length ;
+MIXIN: ?dlist-node
-M: dlist deque-length length>> ;
+INSTANCE: f ?dlist-node
-<PRIVATE
+TUPLE: dlist-node obj { prev ?dlist-node } { next ?dlist-node } ;
-TUPLE: dlist-node obj prev next ;
+INSTANCE: dlist-node ?dlist-node
C: <dlist-node> dlist-node
-M: dlist-node node-value obj>> ;
+PRIVATE>
-: inc-length ( dlist -- )
- [ 1+ ] change-length drop ; inline
+TUPLE: dlist
+{ front ?dlist-node }
+{ back ?dlist-node } ;
-: dec-length ( dlist -- )
- [ 1- ] change-length drop ; inline
+: <dlist> ( -- obj )
+ dlist new ; inline
+
+: <hashed-dlist> ( -- search-deque )
+ 20 <hashtable> <dlist> <search-deque> ;
+
+M: dlist deque-empty? front>> not ;
+
+M: dlist-node node-value obj>> ;
: set-prev-when ( dlist-node dlist-node/f -- )
- [ (>>prev) ] [ drop ] if* ;
+ [ (>>prev) ] [ drop ] if* ; inline
: set-next-when ( dlist-node dlist-node/f -- )
- [ (>>next) ] [ drop ] if* ;
+ [ (>>next) ] [ drop ] if* ; inline
: set-next-prev ( dlist-node -- )
- dup next>> set-prev-when ;
+ dup next>> set-prev-when ; inline
: normalize-front ( dlist -- )
- dup back>> [ f >>front ] unless drop ;
+ dup back>> [ f >>front ] unless drop ; inline
: normalize-back ( dlist -- )
- dup front>> [ f >>back ] unless drop ;
+ dup front>> [ f >>back ] unless drop ; inline
: set-back-to-front ( dlist -- )
- dup back>> [ dup front>> >>back ] unless drop ;
+ dup back>> [ dup front>> >>back ] unless drop ; inline
: set-front-to-back ( dlist -- )
- dup front>> [ dup back>> >>front ] unless drop ;
+ dup front>> [ dup back>> >>front ] unless drop ; inline
: (dlist-find-node) ( dlist-node quot: ( node -- ? ) -- node/f ? )
over [
: unlink-node ( dlist-node -- )
dup prev>> over next>> set-prev-when
- dup next>> swap prev>> set-next-when ;
+ dup next>> swap prev>> set-next-when ; inline
PRIVATE>
M: dlist push-front* ( obj dlist -- dlist-node )
[ front>> f swap <dlist-node> dup dup set-next-prev ] keep
[ (>>front) ] keep
- [ set-back-to-front ] keep
- inc-length ;
+ set-back-to-front ;
M: dlist push-back* ( obj dlist -- dlist-node )
[ back>> f <dlist-node> ] keep
[ back>> set-next-when ] 2keep
[ (>>back) ] 2keep
- [ set-front-to-back ] keep
- inc-length ;
+ set-front-to-back ;
ERROR: empty-dlist ;
front>> [ obj>> ] [ empty-dlist ] if* ;
M: dlist pop-front* ( dlist -- )
- dup front>> [ empty-dlist ] unless
[
- dup front>>
+ dup front>> [ empty-dlist ] unless*
dup next>>
f rot (>>next)
f over set-prev-when
swap (>>front)
] keep
- [ normalize-back ] keep
- dec-length ;
+ normalize-back ;
M: dlist peek-back ( dlist -- obj )
back>> [ obj>> ] [ empty-dlist ] if* ;
M: dlist pop-back* ( dlist -- )
- dup back>> [ empty-dlist ] unless
[
- dup back>>
+ dup back>> [ empty-dlist ] unless*
dup prev>>
f rot (>>prev)
f over set-next-when
swap (>>back)
] keep
- [ normalize-front ] keep
- dec-length ;
+ normalize-front ;
: dlist-find ( dlist quot -- obj/f ? )
[ obj>> ] prepose
{
{ [ 2dup front>> eq? ] [ nip pop-front* ] }
{ [ 2dup back>> eq? ] [ nip pop-back* ] }
- [ dec-length unlink-node ]
+ [ drop unlink-node ]
} cond ;
: delete-node-if* ( dlist quot -- obj/f ? )
IN: search-deques
-USING: help.markup help.syntax kernel dlists hashtables
+USING: help.markup help.syntax kernel hashtables
deques assocs ;
ARTICLE: "search-deques" "Search deques"
"A search deque is a data structure with constant-time insertion and removal of elements at both ends, and constant-time membership tests. Inserting an element more than once has no effect. Search deques implement all deque operations in terms of an underlying deque, and membership testing with " { $link deque-member? } " is implemented with an underlying assoc. Search deques are defined in the " { $vocab-link "search-deques" } " vocabulary."
$nl
"Creating a search deque:"
-{ $subsection <search-deque> }
-"Default implementation:"
-{ $subsection <hashed-dlist> } ;
+{ $subsection <search-deque> } ;
ABOUT: "search-deques"
HELP: <search-deque> ( assoc deque -- search-deque )
{ $values { "assoc" assoc } { "deque" deque } { "search-deque" search-deque } }
{ $description "Creates a new " { $link search-deque } "." } ;
-
-HELP: <hashed-dlist> ( -- search-deque )
-{ $values { "search-deque" search-deque } }
-{ $description "Creates a new " { $link search-deque } " backed by a " { $link dlist } ", with a " { $link hashtable } " for fast membership tests." } ;
IN: search-deques.tests
USING: search-deques tools.test namespaces
-kernel sequences words deques vocabs ;
+kernel sequences words deques vocabs dlists ;
<hashed-dlist> "h" set
[ t ] [ "1" get "2" get eq? ] unit-test
[ t ] [ "2" get "3" get eq? ] unit-test
-[ 3 ] [ "h" get deque-length ] unit-test
[ t ] [ 7 "h" get deque-member? ] unit-test
[ 3 ] [ "1" get node-value ] unit-test
[ ] [ "1" get "h" get delete-node ] unit-test
-[ 2 ] [ "h" get deque-length ] unit-test
[ 1 ] [ "h" get pop-back ] unit-test
[ 7 ] [ "h" get pop-back ] unit-test
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel assocs deques dlists hashtables ;
+USING: accessors kernel assocs deques ;
IN: search-deques
TUPLE: search-deque assoc deque ;
C: <search-deque> search-deque
-: <hashed-dlist> ( -- search-deque )
- 0 <hashtable> <dlist> <search-deque> ;
-
-M: search-deque deque-length deque>> deque-length ;
+M: search-deque deque-empty? deque>> deque-empty? ;
M: search-deque peek-front deque>> peek-front ;
projects / factor.git / commitdiff