record1 strings

db4
Slava Pestov 2008-01-31 23:00:08 -06:00
parent 6530057512
commit 2ef76798b0
34 changed files with 227 additions and 236 deletions

View File

@ -1,6 +1,7 @@
USING: byte-arrays arrays help.syntax help.markup
alien.syntax compiler definitions math libc
debugger parser io io.backend system bit-arrays float-arrays ;
debugger parser io io.backend system bit-arrays float-arrays
alien.accessors ;
IN: alien
HELP: alien

6
core/alien/alien-tests.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
IN: temporary
USING: alien byte-arrays
arrays kernel kernel.private namespaces tools.test sequences
libc math system prettyprint ;
USING: alien alien.accessors byte-arrays arrays kernel
kernel.private namespaces tools.test sequences libc math system
prettyprint ;
[ t ] [ -1 <alien> alien-address 0 > ] unit-test

View File

@ -3,7 +3,7 @@
USING: byte-arrays arrays generator.registers assocs
kernel kernel.private libc math namespaces parser sequences
strings words assocs splitting math.parser cpu.architecture
alien quotations system compiler.units ;
alien alien.accessors quotations system compiler.units ;
IN: alien.c-types
TUPLE: c-type

51
core/ascii/ascii-docs.factor Executable file
View File

@ -0,0 +1,51 @@
USING: help.markup help.syntax ;
IN: ascii
HELP: blank?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an ASCII whitespace character." } ;
HELP: letter?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for a lowercase alphabet ASCII character." } ;
HELP: LETTER?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for a uppercase alphabet ASCII character." } ;
HELP: digit?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an ASCII decimal digit character." } ;
HELP: Letter?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an ASCII alphabet character, both upper and lower case." } ;
HELP: alpha?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an alphanumeric ASCII character." } ;
HELP: printable?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for a printable ASCII character." } ;
HELP: control?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an ASCII control character." } ;
HELP: quotable?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for characters which may appear in a Factor string literal without escaping." } ;
ARTICLE: "ascii" "ASCII character classes"
"Traditional ASCII character classes:"
{ $subsection blank? }
{ $subsection letter? }
{ $subsection LETTER? }
{ $subsection digit? }
{ $subsection printable? }
{ $subsection control? }
{ $subsection quotable? }
"Modern applications should use Unicode 5.0 instead (" { $vocab-link "unicode" } ")." ;
ABOUT: "ascii"

27
core/ascii/ascii.factor Executable file
View File

@ -0,0 +1,27 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences math kernel ;
IN: ascii
: blank? ( ch -- ? ) " \t\n\r" member? ; inline
: letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline
: LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline
: digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline
: printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline
: control? ( ch -- ? ) "\0\e\r\n\t\u0008\u007f" member? ; inline
: quotable? ( ch -- ? )
dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline
: Letter? ( ch -- ? )
dup letter? [ drop t ] [ LETTER? ] if ; inline
: alpha? ( ch -- ? )
dup Letter? [ drop t ] [ digit? ] if ; inline

1
core/ascii/authors.txt Executable file
View File

@ -0,0 +1 @@
Slava Pestov

1
core/ascii/summary.txt Executable file
View File

@ -0,0 +1 @@
ASCII character classes

1
core/ascii/tags.txt Executable file
View File

@ -0,0 +1 @@
text

View File

