2005-07-16 22:16:18 -04:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
2005-12-31 20:51:58 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2005-07-16 22:16:18 -04:00
|
|
|
IN: sequences
|
2005-09-11 20:46:55 -04:00
|
|
|
USING: arrays kernel lists math sequences-internals strings
|
|
|
|
|
vectors ;
|
2005-07-16 22:16:18 -04:00
|
|
|
|
|
|
|
|
! Note that the sequence union does not include lists, or user
|
|
|
|
|
! defined tuples that respond to the sequence protocol.
|
|
|
|
|
UNION: sequence array string sbuf vector ;
|
|
|
|
|
|
|
|
|
|
: sequence= ( seq seq -- ? )
|
2005-09-16 02:39:33 -04:00
|
|
|
2dup [ length ] 2apply = [
|
2005-09-10 18:27:31 -04:00
|
|
|
dup length [ >r 2dup r> 2nth-unsafe = ] all? 2nip
|
2005-07-16 22:16:18 -04:00
|
|
|
] [
|
2005-08-25 15:27:38 -04:00
|
|
|
2drop f
|
2005-12-10 01:02:13 -05:00
|
|
|
] if ; inline
|
2005-07-16 22:16:18 -04:00
|
|
|
|
|
|
|
|
M: sequence = ( obj seq -- ? )
|
|
|
|
|
2dup eq? [
|
|
|
|
|
2drop t
|
|
|
|
|
] [
|
2005-09-24 15:21:17 -04:00
|
|
|
over type over type eq? [ sequence= ] [ 2drop f ] if
|
|
|
|
|
] if ;
|
2005-07-19 04:23:33 -04:00
|
|
|
|
2005-09-16 02:39:33 -04:00
|
|
|
M: sequence hashcode ( seq -- n )
|
|
|
|
|
#! Poor
|
|
|
|
|
length ;
|
|
|
|
|
|
2005-07-19 04:23:33 -04:00
|
|
|
M: string = ( obj str -- ? )
|
|
|
|
|
over string? [
|
|
|
|
|
over hashcode over hashcode number=
|
2005-09-24 15:21:17 -04:00
|
|
|
[ sequence= ] [ 2drop f ] if
|
2005-07-19 04:23:33 -04:00
|
|
|
] [
|
|
|
|
|
2drop f
|
2005-09-24 15:21:17 -04:00
|
|
|
] if ;
|