2010-04-25 20:19:50 -04:00
|
|
|
! Copyright (C) 2003, 2010 Slava Pestov.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2013-03-05 13:34:47 -05:00
|
|
|
USING: accessors alien.accessors byte-arrays kernel
|
|
|
|
kernel.private math math.private sequences sequences.private
|
|
|
|
slots.private ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: strings
|
|
|
|
|
2013-03-10 15:04:34 -04:00
|
|
|
BUILTIN: string { length array-capacity read-only initial: 0 } aux ;
|
|
|
|
|
2015-06-25 21:02:03 -04:00
|
|
|
PRIMITIVE: <string> ( n ch -- string )
|
|
|
|
PRIMITIVE: resize-string ( n str -- newstr )
|
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
<PRIVATE
|
2015-06-25 21:02:03 -04:00
|
|
|
PRIMITIVE: set-string-nth-fast ( ch n string -- )
|
|
|
|
PRIMITIVE: string-nth-fast ( n string -- ch )
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-12-15 20:44:56 -05:00
|
|
|
: string-hashcode ( str -- n ) 3 slot ; inline
|
2008-01-31 21:11:46 -05:00
|
|
|
|
2008-12-15 20:44:56 -05:00
|
|
|
: set-string-hashcode ( n str -- ) 3 set-slot ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-12-15 20:44:56 -05:00
|
|
|
: reset-string-hashcode ( str -- )
|
|
|
|
f swap set-string-hashcode ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: rehash-string ( str -- )
|
2011-10-06 11:37:05 -04:00
|
|
|
1 over sequence-hashcode swap set-string-hashcode ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2010-04-25 20:19:50 -04:00
|
|
|
: (aux) ( n string -- byte-array m )
|
|
|
|
aux>> { byte-array } declare swap 1 fixnum-shift-fast ; inline
|
|
|
|
|
2011-07-20 13:21:11 -04:00
|
|
|
: small-char? ( ch -- ? )
|
2011-11-23 21:49:33 -05:00
|
|
|
dup 0 fixnum>= [ 0x7f fixnum<= ] [ drop f ] if ; inline
|
2010-04-25 20:19:50 -04:00
|
|
|
|
|
|
|
: string-nth ( n string -- ch )
|
|
|
|
2dup string-nth-fast dup small-char?
|
|
|
|
[ 2nip ] [
|
|
|
|
[ (aux) alien-unsigned-2 7 fixnum-shift-fast ] dip
|
|
|
|
fixnum-bitxor
|
|
|
|
] if ; inline
|
|
|
|
|
|
|
|
: ensure-aux ( string -- string )
|
|
|
|
dup aux>> [ dup length 2 * (byte-array) >>aux ] unless ; inline
|
|
|
|
|
|
|
|
: set-string-nth-slow ( ch n string -- )
|
2011-11-23 21:49:33 -05:00
|
|
|
[ [ 0x80 fixnum-bitor ] 2dip set-string-nth-fast ]
|
2010-04-25 20:19:50 -04:00
|
|
|
[
|
|
|
|
ensure-aux
|
|
|
|
[ -7 fixnum-shift-fast 1 fixnum-bitxor ] 2dip
|
|
|
|
(aux) set-alien-unsigned-2
|
|
|
|
] 3bi ;
|
|
|
|
|
2009-03-23 18:12:41 -04:00
|
|
|
: set-string-nth ( ch n string -- )
|
2010-04-25 20:19:50 -04:00
|
|
|
pick small-char?
|
2008-12-05 07:38:51 -05:00
|
|
|
[ set-string-nth-fast ] [ set-string-nth-slow ] if ; inline
|
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
PRIVATE>
|
|
|
|
|
|
|
|
M: string equal?
|
|
|
|
over string? [
|
2018-06-19 20:15:05 -04:00
|
|
|
! faster during bootstrap than ``[ hashcode ] bi@``
|
|
|
|
over hashcode over hashcode eq?
|
2007-09-20 18:09:08 -04:00
|
|
|
[ sequence= ] [ 2drop f ] if
|
|
|
|
] [
|
|
|
|
2drop f
|
|
|
|
] if ;
|
|
|
|
|
|
|
|
M: string hashcode*
|
2008-12-05 07:38:51 -05:00
|
|
|
nip
|
|
|
|
dup string-hashcode
|
|
|
|
[ ] [ dup rehash-string string-hashcode ] ?if ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-06-28 03:36:20 -04:00
|
|
|
M: string length
|
2009-08-17 23:32:21 -04:00
|
|
|
length>> ; inline
|
2008-06-28 03:36:20 -04:00
|
|
|
|
2008-02-01 00:00:08 -05:00
|
|
|
M: string nth-unsafe
|
2012-07-25 21:24:43 -04:00
|
|
|
[ integer>fixnum ] dip string-nth ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-02-01 00:00:08 -05:00
|
|
|
M: string set-nth-unsafe
|
2007-09-20 18:09:08 -04:00
|
|
|
dup reset-string-hashcode
|
2012-07-25 21:24:43 -04:00
|
|
|
[ integer>fixnum ] [ integer>fixnum ] [ ] tri* set-string-nth ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-02-01 17:02:02 -05:00
|
|
|
M: string clone
|
2009-08-17 23:32:21 -04:00
|
|
|
(clone) [ clone ] change-aux ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2013-06-25 18:39:34 -04:00
|
|
|
M: string clone-like
|
|
|
|
over string? [ drop clone ] [ call-next-method ] if ; inline
|
|
|
|
|
2009-08-17 23:32:21 -04:00
|
|
|
M: string resize resize-string ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2011-11-15 22:15:19 -05:00
|
|
|
: 1string ( ch -- str ) 1 swap <string> ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2011-11-15 22:15:19 -05:00
|
|
|
: >string ( seq -- str ) "" clone-like ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-08-17 23:32:21 -04:00
|
|
|
M: string new-sequence drop 0 <string> ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
INSTANCE: string sequence
|