@ -17,8 +17,6 @@ IN: bootstrap.image
: image-magic HEX: 0f0e0d0c ; inline
: image-version 4 ; inline
: char bootstrap-cell 2/ ; inline
: data-base 1024 ; inline
: userenv-size 40 ; inline
@ -244,16 +242,13 @@ M: wrapper '
[ emit ] emit-object ;
! Strings
: 16be> 0 [ swap 16 shift bitor ] reduce ;
: 16le> <reversed> 16be> ;
: emit-chars ( seq -- )
char <groups>
big-endian get [ [ 16be> ] map ] [ [ 16le> ] map ] if
bootstrap-cell <groups>
big-endian get [ [ be> ] map ] [ [ le> ] map ] if
emit-seq ;
: pack-string ( string -- newstr )
dup length 1+ char align 0 pad-right ;
dup length 1+ bootstrap-cell align 0 pad-right ;
: emit-string ( string -- ptr )
string type-number object tag-number [

View File

@ -596,8 +596,8 @@ builtins get num-tags get tail f union-class define-class
{ "alien-address" "alien" }
{ "slot" "slots.private" }
{ "set-slot" "slots.private" }
{ "char-slot" "strings.private" }
{ "set-char-slot" "strings.private" }
{ "string-nth" "strings.private" }
{ "set-string-nth" "strings.private" }
{ "resize-array" "arrays" }
{ "resize-string" "strings" }
{ "<array>" "arrays" }

View File

@ -12,7 +12,7 @@ IN: bootstrap.stage2
! you can see what went wrong, instead of dealing with a
! fep
[
vm file-name windows? [ >lower ".exe" ?tail drop ] when
vm file-name windows? [ "." split1 drop ] when
".image" append "output-image" set-global
"math tools help compiler ui ui.tools io" "include" set-global

View File

@ -1,10 +1,10 @@
IN: temporary
USING: arrays compiler kernel kernel.private math
math.constants math.private sequences strings tools.test words
continuations sequences.private hashtables.private byte-arrays
strings.private system random layouts vectors.private
sbufs.private strings.private slots.private alien alien.c-types
alien.syntax namespaces libc combinators.private ;
USING: arrays compiler kernel kernel.private math math.constants
math.private sequences strings tools.test words continuations
sequences.private hashtables.private byte-arrays strings.private
system random layouts vectors.private sbufs.private
strings.private slots.private alien alien.accessors
alien.c-types alien.syntax namespaces libc combinators.private ;
! Make sure that intrinsic ops compile to correct code.
[ ] [ 1 [ drop ] compile-call ] unit-test
@ -36,13 +36,13 @@ alien.syntax namespaces libc combinators.private ;
! Write barrier hits on the wrong value were causing segfaults
[ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
[ CHAR: b ] [ 1 "abc" [ char-slot ] compile-call ] unit-test
[ CHAR: b ] [ 1 [ "abc" char-slot ] compile-call ] unit-test
[ CHAR: b ] [ [ 1 "abc" char-slot ] compile-call ] unit-test
[ "axc" ] [ CHAR: x 1 "abc" [ [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
[ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
[ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
! [ CHAR: b ] [ 1 "abc" [ char-slot ] compile-call ] unit-test
! [ CHAR: b ] [ 1 [ "abc" char-slot ] compile-call ] unit-test
! [ CHAR: b ] [ [ 1 "abc" char-slot ] compile-call ] unit-test
!
! [ "axc" ] [ CHAR: x 1 "abc" [ [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
! [ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
! [ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
[ ] [ [ 0 getenv ] compile-call drop ] unit-test
[ ] [ 1 getenv [ 1 setenv ] compile-call ] unit-test

View File

@ -249,4 +249,4 @@ DEFER: defer-redefine-test-2
[ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test
[ 1 ] [ defer-redefine-test-2 ] unit-test
[ 2 1 ] [ defer-redefine-test-2 ] unit-test

View File

@ -2,8 +2,8 @@
USING: arrays compiler kernel kernel.private math
hashtables.private math.private namespaces sequences
sequences.private tools.test namespaces.private slots.private
combinators.private byte-arrays alien layouts words definitions
compiler.units ;
combinators.private byte-arrays alien alien.accessors layouts
words definitions compiler.units ;
IN: temporary
! Oops!

View File

@ -93,30 +93,6 @@ IN: cpu.ppc.intrinsics
}
} define-intrinsics
: (%char-slot)
"offset" operand "n" operand 2 SRAWI
"offset" operand dup "obj" operand ADD ;
\ char-slot [
(%char-slot)
"out" operand "offset" operand string-offset LHZ
"out" operand dup %tag-fixnum
] H{
{ +input+ { { f "n" } { f "obj" } } }
{ +scratch+ { { f "out" } { f "offset" } } }
{ +output+ { "out" } }
} define-intrinsic
\ set-char-slot [
(%char-slot)
"val" operand dup %untag-fixnum
"val" operand "offset" operand string-offset STH
] H{
{ +input+ { { f "val" } { f "n" } { f "obj" } } }
{ +scratch+ { { f "offset" } } }
{ +clobber+ { "val" } }
} define-intrinsic
: fixnum-register-op ( op -- pair )
[ "out" operand "y" operand "x" operand ] swap add H{
{ +input+ { { f "x" } { f "y" } } }

View File

@ -1,12 +1,13 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays cpu.x86.assembler cpu.x86.allot
cpu.x86.architecture cpu.architecture kernel kernel.private math
math.private namespaces quotations sequences
USING: alien alien.accessors arrays cpu.x86.assembler
cpu.x86.allot cpu.x86.architecture cpu.architecture kernel
kernel.private math math.private namespaces quotations sequences
words generic byte-arrays hashtables hashtables.private
generator generator.registers generator.fixup sequences.private
sbufs sbufs.private vectors vectors.private layouts system
tuples.private strings.private slots.private compiler.constants ;
tuples.private strings.private slots.private compiler.constants
;
IN: cpu.x86.intrinsics
! Type checks
@ -153,34 +154,6 @@ IN: cpu.x86.intrinsics
: small-reg-16 BX ; inline
: small-reg-32 EBX ; inline
\ char-slot [
small-reg PUSH
"n" operand 2 SHR
small-reg dup XOR
"obj" operand "n" operand ADD
small-reg-16 "obj" operand string-offset [+] MOV
small-reg %tag-fixnum
"obj" operand small-reg MOV
small-reg POP
] H{
{ +input+ { { f "n" } { f "obj" } } }
{ +output+ { "obj" } }
{ +clobber+ { "obj" "n" } }
} define-intrinsic
\ set-char-slot [
small-reg PUSH
"val" operand %untag-fixnum
"slot" operand 2 SHR
"obj" operand "slot" operand ADD
small-reg "val" operand MOV
"obj" operand string-offset [+] small-reg-16 MOV
small-reg POP
] H{
{ +input+ { { f "val" } { f "slot" } { f "obj" } } }
{ +clobber+ { "val" "slot" "obj" } }
} define-intrinsic
! Fixnums
: fixnum-op ( op hash -- pair )
>r [ "x" operand "y" operand ] swap add r> 2array ;

10
core/cpu/x86/sse2/sse2.factor Normal file → Executable file
View File

@ -1,10 +1,10 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays cpu.x86.assembler cpu.x86.architecture
cpu.x86.intrinsics generic kernel kernel.private math
math.private memory namespaces sequences words generator
generator.registers cpu.architecture math.floats.private layouts
quotations ;
USING: alien alien.accessors arrays cpu.x86.assembler
cpu.x86.architecture cpu.x86.intrinsics generic kernel
kernel.private math math.private memory namespaces sequences
words generator generator.registers cpu.architecture
math.floats.private layouts quotations ;
IN: cpu.x86.sse2
: define-float-op ( word op -- )

4
core/growable/growable-docs.factor Normal file → Executable file
View File

@ -21,7 +21,7 @@ HELP: set-fill
{ $values { "n" "a new fill pointer" } { "seq" "a resizable sequence" } }
{ $contract "Sets the fill pointer (number of occupied elements in the underlying storage) of a resizable sequence." }
{ $side-effects "seq" }
{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
{ $warning "This word is in the " { $vocab-link "growable.private" } " vocabulary because it is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
HELP: underlying
{ $values { "seq" "a resizable sequence" } { "underlying" "the underlying sequence" } }
@ -30,7 +30,7 @@ HELP: underlying
HELP: set-underlying
{ $values { "underlying" "a sequence" } { "seq" "a resizable sequence" } }
{ $contract "Modifies the underlying storage of a resizable sequence." }
{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
{ $warning "This word is in the " { $vocab-link "growable.private" } " vocabulary because it is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
HELP: capacity
{ $values { "seq" "a vector or string buffer" } { "n" "the capacity of the sequence" } }

View File

@ -1,15 +1,16 @@
! Copyright (C) 2004, 2007 Slava Pestov.
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays bit-arrays byte-arrays classes
combinators.private continuations.private effects float-arrays
generic hashtables hashtables.private inference.state
inference.backend inference.dataflow io io.backend io.files
io.files.private io.streams.c kernel kernel.private math
math.private memory namespaces namespaces.private parser
prettyprint quotations quotations.private sbufs sbufs.private
sequences sequences.private slots.private strings
strings.private system threads.private tuples tuples.private
vectors vectors.private words words.private assocs inspector ;
USING: alien alien.accessors arrays bit-arrays byte-arrays
classes combinators.private continuations.private effects
float-arrays generic hashtables hashtables.private
inference.state inference.backend inference.dataflow io
io.backend io.files io.files.private io.streams.c kernel
kernel.private math math.private memory namespaces
namespaces.private parser prettyprint quotations
quotations.private sbufs sbufs.private sequences
sequences.private slots.private strings strings.private system
threads.private tuples tuples.private vectors vectors.private
words words.private assocs inspector ;
IN: inference.known-words
! Shuffle words
@ -480,10 +481,10 @@ t over set-effect-terminated?
\ set-slot { object object fixnum } { } <effect> "inferred-effect" set-word-prop
\ char-slot { fixnum object } { fixnum } <effect> "inferred-effect" set-word-prop
\ char-slot make-flushable
\ string-nth { fixnum string } { fixnum } <effect> "inferred-effect" set-word-prop
\ string-nth make-flushable
\ set-char-slot { fixnum fixnum object } { } <effect> "inferred-effect" set-word-prop
\ set-string-nth { fixnum fixnum string } { } <effect> "inferred-effect" set-word-prop
\ resize-array { integer array } { array } <effect> "inferred-effect" set-word-prop
\ resize-array make-flushable

34
core/math/parser/parser.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2007 Slava Pestov.
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.private namespaces sequences strings arrays
combinators splitting math ;
combinators splitting math assocs ;
IN: math.parser
DEFER: base>
@ -11,12 +11,30 @@ DEFER: base>
2dup and [ / ] [ 2drop f ] if ;
: digit> ( ch -- n )
{
{ [ dup digit? ] [ CHAR: 0 - ] }
{ [ dup letter? ] [ CHAR: a - 10 + ] }
{ [ dup LETTER? ] [ CHAR: A - 10 + ] }
{ [ t ] [ drop f ] }
} cond ;
H{
{ CHAR: 0 0 }
{ CHAR: 1 1 }
{ CHAR: 2 2 }
{ CHAR: 3 3 }
{ CHAR: 4 4 }
{ CHAR: 5 5 }
{ CHAR: 6 6 }
{ CHAR: 7 7 }
{ CHAR: 8 8 }
{ CHAR: 9 9 }
{ CHAR: A 10 }
{ CHAR: B 11 }
{ CHAR: C 12 }
{ CHAR: D 13 }
{ CHAR: E 14 }
{ CHAR: F 15 }
{ CHAR: a 10 }
{ CHAR: b 11 }
{ CHAR: c 12 }
{ CHAR: d 13 }
{ CHAR: e 14 }
{ CHAR: f 15 }
} at ;
: digits>integer ( radix seq -- n )
0 rot [ swapd * + ] curry reduce ;

View File

@ -1,13 +1,13 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: optimizer.math
USING: alien arrays generic hashtables kernel assocs math
math.private kernel.private sequences words parser
USING: alien alien.accessors arrays generic hashtables kernel
assocs math math.private kernel.private sequences words parser
inference.class inference.dataflow vectors strings sbufs io
namespaces assocs quotations math.intervals sequences.private
combinators splitting layouts math.parser classes
generic.math optimizer.pattern-match optimizer.backend
optimizer.def-use generic.standard system ;
combinators splitting layouts math.parser classes generic.math
optimizer.pattern-match optimizer.backend optimizer.def-use
generic.standard system ;
{ + bignum+ float+ fixnum+fast } {
{ { number 0 } [ drop ] }

3
core/parser/parser.factor Normal file → Executable file
View File

@ -5,7 +5,8 @@ namespaces prettyprint sequences strings vectors words
quotations inspector io.styles io combinators sorting
splitting math.parser effects continuations debugger
io.files io.streams.string io.streams.lines vocabs
source-files classes hashtables compiler.errors compiler.units ;
source-files classes hashtables compiler.errors compiler.units
ascii ;
IN: parser
TUPLE: lexer text line column ;

View File

@ -4,7 +4,7 @@ USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors
generic hashtables io assocs kernel math namespaces sequences
strings sbufs io.styles vectors words prettyprint.config
prettyprint.sections quotations io io.files math.parser effects
tuples classes float-arrays float-vectors ;
tuples classes float-arrays float-vectors ascii ;
IN: prettyprint.backend
GENERIC: pprint* ( obj -- )

View File

@ -14,7 +14,7 @@ PRIVATE>
: <sbuf> ( n -- sbuf ) 0 <string> 0 string>sbuf ; inline
M: sbuf set-nth-unsafe
underlying >r >r >fixnum r> >fixnum r> set-char-slot ;
underlying >r >r >fixnum r> >fixnum r> set-string-nth ;
M: sbuf new drop [ 0 <string> ] keep >fixnum string>sbuf ;

View File

@ -1 +1,2 @@
text
collections

View File

@ -4,7 +4,11 @@ sbufs math ;
IN: strings
ARTICLE: "strings" "Strings"
"A string is a fixed-size mutable sequence of characters. The literal syntax is covered in " { $link "syntax-strings" } "."
"A string is a fixed-size mutable sequence of Unicode 5.0 code points."
$nl
"Characters are not a first-class type; they are simply represented as integers between 0 and 16777216 (2^24). Only characters up to 2097152 (2^21) have a defined meaning in Unicode."
$nl
"String literal syntax is covered in " { $link "syntax-strings" } "."
$nl
"String words are found in the " { $vocab-link "strings" } " vocabulary."
$nl
@ -16,28 +20,25 @@ $nl
{ $subsection <string> }
"Creating a string from a single character:"
{ $subsection 1string }
"Characters are not a first-class type; they are simply represented as integers between 0 and 65535. A few words operate on characters:"
{ $subsection blank? }
{ $subsection letter? }
{ $subsection LETTER? }
{ $subsection digit? }
{ $subsection printable? }
{ $subsection control? }
{ $subsection quotable? }
{ $subsection ch>lower }
{ $subsection ch>upper } ;
"Since strings are sequences, basic string manipulation can be performed using sequence operations (" { $link "sequences" } "). More advanced functionality can be found in other vocabularies, including but not limited to:"
{ $list
{ { $vocab-link "ascii" } " - traditional ASCII character classes" }
{ { $vocab-link "unicode" } " - Unicode 5.0-aware character classes, case conversion, word breaks, ..." }
{ { $vocab-link "regexp" } " - regular expressions" }
{ { $vocab-link "peg" } " - parser expression grammars" }
} ;
ABOUT: "strings"
HELP: string
{ $description "The class of fixed-length character strings. See " { $link "syntax-strings" } " for syntax and " { $link "strings" } " for general information." } ;
HELP: char-slot ( n string -- ch )
HELP: string-nth ( n string -- ch )
{ $values { "n" fixnum } { "string" string } { "ch" "the character at the " { $snippet "n" } "th index" } }
{ $description "Unsafe string accessor, used to define " { $link nth } " on strings." }
{ $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link nth } " instead." } ;
HELP: set-char-slot ( ch n string -- )
HELP: set-string-nth ( ch n string -- )
{ $values { "ch" "a character" } { "n" fixnum } { "string" string } }
{ $description "Unsafe string mutator, used to define " { $link set-nth } " on strings." }
{ $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link set-nth } " instead." } ;
@ -46,58 +47,6 @@ HELP: <string> ( n ch -- string )
{ $values { "n" "a positive integer specifying string length" } { "ch" "an initial character" } { "string" string } }
{ $description "Creates a new string with the given length and all characters initially set to " { $snippet "ch" } "." } ;
HELP: blank?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an ASCII whitespace character." } ;
HELP: letter?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for a lowercase alphabet ASCII character." } ;
HELP: LETTER?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for a uppercase alphabet ASCII character." } ;
HELP: digit?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an ASCII decimal digit character." } ;
HELP: Letter?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an ASCII alphabet character, both upper and lower case." } ;
HELP: alpha?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an alphanumeric ASCII character." } ;
HELP: printable?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for a printable ASCII character." } ;
HELP: control?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for an ASCII control character." } ;
HELP: quotable?
{ $values { "ch" "a character" } { "?" "a boolean" } }
{ $description "Tests for characters which may appear in a Factor string literal without escaping." } ;
HELP: ch>lower
{ $values { "ch" "a character" } { "lower" "a character" } }
{ $description "Converts a character to lowercase." } ;
HELP: ch>upper
{ $values { "ch" "a character" } { "upper" "a character" } }
{ $description "Converts a character to uppercase." } ;
HELP: >lower
{ $values { "str" string } { "lower" string } }
{ $description "Converts a string to lowercase." } ;
HELP: >upper
{ $values { "str" string } { "upper" string } }
{ $description "Converts a string to uppercase." } ;
HELP: 1string
{ $values { "ch" "a character"} { "str" string } }
{ $description "Outputs a string of one character." } ;

26
core/strings/strings-tests.factor Normal file → Executable file
View File

@ -1,5 +1,5 @@
USING: continuations kernel math namespaces strings sbufs
tools.test sequences vectors ;
tools.test sequences vectors arrays ;
IN: temporary
[ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test
@ -66,3 +66,27 @@ unit-test
! Random tester found this
[ { "kernel-error" 3 12 -7 } ]
[ [ 2 -7 resize-string ] catch ] unit-test
"hello world" "s" set
[ ] [ HEX: 1234 1 "s" get set-nth ] unit-test
[ ] [ HEX: 4321 3 "s" get set-nth ] unit-test
[ ] [ HEX: 654321 5 "s" get set-nth ] unit-test
[
{
CHAR: h
HEX: 1234
CHAR: l
HEX: 4321
CHAR: o
HEX: 654321
CHAR: w
CHAR: o
CHAR: r
CHAR: l
CHAR: d
}
] [
"s" get >array
] unit-test

View File

@ -7,11 +7,6 @@ IN: strings
<PRIVATE
: make-string-aux ( string -- aux )
dup string-aux
[ ] [ dup length <byte-array> dup rot set-string-aux ] ?if
{ byte-array } declare ; inline
: string-hashcode 3 slot ; inline
: set-string-hashcode 3 set-slot ; inline
@ -35,43 +30,17 @@ M: string hashcode*
nip dup string-hashcode [ ]
[ dup rehash-string string-hashcode ] ?if ;
M: string nth-unsafe >r >fixnum r> char-slot ;
M: string nth-unsafe
>r >fixnum r> string-nth ;
M: string set-nth-unsafe
dup reset-string-hashcode
>r >fixnum >r >fixnum r> r> set-char-slot ;
>r >fixnum >r >fixnum r> r> set-string-nth ;
M: string clone (clone) ;
M: string resize resize-string ;
! Characters
: blank? ( ch -- ? ) " \t\n\r" member? ; inline
: letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline
: LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline
: digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline
: printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline
: control? ( ch -- ? ) "\0\e\r\n\t\u0008\u007f" member? ; inline
: quotable? ( ch -- ? )
dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline
: Letter? ( ch -- ? )
dup letter? [ drop t ] [ LETTER? ] if ; inline
: alpha? ( ch -- ? )
dup Letter? [ drop t ] [ digit? ] if ; inline
: ch>lower ( ch -- lower )
dup LETTER? [ HEX: 20 + ] when ; inline
: ch>upper ( ch -- upper )
dup letter? [ HEX: 20 - ] when ; inline
: >lower ( str -- lower ) [ ch>lower ] map ;
: >upper ( str -- upper ) [ ch>upper ] map ;
: 1string ( ch -- str ) 1 swap <string> ;
: >string ( seq -- str ) "" clone-like ;

View File

@ -1 +1,2 @@
text
collections

0
core/syntax/tags.txt Executable file
View File

View File

@ -2,8 +2,8 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: io.buffers
USING: alien alien.c-types alien.syntax kernel kernel.private
libc math sequences strings hints ;
USING: alien alien.accessors alien.c-types alien.syntax kernel
kernel.private libc math sequences strings hints ;
TUPLE: buffer size ptr fill pos ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Doug Coleman.
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: continuations io.backend kernel quotations sequences
system alien sequences.private ;
system alien alien.accessors sequences.private ;
IN: io.mmap
TUPLE: mapped-file length address handle closed? ;

View File

@ -1,7 +1,8 @@
USING: alien alien.c-types byte-arrays continuations destructors
io.nonblocking io io.sockets io.sockets.impl namespaces
io.streams.duplex io.windows io.windows.nt.backend
windows.winsock kernel libc math sequences threads tuples.lib ;
USING: alien alien.accessors alien.c-types byte-arrays
continuations destructors io.nonblocking io io.sockets
io.sockets.impl namespaces io.streams.duplex io.windows
io.windows.nt.backend windows.winsock kernel libc math sequences
threads tuples.lib ;
IN: io.windows.nt.sockets
: malloc-int ( object -- object )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays io kernel libc math
math.vectors namespaces opengl opengl.gl prettyprint assocs
USING: alien alien.accessors alien.c-types arrays io kernel libc
math math.vectors namespaces opengl opengl.gl prettyprint assocs
sequences io.files io.styles continuations freetype
ui.gadgets.worlds ui.render ui.backend byte-arrays ;
IN: ui.freetype