2005-01-29 14:18:28 -05:00
|
|
|
! Copyright (C) 2003, 2005 Slava Pestov.
|
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2005-04-26 00:35:55 -04:00
|
|
|
IN: lists USING: generic kernel sequences ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-12-15 16:57:29 -05:00
|
|
|
! This file contains vital list-related words that everything
|
|
|
|
|
! else depends on, and is loaded early in bootstrap.
|
|
|
|
|
! lists.factor has everything else.
|
|
|
|
|
|
2005-03-19 00:30:49 -05:00
|
|
|
! We borrow an idiom from Common Lisp. The car/cdr of an empty
|
|
|
|
|
! list is the empty list.
|
|
|
|
|
M: f car ;
|
|
|
|
|
M: f cdr ;
|
|
|
|
|
|
2005-08-03 18:47:32 -04:00
|
|
|
UNION: general-list POSTPONE: f cons ;
|
2005-07-16 22:16:18 -04:00
|
|
|
|
2005-04-25 19:54:21 -04:00
|
|
|
GENERIC: >list ( seq -- list )
|
2005-05-14 17:18:45 -04:00
|
|
|
M: general-list >list ( list -- list ) ;
|
2005-04-25 19:54:21 -04:00
|
|
|
|
2005-04-26 00:35:55 -04:00
|
|
|
: last ( list -- last )
|
2004-12-15 16:57:29 -05:00
|
|
|
#! Last cons of a list.
|
2005-08-19 22:22:15 -04:00
|
|
|
dup cdr cons? [ cdr last ] when ; foldable
|
2004-12-15 16:57:29 -05:00
|
|
|
|
2004-12-23 01:14:07 -05:00
|
|
|
PREDICATE: general-list list ( list -- ? )
|
2004-12-15 16:57:29 -05:00
|
|
|
#! Proper list test. A proper list is either f, or a cons
|
|
|
|
|
#! cell whose cdr is a proper list.
|
2005-04-26 00:35:55 -04:00
|
|
|
dup [ last cdr ] when not ;
|
2004-12-15 16:57:29 -05:00
|
|
|
|
2005-08-02 02:03:36 -04:00
|
|
|
: uncons ( [[ car cdr ]] -- car cdr ) dup car swap cdr ; inline
|
|
|
|
|
: unswons ( [[ car cdr ]] -- cdr car ) dup cdr swap car ; inline
|
2005-07-16 22:16:18 -04:00
|
|
|
|
2005-08-19 22:22:15 -04:00
|
|
|
: swons ( cdr car -- [[ car cdr ]] ) swap cons ; inline
|
|
|
|
|
: unit ( a -- [ a ] ) f cons ; inline
|
|
|
|
|
: 2list ( a b -- [ a b ] ) unit cons ; inline
|
2005-07-16 22:16:18 -04:00
|
|
|
|
2005-08-02 02:03:36 -04:00
|
|
|
: 2car ( cons cons -- car car ) swap car swap car ; inline
|
|
|
|
|
: 2cdr ( cons cons -- car car ) swap cdr swap cdr ; inline
|
2005-01-28 23:55:22 -05:00
|
|
|
|
2005-07-16 22:16:18 -04:00
|
|
|
M: cons = ( obj cons -- ? )
|
|
|
|
|
2dup eq? [
|
|
|
|
|
2drop t
|
2004-12-15 16:57:29 -05:00
|
|
|
] [
|
2005-07-16 22:16:18 -04:00
|
|
|
over cons? [
|
|
|
|
|
2dup 2car = >r 2cdr = r> and
|
2005-01-19 21:01:47 -05:00
|
|
|
] [
|
2005-07-16 22:16:18 -04:00
|
|
|
2drop f
|
2005-01-19 21:01:47 -05:00
|
|
|
] ifte
|
2005-07-16 22:16:18 -04:00
|
|
|
] ifte ;
|
|
|
|
|
|
|
|
|
|
M: f = ( obj f -- ? ) eq? ;
|
|
|
|
|
|
|
|
|
|
M: cons hashcode ( cons -- hash ) car hashcode ;
|