2008-01-31 21:11:46 -05:00
|
|
|
! Copyright (C) 2003, 2008 Slava Pestov.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-06-28 03:36:20 -04:00
|
|
|
USING: accessors kernel math.private sequences kernel.private
|
2008-01-31 21:11:46 -05:00
|
|
|
math sequences.private slots.private byte-arrays
|
|
|
|
alien.accessors ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: strings
|
|
|
|
|
|
|
|
<PRIVATE
|
|
|
|
|
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 -- )
|
2007-11-21 03:13:23 -05:00
|
|
|
1 over sequence-hashcode swap set-string-hashcode ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-03-23 18:12:41 -04:00
|
|
|
: set-string-nth ( ch n string -- )
|
2008-12-05 07:38:51 -05:00
|
|
|
pick HEX: 7f fixnum<=
|
|
|
|
[ set-string-nth-fast ] [ set-string-nth-slow ] if ; inline
|
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
PRIVATE>
|
|
|
|
|
|
|
|
M: string equal?
|
|
|
|
over string? [
|
2008-11-12 00:04:15 -05:00
|
|
|
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
|
|
|
|
length>> ;
|
|
|
|
|
2008-02-01 00:00:08 -05:00
|
|
|
M: string nth-unsafe
|
2008-11-23 03:44:56 -05:00
|
|
|
[ >fixnum ] dip string-nth ;
|
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
|
2008-12-05 07:38:51 -05:00
|
|
|
[ >fixnum ] [ >fixnum ] [ ] tri* set-string-nth ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-02-01 17:02:02 -05:00
|
|
|
M: string clone
|
2008-06-28 03:36:20 -04:00
|
|
|
(clone) [ clone ] change-aux ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
M: string resize resize-string ;
|
|
|
|
|
|
|
|
: 1string ( ch -- str ) 1 swap <string> ;
|
|
|
|
|
|
|
|
: >string ( seq -- str ) "" clone-like ;
|
|
|
|
|
2008-04-13 13:54:58 -04:00
|
|
|
M: string new-sequence drop 0 <string> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
INSTANCE: string sequence
|