steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

modern: Removing ch'a syntax. 

It's cool but I don't like it right now.
modern-harvey3
Doug Coleman 2019-09-28 10:59:07 -05:00
parent fbf7c73e99
commit d635604026
302 changed files with 1591 additions and 1591 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/alien/parser/parser.factor
View File

@ -21,7 +21,7 @@ ERROR: bad-array-type ;
: (parse-c-type) ( string -- type )
{
{ [ "*" ?tail ] [ (parse-c-type) <pointer> ] }
{ [ ch'\] over member? ] [ parse-array-type ] }
{ [ char: \] over member? ] [ parse-array-type ] }
{ [ dup search ] [ parse-word ] }
[ parse-word ]
} cond ;

30
basis/base64/base64.factor
View File

@ -26,7 +26,7 @@ CONSTANT: alphabet $[
alphabet nth ; inline
: base64>ch ( ch -- ch )
$[ alphabet alphabet-inverse 0 ch'= pick set-nth ] nth
$[ alphabet alphabet-inverse 0 char: = pick set-nth ] nth
[ malformed-base64 ] unless* { fixnum } declare ; inline
: encode3 ( x y z -- a b c d )
@ -41,7 +41,7 @@ CONSTANT: alphabet $[
[
stream stream-write1 1 + dup 76 = [
drop 0
B{ ch'\r ch'\n } stream stream-write
B{ char: \r char: \n } stream stream-write
] when
] each
] [
@ -61,8 +61,8 @@ CONSTANT: alphabet $[
input stream-read1
[ [ 0 or ] bi@ encode3 ] 2keep [ 0 1 ? ] bi@ + {
{ 0 [ ] }
{ 1 [ drop ch'= ] }
{ 2 [ 2drop ch'= ch'= ] }
{ 1 [ drop char: = ] }
{ 2 [ 2drop char: = char: = ] }
} case data (4sequence) output stream-write-lines
] while 2drop ; inline
@ -95,12 +95,12 @@ PRIVATE>
:: (decode-base64) ( input output -- )
3 <byte-array> :> data
[ B{ ch'\n ch'\r } input read1-ignoring dup ] [
B{ ch'\n ch'\r } input read1-ignoring ch'= or
B{ ch'\n ch'\r } input read1-ignoring ch'= or
B{ ch'\n ch'\r } input read1-ignoring ch'= or
[ B{ char: \n char: \r } input read1-ignoring dup ] [
B{ char: \n char: \r } input read1-ignoring char: = or
B{ char: \n char: \r } input read1-ignoring char: = or
B{ char: \n char: \r } input read1-ignoring char: = or
[ decode4 data (3sequence) ] 3keep
[ ch'= eq? 1 0 ? ] tri@ + +
[ char: = eq? 1 0 ? ] tri@ + +
[ head-slice* ] unless-zero
output stream-write
] while drop ;
@ -142,18 +142,18 @@ PRIVATE>
: >urlsafe-base64 ( seq -- base64 )
>base64 H{
{ ch'+ ch'- }
{ ch'/ ch'_ }
{ char: + char: - }
{ char: / char: _ }
} substitute ;
: urlsafe-base64> ( base64 -- seq )
H{
{ ch'- ch'+ }
{ ch'_ ch'/ }
{ char: - char: + }
{ char: _ char: / }
} substitute base64> ;
: >urlsafe-base64-lines ( seq -- base64 )
>base64-lines H{
{ ch'+ ch'- }
{ ch'/ ch'_ }
{ char: + char: - }
{ char: / char: _ }
} substitute ;

6
basis/calendar/format/format.factor
View File

@ -15,14 +15,14 @@ MACRO: formatted ( spec -- quot )
} cond
] map [ cleave ] curry ;
: pad-00 ( n -- str ) number>string 2 ch'0 pad-head ;
: pad-00 ( n -- str ) number>string 2 char: 0 pad-head ;
: formatted>string ( spec -- string )
'[ _ formatted ] with-string-writer ; inline
: pad-0000 ( n -- str ) number>string 4 ch'0 pad-head ;
: pad-0000 ( n -- str ) number>string 4 char: 0 pad-head ;
: pad-00000 ( n -- str ) number>string 5 ch'0 pad-head ;
: pad-00000 ( n -- str ) number>string 5 char: 0 pad-head ;
: write-00 ( n -- ) pad-00 write ;

14
basis/calendar/parser/parser.factor
View File

@ -28,16 +28,16 @@ ERROR: invalid-timestamp-format ;
: read-sp ( -- token ) " " read-token ;
: signed-gmt-offset ( dt ch -- dt' )
{ { ch'+ [ 1 ] } { ch'- [ -1 ] } } case time* ;
{ { char: + [ 1 ] } { char: - [ -1 ] } } case time* ;
: read-rfc3339-gmt-offset ( ch -- dt )
{
{ f [ instant ] }
{ ch'Z [ instant ] }
{ char: Z [ instant ] }
[
[
read-00 hours
read1 { { ch'\: [ read-00 ] } { f [ 0 ] } } case minutes
read1 { { char: \: [ read-00 ] } { f [ 0 ] } } case minutes
time+
] dip signed-gmt-offset
]
@ -58,7 +58,7 @@ ERROR: invalid-timestamp-format ;
read-ymd
"Tt \t" expect
read-hms
read1 { { ch'. [ read-rfc3339-seconds ] } [ ] } case
read1 { { char: . [ read-rfc3339-seconds ] } [ ] } case
read-rfc3339-gmt-offset
<timestamp> ;
@ -66,7 +66,7 @@ ERROR: invalid-timestamp-format ;
[ (rfc3339>timestamp) ] with-string-reader ;
: parse-rfc822-military-offset ( string -- dt )
first ch'A - {
first char: A - {
-1 -2 -3 -4 -5 -6 -7 -8 -9 f -10 -11 -12
1 2 3 4 5 6 7 8 9 10 11 12 0
} nth hours ;
@ -101,7 +101,7 @@ CONSTANT: rfc822-named-zones H{
: (rfc822>timestamp) ( -- timestamp )
"," read-token day-abbreviations3 member? check-timestamp drop
read1 ch'\s assert=
read1 char: \s assert=
read-sp checked-number
read-sp month-abbreviations index 1 + check-timestamp
read-sp checked-number spin
@ -117,7 +117,7 @@ CONSTANT: rfc822-named-zones H{
: (cookie-string>timestamp-1) ( -- timestamp )
"," read-token check-day-name
read1 ch'\s assert=
read1 char: \s assert=
"-" read-token checked-number
"-" read-token month-abbreviations index 1 + check-timestamp
read-sp checked-number spin

2
basis/checksums/adler-32/adler-32-tests.factor
View File

@ -1,4 +1,4 @@
USING: checksums checksums.adler-32 strings tools.test ;
{ 300286872 } [ "Wikipedia" adler-32 checksum-bytes ] unit-test
{ 2679885283 } [ 10000 ch'a <string> adler-32 checksum-bytes ] unit-test
{ 2679885283 } [ 10000 char: a <string> adler-32 checksum-bytes ] unit-test

2
basis/checksums/bsd/bsd-tests.factor
View File

@ -1,4 +1,4 @@
USING: checksums checksums.bsd strings tools.test ;
{ 15816 } [ "Wikipedia" bsd checksum-bytes ] unit-test
{ 47937 } [ 10000 ch'a <string> bsd checksum-bytes ] unit-test
{ 47937 } [ 10000 char: a <string> bsd checksum-bytes ] unit-test

2
basis/checksums/crc16/crc16.factor
View File

@ -36,5 +36,5 @@ M: crc16 checksum-bytes
M: crc16 checksum-lines
init-crc16
[ [ (crc16) ] each ch'\n (crc16) ] each
[ [ (crc16) ] each char: \n (crc16) ] each
finish-crc16 ; inline

2
basis/checksums/ripemd/ripemd-tests.factor
View File

@ -64,4 +64,4 @@ USING: checksums checksums.ripemd strings tools.test ;
0x69 0x7b 0xdb 0xe1 0x6d
0x37 0xf9 0x7f 0x68 0xf0
0x83 0x25 0xdc 0x15 0x28
} } [ 1000000 ch'a <string> ripemd-160 checksum-bytes ] unit-test
} } [ 1000000 char: a <string> ripemd-160 checksum-bytes ] unit-test

2
basis/checksums/sha/sha-tests.factor
View File

@ -5,7 +5,7 @@ IN: checksums.sha.tests
{ "a9993e364706816aba3e25717850c26c9cd0d89d" } [ "abc" sha1 checksum-bytes bytes>hex-string ] unit-test
{ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" } [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes bytes>hex-string ] unit-test
! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 ch'a fill string>sha1str ] unit-test ! takes a long time...
! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 char: a fill string>sha1str ] unit-test ! takes a long time...
{ "dea356a2cddd90c7a7ecedc5ebb563934f460452" } [ "0123456701234567012345670123456701234567012345670123456701234567"
10 swap <array> concat sha1 checksum-bytes bytes>hex-string ] unit-test

12
basis/circular/circular-tests.factor
View File

@ -7,10 +7,10 @@ IN: circular.tests
{ 0 } [ { 0 1 2 3 4 } <circular> 0 swap virtual@ drop ] unit-test
{ 2 } [ { 0 1 2 3 4 } <circular> 2 swap virtual@ drop ] unit-test
{ ch't } [ "test" <circular> 0 swap nth ] unit-test
{ char: t } [ "test" <circular> 0 swap nth ] unit-test
{ "test" } [ "test" <circular> >string ] unit-test
{ ch'e } [ "test" <circular> 5 swap nth-unsafe ] unit-test
{ char: e } [ "test" <circular> 5 swap nth-unsafe ] unit-test
{ [ 1 2 3 ] } [ { 1 2 3 } <circular> [ ] like ] unit-test
{ [ 2 3 1 ] } [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test
@ -19,9 +19,9 @@ IN: circular.tests
{ [ 3 1 2 ] } [ { 1 2 3 } <circular> 1 over change-circular-start 1 over change-circular-start [ ] like ] unit-test
{ [ 3 1 2 ] } [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test
{ "fob" } [ "foo" <circular> ch'b 2 pick set-nth >string ] unit-test
{ "boo" } [ "foo" <circular> ch'b 3 pick set-nth-unsafe >string ] unit-test
{ "ornact" } [ "factor" <circular> 4 over change-circular-start ch'n 2 pick set-nth >string ] unit-test
{ "fob" } [ "foo" <circular> char: b 2 pick set-nth >string ] unit-test
{ "boo" } [ "foo" <circular> char: b 3 pick set-nth-unsafe >string ] unit-test
{ "ornact" } [ "factor" <circular> 4 over change-circular-start char: n 2 pick set-nth >string ] unit-test
{ "bcd" } [ 3 <circular-string> "abcd" [ over circular-push ] each >string ] unit-test
@ -29,7 +29,7 @@ IN: circular.tests
! This no longer fails
! [ "test" <circular> 5 swap nth ] must-fail
! [ "foo" <circular> ch'b 3 rot set-nth ] must-fail
! [ "foo" <circular> char: b 3 rot set-nth ] must-fail
{ { } } [ 3 <growing-circular> >array ] unit-test
{ { 1 2 } } [

12
basis/cocoa/messages/messages.factor
View File

@ -42,7 +42,7 @@ INITIALIZED-SYMBOL: super-message-senders [ H{ } clone ]
TUPLE: selector-tuple name object ;
: selector-name ( name -- name' )
ch'. over index [ 0 > [ "." split1 nip ] when ] when* ;
char: . over index [ 0 > [ "." split1 nip ] when ] when* ;
MEMO: <selector> ( name -- sel )
selector-name f selector-tuple boa ;
@ -185,7 +185,7 @@ cell {
assoc-union alien>objc-types set-global
: objc-struct-type ( i string -- ctype )
[ ch'= ] 2keep index-from swap subseq
[ char: = ] 2keep index-from swap subseq
objc>struct-types get at* [ drop void* ] unless ;
ERROR: no-objc-type name ;
@ -197,9 +197,9 @@ ERROR: no-objc-type name ;
: (parse-objc-type) ( i string -- ctype )
[ [ 1 + ] dip ] [ nth ] 2bi {
{ [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
{ [ dup ch'^ = ] [ 3drop void* ] }
{ [ dup ch'\{ = ] [ drop objc-struct-type ] }
{ [ dup ch'\[ = ] [ 3drop void* ] }
{ [ dup char: ^ = ] [ 3drop void* ] }
{ [ dup char: \{ = ] [ drop objc-struct-type ] }
{ [ dup char: \[ = ] [ 3drop void* ] }
[ 2nip decode-type ]
} cond ;
@ -235,7 +235,7 @@ ERROR: no-objc-type name ;
: method-collisions ( -- collisions )
objc-methods get >alist
[ first ch'. swap member? ] filter
[ first char: . swap member? ] filter
[ first "." split1 nip ] collect-by
[ nip values members length 1 > ] assoc-filter ;

2
basis/colors/constants/constants.factor
View File

@ -9,7 +9,7 @@ IN: colors.constants
: parse-color ( line -- name color )
first4
[ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip
[ blank? ] trim-head H{ { ch'\s ch'- } } substitute swap ;
[ blank? ] trim-head H{ { char: \s char: - } } substitute swap ;
: parse-colors ( lines -- assoc )
[ "!" head? ] reject

4
basis/compiler/cfg/linear-scan/debugger/debugger.factor
View File

@ -14,8 +14,8 @@ IN: compiler.cfg.linear-scan.debugger
allocate-registers drop ;
: picture ( uses -- str )
dup last 1 + ch'space <string>
[ '[ ch'* swap _ set-nth ] each ] keep ;
dup last 1 + char: space <string>
[ '[ char: * swap _ set-nth ] each ] keep ;
: interval-picture ( interval -- str )
[ uses>> picture ]

12
basis/compiler/tests/intrinsics.factor
View File

@ -42,12 +42,12 @@ IN: compiler.tests.intrinsics
! Write barrier hits on the wrong value were causing segfaults
[ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
[ ch'a ] [ 0 "abc" [ string-nth ] compile-call ] unit-test
[ ch'a ] [ 0 [ "abc" string-nth ] compile-call ] unit-test
[ ch'a ] [ [ 0 "abc" string-nth ] compile-call ] unit-test
[ ch'b ] [ 1 "abc" [ string-nth ] compile-call ] unit-test
[ ch'b ] [ 1 [ "abc" string-nth ] compile-call ] unit-test
[ ch'b ] [ [ 1 "abc" string-nth ] compile-call ] unit-test
[ char: a ] [ 0 "abc" [ string-nth ] compile-call ] unit-test
[ char: a ] [ 0 [ "abc" string-nth ] compile-call ] unit-test
[ char: a ] [ [ 0 "abc" string-nth ] compile-call ] unit-test
[ char: b ] [ 1 "abc" [ string-nth ] compile-call ] unit-test
[ char: b ] [ 1 [ "abc" string-nth ] compile-call ] unit-test
[ char: b ] [ [ 1 "abc" string-nth ] compile-call ] unit-test
[ 0x123456 ] [ 0 "\u123456bc" [ string-nth ] compile-call ] unit-test
[ 0x123456 ] [ 0 [ "\u123456bc" string-nth ] compile-call ] unit-test

2
basis/csv/csv-docs.factor
View File

@ -46,7 +46,7 @@ HELP: write-csv
{ $description "Writes a sequence of sequences of comma-separated-values to the output stream, escaping where necessary." } ;
HELP: with-delimiter
{ $values { "ch" "field delimiter (e.g. ch'\\t)" }
{ $values { "ch" "field delimiter (e.g. char: \\t)" }
{ "quot" quotation } }
{ $description "Sets the field delimiter for read-csv, read-row, write-csv, or write-row words." } ;

2
basis/csv/csv-tests.factor
View File

@ -61,7 +61,7 @@ IN: csv.tests
"allows setting of delimiting character"
[ { { "foo" "bah" "baz" } } ]
[ "foo\tbah\tbaz\n" ch'\t [ string>csv ] with-delimiter ] named-unit-test
[ "foo\tbah\tbaz\n" char: \t [ string>csv ] with-delimiter ] named-unit-test
"Quoted field followed immediately by newline"
[ { { "foo" "bar" }

16
basis/csv/csv.factor
View File

@ -7,7 +7,7 @@ IN: csv
SYMBOL: delimiter
ch', delimiter set-global
char: , delimiter set-global
<PRIVATE
@ -20,9 +20,9 @@ DEFER: quoted-field,
2over stream-read1 tuck =
[ nip ] [
{
{ ch'\" [ [ ch'\" , ] when quoted-field, ] }
{ ch'\n [ ] } ! Error: cr inside string?
{ ch'\r [ ] } ! Error: lf inside string?
{ char: \" [ [ char: \" , ] when quoted-field, ] }
{ char: \n [ ] } ! Error: cr inside string?
{ char: \r [ ] } ! Error: lf inside string?
[ [ , drop f maybe-escaped-quote ] when* ]
} case
] if ; inline recursive
@ -45,7 +45,7 @@ DEFER: quoted-field,
swap ?trim nipd ; inline
: field ( delimiter stream field-seps quote-seps -- sep/f field )
pick stream-read-until dup ch'\" = [
pick stream-read-until dup char: \" = [
drop [ drop quoted-field ] [ continue-field ] if-empty
] [ 3nipd swap ?trim ] if ;
@ -89,10 +89,10 @@ PRIVATE>
'[ dup "\n\"\r" member? [ drop t ] [ _ = ] if ] any? ; inline
: escape-quotes ( cell stream -- )
ch'\" over stream-write1 swap [
char: \" over stream-write1 swap [
[ over stream-write1 ]
[ dup ch'\" = [ over stream-write1 ] [ drop ] if ] bi
] each ch'\" swap stream-write1 ;
[ dup char: \" = [ over stream-write1 ] [ drop ] if ] bi
] each char: \" swap stream-write1 ;
: escape-if-required ( cell delimiter stream -- )
[ dupd needs-escaping? ] dip

2
basis/db/postgresql/postgresql.factor
View File

@ -117,7 +117,7 @@ M: postgresql-db-connection <prepared-statement> ( sql in out -- statement )
<simple-statement> dup prepare-statement ;
: bind-name% ( -- )
ch'$ 0,
char: $ 0,
sql-counter [ inc ] [ get 0# ] bi ;
M: postgresql-db-connection bind% ( spec -- )

2
basis/db/tester/tester.factor
View File

@ -8,7 +8,7 @@ IN: db.tester
: postgresql-test-db-name ( -- string )
cpu name>> "-" "factor-test" 3append
H{ { ch'- ch'_ } { ch'. ch'_ } } substitute ;
H{ { char: - char: _ } { char: . char: _ } } substitute ;
: postgresql-test-db ( -- postgresql-db )
\ postgresql-db get-global clone postgresql-test-db-name >>database ;

2
basis/db/tuples/tuples-tests.factor
View File

@ -305,7 +305,7 @@ TUPLE: exam id name score ;
: random-exam ( -- exam )
f
6 [ ch'a ch'z [a,b] random ] replicate >string
6 [ char: a char: z [a,b] random ] replicate >string
100 random
exam boa ;

2
basis/english/english-tests.factor
View File

@ -71,7 +71,7 @@ FROM: english => a/an ;
{ "i18n" } [ "internationalization" a10n ] unit-test
{ "f28n" } [ "floccinauccinihilipilification" a10n ] unit-test
{ "p43s" } [ "pneumonoultramicroscopicsilicovolcanoconiosis" a10n ] unit-test
{ "a10000c" } [ 10000 ch'b <string> "a" "c" surround a10n ] unit-test
{ "a10000c" } [ 10000 char: b <string> "a" "c" surround a10n ] unit-test
{ "an" } [ "object" a/an ] unit-test
{ "an" } [ "elephant" a/an ] unit-test

2
basis/environment/environment-tests.factor
View File

@ -20,7 +20,7 @@ os unix? [
{ f } [ "factor-test-key-1" os-env ] unit-test
{ } [
32766 ch'a <string> "factor-test-key-long" set-os-env
32766 char: a <string> "factor-test-key-long" set-os-env
] unit-test
{ 32766 } [ "factor-test-key-long" os-env length ] unit-test
{ } [ "factor-test-key-long" unset-os-env ] unit-test

12
basis/escape-strings/escape-strings.factor
View File

@ -8,8 +8,8 @@ IN: escape-strings
[ HS{ } clone 0 0 ] dip
[
{
{ ch'\] [ 1 + dup 2 = [ drop over adjoin 0 1 ] when ] }
{ ch'= [ dup 1 = [ [ 1 + ] dip ] when ] }
{ char: \] [ 1 + dup 2 = [ drop over adjoin 0 1 ] when ] }
{ char: = [ dup 1 = [ [ 1 + ] dip ] when ] }
[ 3drop 0 0 ]
} case
] each 0 > [ over adjoin ] [ drop ] if ;
@ -19,7 +19,7 @@ IN: escape-strings
[ nip ] [ drop length ] if ;
: escape-string* ( str n -- str' )
ch'= <repetition>
char: = <repetition>
[ "[" dup surround ] [ "]" dup surround ] bi surround ;
: escape-string ( str -- str' )
@ -32,8 +32,8 @@ IN: escape-strings
[ escape-string ] dip prepend ;
: escape-simplest ( str -- str' )
dup { ch'\' ch'\" ch'\r ch'\n ch'\s } counts {
! { [ dup { ch'\' ch'\r ch'\n ch'\s } values-of sum 0 = ] [ drop "'" prepend ] }
{ [ dup ch'\" of not ] [ drop "\"" "\"" surround ] }
dup { char: \' char: \" char: \r char: \n char: \s } counts {
! { [ dup { char: \' char: \r char: \n char: \s } values-of sum 0 = ] [ drop "'" prepend ] }
{ [ dup char: \" of not ] [ drop "\"" "\"" surround ] }
[ drop escape-string ]
} cond ;

46
basis/farkup/farkup.factor
View File

@ -63,11 +63,11 @@ DEFER: (parse-paragraph)
: delimiter-class ( delimiter -- class )
H{
{ ch'* strong }
{ ch'_ emphasis }
{ ch'^ superscript }
{ ch'~ subscript }
{ ch'% inline-code }
{ char: * strong }
{ char: _ emphasis }
{ char: ^ superscript }
{ char: ~ subscript }
{ char: % inline-code }
} at ;
: or-simple-title ( ... url title/f quot: ( ... title -- ... title' ) -- ... url title' )
@ -82,9 +82,9 @@ DEFER: (parse-paragraph)
] dip [ (parse-paragraph) cons ] [ 1list ] if* ;
: parse-big-link ( before after -- link rest )
dup ?first ch'\[ =
dup ?first char: \[ =
[ parse-link ]
[ [ ch'\[ suffix ] [ (parse-paragraph) ] bi* ]
[ [ char: \[ suffix ] [ (parse-paragraph) ] bi* ]
if ;
: escape ( before after -- before' after' )
@ -94,8 +94,8 @@ DEFER: (parse-paragraph)
[ nil ] [
[ "*_^~%[\\" member? ] find-cut [
{
{ ch'\[ [ parse-big-link ] }
{ ch'\\ [ escape ] }
{ char: \[ [ parse-big-link ] }
{ char: \\ [ escape ] }
[ dup delimiter-class parse-delimiter ]
} case cons
] [ drop "" like 1list ] if*
@ -124,10 +124,10 @@ DEFER: (parse-paragraph)
V{ } clone (take-until) ;
: count= ( string -- n )
dup <reversed> [ [ ch'= = not ] find drop 0 or ] bi@ min ;
dup <reversed> [ [ char: = = not ] find drop 0 or ] bi@ min ;
: trim= ( string -- string' )
[ ch'= = ] trim ;
[ char: = = ] trim ;
: make-heading ( string class -- heading )
[ trim= parse-paragraph ] dip boa ; inline
@ -149,14 +149,14 @@ DEFER: (parse-paragraph)
: coalesce ( rows -- rows' )
V{ } clone [
'[
_ dup ?last ?last ch'\\ =
_ dup ?last ?last char: \\ =
[ [ pop "|" rot 3append ] keep ] when
push
] each
] keep ;
: parse-table ( state -- state' table )
ch'| take-lines [
char: | take-lines [
"|" split
trim-row
coalesce
@ -175,13 +175,13 @@ DEFER: (parse-paragraph)
] dip boa ; inline
: parse-ul ( state -- state' ul )
ch'- unordered-list parse-list ;
char: - unordered-list parse-list ;
: parse-ol ( state -- state' ul )
ch'# ordered-list parse-list ;
char: # ordered-list parse-list ;
: parse-code ( state -- state' item )
dup 1 look ch'\[ =
dup 1 look char: \[ =
[ unclip-slice make-paragraph ] [
dup "{" take-until [
[ nip rest ] dip
@ -192,12 +192,12 @@ DEFER: (parse-paragraph)
: parse-item ( state -- state' item )
dup 0 look {
{ ch'= [ parse-heading ] }
{ ch'| [ parse-table ] }
{ ch'_ [ parse-line ] }
{ ch'- [ parse-ul ] }
{ ch'# [ parse-ol ] }
{ ch'\[ [ parse-code ] }
{ char: = [ parse-heading ] }
{ char: | [ parse-table ] }
{ char: _ [ parse-line ] }
{ char: - [ parse-ul ] }
{ char: # [ parse-ol ] }
{ char: \[ [ parse-code ] }
{ f [ rest-slice f ] }
[ drop unclip-slice make-paragraph ]
} case ;
@ -212,7 +212,7 @@ CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
{ [ dup empty? ] [ drop invalid-url ] }
{ [ dup [ 127 > ] any? ] [ drop invalid-url ] }
{ [ dup first "/\\" member? ] [ drop invalid-url ] }
{ [ ch'\: over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] }
{ [ char: \: over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] }
[ relative-link-prefix get prepend "" like url-encode ]
} cond ;

10
basis/formatting/formatting-tests.factor
View File

@ -62,21 +62,21 @@ IN: formatting.tests
{ "1.00000e-1000" } [ -1000 10^ "%.5e" sprintf ] unit-test
{ t } [
1000 10^ "%.5f" sprintf
"1" ".00000" 1000 ch'0 <string> glue =
"1" ".00000" 1000 char: 0 <string> glue =
] unit-test
{ t } [
-1000 10^ "%.1004f" sprintf
"0." "10000" 999 ch'0 <string> glue =
"0." "10000" 999 char: 0 <string> glue =
] unit-test
{ "-1.00000e+1000" } [ 1000 10^ neg "%.5e" sprintf ] unit-test
{ "-1.00000e-1000" } [ -1000 10^ neg "%.5e" sprintf ] unit-test
{ t } [
1000 10^ neg "%.5f" sprintf
"-1" ".00000" 1000 ch'0 <string> glue =
"-1" ".00000" 1000 char: 0 <string> glue =
] unit-test
{ t } [
-1000 10^ neg "%.1004f" sprintf
"-0." "10000" 999 ch'0 <string> glue =
"-0." "10000" 999 char: 0 <string> glue =
] unit-test
{ "9007199254740991.0" } [ 53 2^ 1 - "%.1f" sprintf ] unit-test
{ "9007199254740992.0" } [ 53 2^ "%.1f" sprintf ] unit-test
@ -121,7 +121,7 @@ IN: formatting.tests
{ "2008-09-10" } [ 2008 9 10 "%04d-%02d-%02d" sprintf ] unit-test
{ "Hello, World!" } [ "Hello, World!" "%s" sprintf ] unit-test
{ "printf test" } [ "printf test" sprintf ] unit-test
{ "char a = 'a'" } [ ch'a "char %c = 'a'" sprintf ] unit-test
{ "char a = 'a'" } [ char: a "char %c = 'a'" sprintf ] unit-test
{ "00" } [ 0x0 "%02x" sprintf ] unit-test
{ "ff" } [ 0xff "%02x" sprintf ] unit-test
{ "0 message(s)" } [ 0 "message" "%d %s(s)" sprintf ] unit-test

28
basis/formatting/formatting.factor
View File

@ -17,12 +17,12 @@ ERROR: unknown-format-directive value ;
[ ] [ compose ] reduce ; inline
: fix-sign ( string -- string )
dup first ch'0 = [
dup [ [ ch'0 = not ] [ digit? ] bi and ] find
dup first char: 0 = [
dup [ [ char: 0 = not ] [ digit? ] bi and ] find
[
1 - swap 2dup nth {
{ ch'- [ remove-nth "-" prepend ] }
{ ch'+ [ remove-nth "+" prepend ] }
{ char: - [ remove-nth "-" prepend ] }
{ char: + [ remove-nth "+" prepend ] }
[ drop nip ]
} case
] [ drop ] if
@ -35,9 +35,9 @@ ERROR: unknown-format-directive value ;
[
[ abs ] dip
[ 10^ * round-to-even >integer number>string ]
[ 1 + ch'0 pad-head ]
[ 1 + char: 0 pad-head ]
[ cut* ] tri [ "." glue ] unless-empty
] keepd neg? [ ch'- prefix ] when ;
] keepd neg? [ char: - prefix ] when ;
: format-scientific-mantissa ( x log10x digits -- string rounded-up? )
[ swap - 10^ * round-to-even >integer number>string ] keep
@ -47,15 +47,15 @@ ERROR: unknown-format-directive value ;
] keep ;
: format-scientific-exponent ( rounded-up? log10x -- string )
swap [ 1 + ] when number>string 2 ch'0 pad-head
dup ch'- swap index "e" "e+" ? prepend ;
swap [ 1 + ] when number>string 2 char: 0 pad-head
dup char: - swap index "e" "e+" ? prepend ;
: format-scientific-simple ( x digits -- string )
[
[ abs dup integer-log10 ] dip
[ format-scientific-mantissa ]
[ drop nip format-scientific-exponent ] 3bi append
] keepd neg? [ ch'- prefix ] when ;
] keepd neg? [ char: - prefix ] when ;
: format-float-fast ( x digits string -- string )
[ "" -1 ] 2dip "C" format-float ;
@ -95,15 +95,15 @@ ERROR: unknown-format-directive value ;
EBNF: parse-printf [=[
zero = "0" => [[ ch'0 ]]
zero = "0" => [[ char: 0 ]]
char = "'" (.) => [[ second ]]
pad-char = (zero|char)? => [[ ch'\s or ]]
pad-char = (zero|char)? => [[ char: \s or ]]
pad-align = ("-")? => [[ \ pad-tail \ pad-head ? ]]
pad-width = ([0-9])* => [[ >digits ]]
pad = pad-align pad-char pad-width => [[ <reversed> >quotation dup first 0 = [ drop [ ] ] when ]]
sign_ = [+ ] => [[ '[ dup first ch'- = [ _ prefix ] unless ] ]]
sign_ = [+ ] => [[ '[ dup first char: - = [ _ prefix ] unless ] ]]
sign = (sign_)? => [[ [ ] or ]]
width_ = "." ([0-9])* => [[ second >digits '[ _ shorted head ] ]]
@ -179,10 +179,10 @@ MACRO: sprintf ( format-string -- quot )
<PRIVATE
: pad-00 ( n -- string )
number>string 2 ch'0 pad-head ; inline
number>string 2 char: 0 pad-head ; inline
: pad-000 ( n -- string )
number>string 3 ch'0 pad-head ; inline
number>string 3 char: 0 pad-head ; inline
: >time ( timestamp -- string )
[ hour>> ] [ minute>> ] [ second>> floor ] tri

4
basis/ftp/client/client.factor
View File

@ -11,7 +11,7 @@ IN: ftp.client
3 head string>number ;
: ftp-response-code ( string -- n/f )
dup fourth ch'- = [ drop f ] [ (ftp-response-code) ] if ;
dup fourth char: - = [ drop f ] [ (ftp-response-code) ] if ;
: read-response-loop ( ftp-response -- ftp-response )
readln
@ -22,7 +22,7 @@ IN: ftp.client
<ftp-response> readln
[ (ftp-response-code) >>n ]
[ add-response-line ]
[ fourth ch'- = ] tri
[ fourth char: - = ] tri
[ read-response-loop ] when ;
ERROR: ftp-error got expected ;

30
basis/ftp/client/listing-parser/listing-parser.factor
View File

@ -6,26 +6,26 @@ IN: ftp.client.listing-parser
: ch>file-type ( ch -- type )
{
{ ch'b [ +block-device+ ] }
{ ch'c [ +character-device+ ] }
{ ch'd [ +directory+ ] }
{ ch'l [ +symbolic-link+ ] }
{ ch's [ +socket+ ] }
{ ch'p [ +fifo+ ] }
{ ch'- [ +regular-file+ ] }
{ char: b [ +block-device+ ] }
{ char: c [ +character-device+ ] }
{ char: d [ +directory+ ] }
{ char: l [ +symbolic-link+ ] }
{ char: s [ +socket+ ] }
{ char: p [ +fifo+ ] }
{ char: - [ +regular-file+ ] }
[ drop +unknown+ ]
} case ;
: file-type>ch ( type -- string )
{
{ +block-device+ [ ch'b ] }
{ +character-device+ [ ch'c ] }
{ +directory+ [ ch'd ] }
{ +symbolic-link+ [ ch'l ] }
{ +socket+ [ ch's ] }
{ +fifo+ [ ch'p ] }
{ +regular-file+ [ ch'- ] }
[ drop ch'- ]
{ +block-device+ [ char: b ] }
{ +character-device+ [ char: c ] }
{ +directory+ [ char: d ] }
{ +symbolic-link+ [ char: l ] }
{ +socket+ [ char: s ] }
{ +fifo+ [ char: p ] }
{ +regular-file+ [ char: - ] }
[ drop char: - ]
} case ;
: parse-permissions ( remote-file str -- remote-file )

2
basis/furnace/auth/providers/couchdb/couchdb.factor
View File

@ -111,7 +111,7 @@ TUPLE: couchdb-auth-provider
url>user ;
: strip-hash ( hash1 -- hash2 )
[ drop first ch'_ = ] assoc-reject ;
[ drop first char: _ = ] assoc-reject ;
: at-or-k ( key hash -- newkey )
dupd at [ nip ] when* ;

2
basis/gobject-introspection/types/types.factor
View File

@ -68,7 +68,7 @@ PREDICATE: fixed-size-array-type < c-array-type fixed-size>> >boolean ;
: qualified-type-name ( data-type -- name )
[ name>> ] keep {
[ name>> ch'. swap member? ]
[ name>> char: . swap member? ]
[ none-type? ]
[ standard-type? ]
} 1|| [ qualified-name ] unless ;

28
basis/help/html/html.factor
View File

@ -15,19 +15,19 @@ IN: help.html
: escape-char ( ch -- )
dup ascii? [
dup H{
{ ch'\" "__quo__" }
{ ch'* "__star__" }
{ ch'\: "__colon__" }
{ ch'< "__lt__" }
{ ch'> "__gt__" }
{ ch'? "__que__" }
{ ch'\\ "__back__" }
{ ch'| "__pipe__" }
{ ch'/ "__slash__" }
{ ch', "__comma__" }
{ ch'@ "__at__" }
{ ch'# "__hash__" }
{ ch'% "__percent__" }
{ char: \" "__quo__" }
{ char: * "__star__" }
{ char: \: "__colon__" }
{ char: < "__lt__" }
{ char: > "__gt__" }
{ char: ? "__que__" }
{ char: \\ "__back__" }
{ char: | "__pipe__" }
{ char: / "__slash__" }
{ char: , "__comma__" }
{ char: @ "__at__" }
{ char: # "__hash__" }
{ char: % "__percent__" }
} at [ % ] [ , ] ?if
] [ number>string "__" "__" surround % ] if ;
@ -87,7 +87,7 @@ M: pathname url-of
]] ;
: bijective-base26 ( n -- name )
[ dup 0 > ] [ 1 - 26 /mod ch'a + ] "" produce-as nip reverse! ;
[ dup 0 > ] [ 1 - 26 /mod char: a + ] "" produce-as nip reverse! ;
: css-class ( style classes -- name )
dup '[ drop _ assoc-size 1 + bijective-base26 ] cache ;

2
basis/help/lint/spaces/spaces.factor
View File

@ -17,7 +17,7 @@ IN: help.lint.spaces
dup utf8 file-lines [ 1 + 2array ] map-index
[
first [
{ [ ch'space = ] [ ch'\" = ] } 1||
{ [ char: space = ] [ char: \" = ] } 1||
] trim-head
" " swap subseq?
] filter

4
basis/help/tutorial/tutorial.factor
View File

@ -142,7 +142,7 @@ $nl
"We begin by writing a word which removes blanks and non-alphabetical characters from a string, and then converts the string to lower case. We call this word " { $snippet "normalize" } ". To figure out how to write this word, we begin with some interactive experimentation in the listener."
$nl
"Start by pushing a character on the stack; notice that characters are really just integers:"
{ $code "ch'a" }
{ $code "char: a" }
$nl
"Now, use the " { $link Letter? } " word to test if it is an alphabetical character, upper or lower case:"
{ $unchecked-example "Letter? ." "t" }
@ -151,7 +151,7 @@ $nl
"This gives the expected result."
$nl
"Now try with a non-alphabetical character:"
{ $code "ch'#" }
{ $code "char: #" }
{ $unchecked-example "Letter? ." "f" }
$nl
"What we want to do is given a string, remove all characters which do not match the " { $link Letter? } " predicate. Let's push a string on the stack:"

2
basis/html/streams/streams-tests.factor
View File

@ -14,7 +14,7 @@ IN: html.streams.tests
] unit-test
{ "a" } [
[ ch'a write1 ] make-html-string
[ char: a write1 ] make-html-string
] unit-test
{ "&lt;" } [

2
basis/html/streams/streams.factor
View File

@ -36,7 +36,7 @@ TUPLE: html-sub-stream < html-writer style parent ;
: hex-color, ( color -- )
[ red>> ] [ green>> ] [ blue>> ] tri
[ 255 * >integer >hex 2 ch'0 pad-head % ] tri@ ;
[ 255 * >integer >hex 2 char: 0 pad-head % ] tri@ ;
: fg-css, ( color -- )
"color: #" % hex-color, "; " % ;

2
basis/html/templates/chloe/chloe-tests.factor
View File

@ -10,7 +10,7 @@ IN: html.templates.chloe.tests
: run-template ( quot -- string )
with-string-writer [ "\r\n\t" member? ] reject
[ ch'\s = ] trim ; inline
[ char: \s = ] trim ; inline
: test-template ( name -- template )
"vocab:html/templates/chloe/test/"

2
basis/html/templates/fhtml/fhtml.factor
View File

@ -16,7 +16,7 @@ TUPLE: template-lexer < lexer ;
M: template-lexer skip-word
[
{
{ [ 2dup nth ch'\" = ] [ drop 1 + ] }
{ [ 2dup nth char: \" = ] [ drop 1 + ] }
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
[ f skip ]
} cond

2
basis/http/parsers/parsers.factor
View File

@ -97,7 +97,7 @@ PEG: parse-response-line ( string -- triple )
[ " \t" member? ] satisfy repeat1 ;
: qdtext-parser ( -- parser )
{ [ ch'\" = ] [ control? ] } except-these ;
{ [ char: \" = ] [ control? ] } except-these ;
: quoted-char-parser ( -- parser )
"\\" token hide any-char 2seq ;

2
basis/io/backend/unix/unix.factor
View File

@ -147,7 +147,7 @@ M: stdin dispose*
] with-destructors ;
: wait-for-stdin ( stdin -- size )
[ control>> ch'X over io:stream-write1 io:stream-flush ]
[ control>> char: X over io:stream-write1 io:stream-flush ]
[ size>> ssize_t heap-size swap io:stream-read ssize_t deref ]
bi ;

6
basis/io/buffers/buffers-tests.factor
View File

@ -44,7 +44,7 @@ io.buffers kernel libc namespaces sequences strings tools.test ;
dup buffer-read-all >string swap dispose
] unit-test
{ ch'e } [
{ char: e } [
"hello" string>buffer
1 over buffer-consume [ buffer-pop ] keep dispose
] unit-test
@ -58,11 +58,11 @@ io.buffers kernel libc namespaces sequences strings tools.test ;
"b" get dispose
"hello world" string>buffer "b" set
{ "hello" ch'\s } [ " " "b" get buffer-read-until [ >string ] dip ] unit-test
{ "hello" char: \s } [ " " "b" get buffer-read-until [ >string ] dip ] unit-test
"b" get dispose
"hello world" string>buffer "b" set
{ "hello worl" ch'd } [ "d" "b" get buffer-read-until [ >string ] dip ] unit-test
{ "hello worl" char: d } [ "d" "b" get buffer-read-until [ >string ] dip ] unit-test
"b" get dispose
"hello world" string>buffer "b" set

6
basis/io/crlf/crlf-tests.factor
View File

@ -15,9 +15,9 @@ USING: io.crlf tools.test io.streams.string io ;
{ "foo\r\nbar" } [ "foo\nbar" lf>crlf ] unit-test
{ f } [ "" [ read1-ignoring-crlf ] with-string-reader ] unit-test
{ ch'a } [ "a" [ read1-ignoring-crlf ] with-string-reader ] unit-test
{ ch'b } [ "\nb" [ read1-ignoring-crlf ] with-string-reader ] unit-test
{ ch'c } [ "\r\nc" [ read1-ignoring-crlf ] with-string-reader ] unit-test
{ char: a } [ "a" [ read1-ignoring-crlf ] with-string-reader ] unit-test
{ char: b } [ "\nb" [ read1-ignoring-crlf ] with-string-reader ] unit-test
{ char: c } [ "\r\nc" [ read1-ignoring-crlf ] with-string-reader ] unit-test
{ f } [ "" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test
{ "a" } [ "a" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test

6
basis/io/crlf/crlf.factor
View File

@ -9,7 +9,7 @@ IN: io.crlf
:: stream-read-crlf ( stream -- seq )
"\r" stream stream-read-until [
ch'\r assert= stream stream-read1 ch'\n assert=
char: \r assert= stream stream-read1 char: \n assert=
] [ f like ] if* ;
: read-crlf ( -- seq )
@ -17,14 +17,14 @@ IN: io.crlf
:: stream-read-?crlf ( stream -- seq )
"\r\n" stream stream-read-until [
ch'\r = [ stream stream-read1 ch'\n assert= ] when
char: \r = [ stream stream-read1 char: \n assert= ] when
] [ f like ] if* ;
: read-?crlf ( -- seq )
input-stream get stream-read-?crlf ;
: crlf>lf ( str -- str' )
ch'\r swap remove ;
char: \r swap remove ;
: lf>crlf ( str -- str' )
"\n" split "\r\n" join ;

4
basis/io/encodings/8-bit/8-bit-tests.factor
View File

@ -1,10 +1,10 @@
USING: arrays io.encodings.8-bit io.encodings.string strings
tools.test ;
{ B{ ch'f ch'o ch'o } } [ "foo" latin2 encode ] unit-test
{ B{ char: f char: o char: o } } [ "foo" latin2 encode ] unit-test
[ { 256 } >string latin2 encode ] must-fail
{ "bar" } [ "bar" latin2 decode ] unit-test
{ { ch'b 233 ch'r } } [ B{ ch'b 233 ch'r } latin2 decode >array ] unit-test
{ { char: b 233 char: r } } [ B{ char: b 233 char: r } latin2 decode >array ] unit-test
{ { 0xfffd 0x20AC } } [ B{ 0x81 0x80 } windows-1252 decode >array ] unit-test

2
basis/io/encodings/euc/euc-tests.factor
View File

@ -47,4 +47,4 @@ IN: io.encodings.euc.tests
{ t } [ phrase-euc-kr 3 head* euc-kr decode phrase-unicode 2 head* = ] unit-test
{ t } [ phrase-euc-kr 2 head* euc-kr decode phrase-unicode 2 head* ch'replacement-character suffix = ] unit-test
{ t } [ phrase-euc-kr 2 head* euc-kr decode phrase-unicode 2 head* char: replacement-character suffix = ] unit-test

8
basis/io/encodings/gb18030/gb18030-tests.factor
View File

@ -8,15 +8,15 @@ USING: io.encodings.gb18030 io.encodings.string strings tools.test arrays ;
[ B{ 0xB7 0xB8 } >string gb18030 encode ] unit-test
{ { 0xB7 0xB8 } }
[ B{ 0xA1 0xA4 0x81 0x30 0x86 0x30 } gb18030 decode >array ] unit-test
{ { 0xB7 ch'replacement-character } }
{ { 0xB7 char: replacement-character } }
[ B{ 0xA1 0xA4 0x81 0x30 0x86 } gb18030 decode >array ] unit-test
{ { 0xB7 ch'replacement-character } }
{ { 0xB7 char: replacement-character } }
[ B{ 0xA1 0xA4 0x81 0x30 } gb18030 decode >array ] unit-test
{ { 0xB7 ch'replacement-character } }
{ { 0xB7 char: replacement-character } }
[ B{ 0xA1 0xA4 0x81 } gb18030 decode >array ] unit-test
{ { 0xB7 } }
[ B{ 0xA1 0xA4 } gb18030 decode >array ] unit-test
{ { ch'replacement-character } }
{ { char: replacement-character } }
[ B{ 0xA1 } >string gb18030 decode >array ] unit-test
{ { 0x44D7 0x464B } }
[ B{ 0x82 0x33 0xA3 0x39 0x82 0x33 0xC9 0x31 }

44
basis/io/encodings/iso2022/iso2022-tests.factor
View File

@ -7,30 +7,30 @@ strings tools.test ;
{ "hello" } [ "hello" >byte-array iso2022 decode ] unit-test
{ "hello" } [ "hello" iso2022 encode >string ] unit-test
{ "hi" } [ B{ ch'h $ ESC ch'\( ch'B ch'i } iso2022 decode ] unit-test
{ "hi" } [ B{ ch'h ch'i $ ESC ch'\( ch'B } iso2022 decode ] unit-test
{ "hi\u00fffd" } [ B{ ch'h ch'i $ ESC ch'\( } iso2022 decode ] unit-test
{ "hi\u00fffd" } [ B{ ch'h ch'i $ ESC } iso2022 decode ] unit-test
{ "hi" } [ B{ char: h $ ESC char: \( char: B char: i } iso2022 decode ] unit-test
{ "hi" } [ B{ char: h char: i $ ESC char: \( char: B } iso2022 decode ] unit-test
{ "hi\u00fffd" } [ B{ char: h char: i $ ESC char: \( } iso2022 decode ] unit-test
{ "hi\u00fffd" } [ B{ char: h char: i $ ESC } iso2022 decode ] unit-test
{ B{ ch'h $ ESC ch'\( ch'J 0xD8 } } [ "h\u00ff98" iso2022 encode ] unit-test
{ "h\u00ff98" } [ B{ ch'h $ ESC ch'\( ch'J 0xD8 } iso2022 decode ] unit-test
{ "hi" } [ B{ ch'h $ ESC ch'\( ch'J ch'i } iso2022 decode ] unit-test
{ "h" } [ B{ ch'h $ ESC ch'\( ch'J } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ ch'h $ ESC ch'\( ch'J 0x80 } iso2022 decode ] unit-test
{ B{ char: h $ ESC char: \( char: J 0xD8 } } [ "h\u00ff98" iso2022 encode ] unit-test
{ "h\u00ff98" } [ B{ char: h $ ESC char: \( char: J 0xD8 } iso2022 decode ] unit-test
{ "hi" } [ B{ char: h $ ESC char: \( char: J char: i } iso2022 decode ] unit-test
{ "h" } [ B{ char: h $ ESC char: \( char: J } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ char: h $ ESC char: \( char: J 0x80 } iso2022 decode ] unit-test
{ B{ ch'h $ ESC ch'$ ch'B 0x3E 0x47 } } [ "h\u007126" iso2022 encode ] unit-test
{ "h\u007126" } [ B{ ch'h $ ESC ch'$ ch'B 0x3E 0x47 } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ ch'h $ ESC ch'$ ch'B 0x3E } iso2022 decode ] unit-test
{ "h" } [ B{ ch'h $ ESC ch'$ ch'B } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ ch'h $ ESC ch'$ } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ ch'h $ ESC } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ ch'h $ ESC ch'$ ch'B 0x80 0x80 } iso2022 decode ] unit-test
{ B{ char: h $ ESC char: $ char: B 0x3E 0x47 } } [ "h\u007126" iso2022 encode ] unit-test
{ "h\u007126" } [ B{ char: h $ ESC char: $ char: B 0x3E 0x47 } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ char: h $ ESC char: $ char: B 0x3E } iso2022 decode ] unit-test
{ "h" } [ B{ char: h $ ESC char: $ char: B } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ char: h $ ESC char: $ } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ char: h $ ESC } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ char: h $ ESC char: $ char: B 0x80 0x80 } iso2022 decode ] unit-test
{ B{ ch'h $ ESC ch'$ ch'\( ch'D 0x38 0x54 } } [ "h\u0058ce" iso2022 encode ] unit-test
{ "h\u0058ce" } [ B{ ch'h $ ESC ch'$ ch'\( ch'D 0x38 0x54 } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ ch'h $ ESC ch'$ ch'\( ch'D 0x38 } iso2022 decode ] unit-test
{ "h" } [ B{ ch'h $ ESC ch'$ ch'\( ch'D } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ ch'h $ ESC ch'$ ch'\( } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ ch'h $ ESC ch'$ ch'\( ch'D 0x70 0x70 } iso2022 decode ] unit-test
{ B{ char: h $ ESC char: $ char: \( char: D 0x38 0x54 } } [ "h\u0058ce" iso2022 encode ] unit-test
{ "h\u0058ce" } [ B{ char: h $ ESC char: $ char: \( char: D 0x38 0x54 } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ char: h $ ESC char: $ char: \( char: D 0x38 } iso2022 decode ] unit-test
{ "h" } [ B{ char: h $ ESC char: $ char: \( char: D } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ char: h $ ESC char: $ char: \( } iso2022 decode ] unit-test
{ "h\u00fffd" } [ B{ char: h $ ESC char: $ char: \( char: D 0x70 0x70 } iso2022 decode ] unit-test
[ "\u{syriac-music}" iso2022 encode ] must-fail

24
basis/io/encodings/iso2022/iso2022.factor
View File

@ -33,10 +33,10 @@ M: iso2022 <decoder>
CONSTANT: ESC 0x16
CONSTANT: switch-ascii B{ $ ESC ch'\( ch'B }
CONSTANT: switch-jis201 B{ $ ESC ch'\( ch'J }
CONSTANT: switch-jis208 B{ $ ESC ch'$ ch'B }
CONSTANT: switch-jis212 B{ $ ESC ch'$ ch'\( ch'D }
CONSTANT: switch-ascii B{ $ ESC char: \( char: B }
CONSTANT: switch-jis201 B{ $ ESC char: \( char: J }
CONSTANT: switch-jis208 B{ $ ESC char: $ char: B }
CONSTANT: switch-jis212 B{ $ ESC char: $ char: \( char: D }
: find-type ( char -- code type )
{
@ -62,19 +62,19 @@ M:: iso2022-state encode-char ( char stream encoding -- )
: read-escape ( stream -- type/f )
dup stream-read1 {
{ ch'\( [
{ char: \( [
stream-read1 {
{ ch'B [ ascii get-global ] }
{ ch'J [ jis201 get-global ] }
{ char: B [ ascii get-global ] }
{ char: J [ jis201 get-global ] }
[ drop f ]
} case
] }
{ ch'$ [
{ char: $ [
dup stream-read1 {
{ ch'@ [ drop jis208 get-global ] } ! want: JIS X 0208-1978
{ ch'B [ drop jis208 get-global ] }
{ ch'\( [
stream-read1 ch'D = jis212 get-global f ?
{ char: @ [ drop jis208 get-global ] } ! want: JIS X 0208-1978
{ char: B [ drop jis208 get-global ] }
{ char: \( [
stream-read1 char: D = jis212 get-global f ?
] }
[ 2drop f ]
} case

6
basis/io/encodings/latin1/latin1-tests.factor
View File

@ -1,7 +1,7 @@
USING: arrays io.encodings.latin1 io.encodings.string strings
tools.test ;
{ B{ ch'f ch'o ch'o } } [ "foo" latin1 encode ] unit-test
{ B{ char: f char: o char: o } } [ "foo" latin1 encode ] unit-test
[ { 256 } >string latin1 encode ] must-fail
@ -9,6 +9,6 @@ tools.test ;
{ "bar" } [ "bar" latin1 decode ] unit-test
{ { ch'b 233 ch'r } } [
B{ ch'b 233 ch'r } latin1 decode >array
{ { char: b 233 char: r } } [
B{ char: b 233 char: r } latin1 decode >array
] unit-test

20
basis/io/encodings/shift-jis/shift-jis-tests.factor
View File

@ -3,15 +3,15 @@
USING: arrays io.encodings.shift-jis io.encodings.string strings
tools.test ;
{ { ch'replacement-character } } [ { 141 } shift-jis decode >array ] unit-test
{ { char: replacement-character } } [ { 141 } shift-jis decode >array ] unit-test
{ "" } [ "" shift-jis decode >string ] unit-test
{ "" } [ "" shift-jis encode >string ] unit-test
[ { ch'replacement-character } shift-jis encode ] must-fail
{ "ab¥ｨ" } [ { ch'a ch'b 0x5C 0xA8 } shift-jis decode ] unit-test
{ { ch'a ch'b 0x5C 0xA8 } } [ "ab¥ｨ" shift-jis encode >array ] unit-test
{ "ab\\ｨ" } [ { ch'a ch'b 0x5C 0xA8 } windows-31j decode ] unit-test
{ { ch'a ch'b 0x5C 0xA8 } } [ "ab\\ｨ" windows-31j encode >array ] unit-test
{ "\u000081\u0000c8" } [ ch'logical-and 1string windows-31j encode >string ] unit-test
{ "\u000081\u0000c8" } [ ch'logical-and 1string shift-jis encode >string ] unit-test
{ { ch'logical-and } } [ "\u000081\u0000c8" windows-31j decode >array ] unit-test
{ { ch'logical-and } } [ "\u000081\u0000c8" shift-jis decode >array ] unit-test
[ { char: replacement-character } shift-jis encode ] must-fail
{ "ab¥ｨ" } [ { char: a char: b 0x5C 0xA8 } shift-jis decode ] unit-test
{ { char: a char: b 0x5C 0xA8 } } [ "ab¥ｨ" shift-jis encode >array ] unit-test
{ "ab\\ｨ" } [ { char: a char: b 0x5C 0xA8 } windows-31j decode ] unit-test
{ { char: a char: b 0x5C 0xA8 } } [ "ab\\ｨ" windows-31j encode >array ] unit-test
{ "\u000081\u0000c8" } [ char: logical-and 1string windows-31j encode >string ] unit-test
{ "\u000081\u0000c8" } [ char: logical-and 1string shift-jis encode >string ] unit-test
{ { char: logical-and } } [ "\u000081\u0000c8" windows-31j decode >array ] unit-test
{ { char: logical-and } } [ "\u000081\u0000c8" shift-jis decode >array ] unit-test

26
basis/io/encodings/utf32/utf32-tests.factor
View File

@ -4,25 +4,25 @@ USING: kernel tools.test io.encodings.utf32 arrays sbufs
io.streams.byte-array sequences io.encodings io strings
io.encodings.string alien.c-types alien.strings accessors classes ;
{ { ch'x } } [ B{ 0 0 0 ch'x } utf32be decode >array ] unit-test
{ { char: x } } [ B{ 0 0 0 char: x } utf32be decode >array ] unit-test
{ { 0x1D11E } } [ B{ 0 1 0xD1 0x1E } utf32be decode >array ] unit-test
{ { ch'replacement-character } } [ B{ 0 1 0xD1 } utf32be decode >array ] unit-test
{ { ch'replacement-character } } [ B{ 0 1 } utf32be decode >array ] unit-test
{ { ch'replacement-character } } [ B{ 0 } utf32be decode >array ] unit-test
{ { char: replacement-character } } [ B{ 0 1 0xD1 } utf32be decode >array ] unit-test
{ { char: replacement-character } } [ B{ 0 1 } utf32be decode >array ] unit-test
{ { char: replacement-character } } [ B{ 0 } utf32be decode >array ] unit-test
{ { } } [ { } utf32be decode >array ] unit-test
{ B{ 0 0 0 ch'x 0 1 0xD1 0x1E } } [ { ch'x 0x1d11e } >string utf32be encode ] unit-test
{ B{ 0 0 0 char: x 0 1 0xD1 0x1E } } [ { char: x 0x1d11e } >string utf32be encode ] unit-test
{ { ch'x } } [ B{ ch'x 0 0 0 } utf32le decode >array ] unit-test
{ { char: x } } [ B{ char: x 0 0 0 } utf32le decode >array ] unit-test
{ { 0x1d11e } } [ B{ 0x1e 0xd1 1 0 } utf32le decode >array ] unit-test
{ { ch'replacement-character } } [ B{ 0x1e 0xd1 1 } utf32le decode >array ] unit-test
{ { ch'replacement-character } } [ B{ 0x1e 0xd1 } utf32le decode >array ] unit-test
{ { ch'replacement-character } } [ B{ 0x1e } utf32le decode >array ] unit-test
{ { char: replacement-character } } [ B{ 0x1e 0xd1 1 } utf32le decode >array ] unit-test
{ { char: replacement-character } } [ B{ 0x1e 0xd1 } utf32le decode >array ] unit-test
{ { char: replacement-character } } [ B{ 0x1e } utf32le decode >array ] unit-test
{ { } } [ { } utf32le decode >array ] unit-test
{ B{ 120 0 0 0 0x1e 0xd1 1 0 } } [ { ch'x 0x1d11e } >string utf32le encode ] unit-test
{ B{ 120 0 0 0 0x1e 0xd1 1 0 } } [ { char: x 0x1d11e } >string utf32le encode ] unit-test
{ { ch'x } } [ B{ 0xff 0xfe 0 0 ch'x 0 0 0 } utf32 decode >array ] unit-test
{ { ch'x } } [ B{ 0 0 0xfe 0xff 0 0 0 ch'x } utf32 decode >array ] unit-test
{ { char: x } } [ B{ 0xff 0xfe 0 0 char: x 0 0 0 } utf32 decode >array ] unit-test
{ { char: x } } [ B{ 0 0 0xfe 0xff 0 0 0 char: x } utf32 decode >array ] unit-test
{ B{ 0xff 0xfe 0 0 120 0 0 0 0x1e 0xd1 1 0 } } [ { ch'x 0x1d11e } >string utf32 encode ] unit-test
{ B{ 0xff 0xfe 0 0 120 0 0 0 0x1e 0xd1 1 0 } } [ { char: x 0x1d11e } >string utf32 encode ] unit-test

10
basis/io/encodings/utf7/utf7.factor
View File

@ -13,20 +13,20 @@ TUPLE: utf7codec dialect buffer ;
: utf7 ( -- utf7codec )
{
{ { } { } }
{ { ch'+ } { ch'- } }
{ { char: + } { char: - } }
} V{ } utf7codec boa ;
: utf7imap4 ( -- utf7codec )
{
{ { ch'/ } { ch', } }
{ { ch'& } { ch'- } }
{ { char: / } { char: , } }
{ { char: & } { char: - } }
} V{ } utf7codec boa ;
: >raw-base64 ( bytes -- bytes' )
>string utf16be encode >base64 [ ch'= = ] trim-tail ;
>string utf16be encode >base64 [ char: = = ] trim-tail ;
: raw-base64> ( str -- str' )
dup length 4 / ceiling 4 * ch'= pad-tail base64> utf16be decode ;
dup length 4 / ceiling 4 * char: = pad-tail base64> utf16be decode ;
: encode-chunk ( repl-pair surround-pair chunk ascii? -- bytes )
[ swap [ first ] [ concat ] bi replace nip ]

2
basis/io/files/info/unix/linux/linux.factor
View File

@ -65,7 +65,7 @@ frequency pass-number ;
} cleave ;
: parse-mtab ( -- array )
ch'\s [ "/etc/mtab" utf8 file>csv ] with-delimiter
char: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
[ mtab-csv>mtab-entry ] map ;
: mtab-entry>file-system-info ( mtab-entry -- file-system-info/f )

30
basis/io/files/info/unix/unix.factor
View File

@ -242,26 +242,26 @@ M: string set-file-group ( path string -- )
: ch>file-type ( ch -- type )
{
{ ch'b [ +block-device+ ] }
{ ch'c [ +character-device+ ] }
{ ch'd [ +directory+ ] }
{ ch'l [ +symbolic-link+ ] }
{ ch's [ +socket+ ] }
{ ch'p [ +fifo+ ] }
{ ch'- [ +regular-file+ ] }
{ char: b [ +block-device+ ] }
{ char: c [ +character-device+ ] }
{ char: d [ +directory+ ] }
{ char: l [ +symbolic-link+ ] }
{ char: s [ +socket+ ] }
{ char: p [ +fifo+ ] }
{ char: - [ +regular-file+ ] }
[ drop +unknown+ ]
} case ;
: file-type>ch ( type -- ch )
{
{ +block-device+ [ ch'b ] }
{ +character-device+ [ ch'c ] }
{ +directory+ [ ch'd ] }
{ +symbolic-link+ [ ch'l ] }
{ +socket+ [ ch's ] }
{ +fifo+ [ ch'p ] }
{ +regular-file+ [ ch'- ] }
[ drop ch'- ]
{ +block-device+ [ char: b ] }
{ +character-device+ [ char: c ] }
{ +directory+ [ char: d ] }
{ +symbolic-link+ [ char: l ] }
{ +socket+ [ char: s ] }
{ +fifo+ [ char: p ] }
{ +regular-file+ [ char: - ] }
[ drop char: - ]
} case ;
<PRIVATE

2
basis/io/files/info/windows/windows.factor
View File

@ -147,7 +147,7 @@ ERROR: not-absolute-path ;
unicode-prefix ?head drop
dup {
[ length 2 >= ]
[ second ch'\: = ]
[ second char: \: = ]
[ first Letter? ]
} 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;

2
basis/io/files/unique/unique-tests.factor
View File

@ -6,7 +6,7 @@ namespaces sequences strings tools.test ;
{ 123 } [
[
"core" ".test" [
[ [ 123 ch'a <string> ] dip ascii set-file-contents ]
[ [ 123 char: a <string> ] dip ascii set-file-contents ]
[ file-info size>> ] bi
] cleanup-unique-file
] with-temp-directory

2
basis/io/files/windows/windows.factor
View File

@ -320,7 +320,7 @@ M: windows root-directory? ( path -- ? )
{ [ dup empty? ] [ drop f ] }
{ [ dup [ path-separator? ] all? ] [ drop t ] }
{ [ dup trim-tail-separators { [ length 2 = ]
[ second ch'\: = ] } 1&& ] [ drop t ] }
[ second char: \: = ] } 1&& ] [ drop t ] }
{ [ dup unicode-prefix head? ]
[ trim-tail-separators length unicode-prefix length 2 + = ] }
[ drop f ]

10
basis/io/launcher/windows/windows.factor
View File

@ -57,17 +57,17 @@ TUPLE: CreateProcess-args
: fix-trailing-backslashes ( str -- str' )
0 count-trailing-backslashes
2 * ch'\\ <repetition> append ;
2 * char: \\ <repetition> append ;
! Find groups of \, groups of \ followed by ", or naked "
: escape-double-quote ( str -- newstr )
[
{ [ drop ch'\\ = ] [ nip "\\\"" member? ] } 2&&
{ [ drop char: \\ = ] [ nip "\\\"" member? ] } 2&&
] monotonic-split [
dup last ch'\" = [
dup last char: \" = [
dup length 1 > [
! String of backslashes + double-quote
length 1 - 2 * ch'\\ <repetition> "\\\"" append
length 1 - 2 * char: \\ <repetition> "\\\"" append
] [
! Single double-quote
drop "\\\""
@ -81,7 +81,7 @@ TUPLE: CreateProcess-args
! See http://msdn.microsoft.com/en-us/library/ms647232.aspx
: escape-argument ( str -- newstr )
escape-double-quote
ch'\s over member? [
char: \s over member? [
fix-trailing-backslashes "\"" dup surround
] when ;

2
basis/io/mmap/mmap-tests.factor
View File

@ -6,7 +6,7 @@ SPECIALIZED-ARRAY: uint
|[ path |
"12345" path ascii set-file-contents
{ } [ path [ char <mapped-array> ch'2 0 pick set-nth drop ] with-mapped-file ] unit-test
{ } [ path [ char <mapped-array> char: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
{ 5 } [ path [ char <mapped-array> length ] with-mapped-file ] unit-test
{ 5 } [ path [ char <mapped-array> length ] with-mapped-file-reader ] unit-test
{ "22345" } [ path ascii file-contents ] unit-test

2
basis/io/sockets/secure/openssl/openssl.factor
View File

@ -361,7 +361,7 @@ M: ssl-handle dispose*
"*." ?head [
{
[ tail? ]
[ [ [ ch'. = ] count ] bi@ - 1 <= ]
[ [ [ char: . = ] count ] bi@ - 1 <= ]
} 2&&
] [
=

6
basis/io/streams/limited/limited-tests.factor
View File

@ -11,7 +11,7 @@ namespaces strings tools.test ;
{ } [ "data" get 24 <limited-stream> "limited" set ] unit-test
{ ch'h } [ "limited" get stream-read1 ] unit-test
{ char: h } [ "limited" get stream-read1 ] unit-test
{ } [ "limited" get ascii <decoder> "decoded" set ] unit-test
@ -30,13 +30,13 @@ namespaces strings tools.test ;
{ } [ "data" get 4 <limited-stream> "limited" set ] unit-test
{ "abc" ch'\n }
{ "abc" char: \n }
[ "\n" "limited" get stream-read-until [ >string ] dip ] unit-test
{ "" f } [ "\n" "limited" get stream-read-until [ >string ] dip ] unit-test
{ ch'a }
{ char: a }
[ "a" <string-reader> 1 <limited-stream> stream-read1 ] unit-test
{ "abc" }

2
basis/io/streams/throwing/throwing-tests.factor
View File

@ -51,7 +51,7 @@ io.streams.throwing kernel namespaces tools.test ;
] with-byte-reader
] [ stream-exhausted? ] must-fail-with
{ "asd" ch'f } [
{ "asd" char: f } [
"asdf" [ [ "f" read-until ] throw-on-eof ] with-string-reader
] unit-test

2
basis/ip-parser/ip-parser.factor
View File

@ -62,7 +62,7 @@ ERROR: more-than-8-components ;
dup hex> [ ] [ bad-ipv6-component ] ?if ;
: split-ipv6 ( string -- seq )
":" split ch'. over last member? [ unclip-last ] [ f ] if
":" split char: . over last member? [ unclip-last ] [ f ] if
[ [ ipv6-component ] map ]
[ [ parse-ipv4 append ] unless-empty ] bi* ;

2
basis/json/prettyprint/prettyprint.factor
View File

@ -14,7 +14,7 @@ GENERIC: pprint-json* ( obj -- )
: write-spaces ( -- )
indent-level get 0 > [
indent-level get nspaces *
ch'\s
char: \s
<string> write
] when ;

50
basis/json/reader/reader.factor
View File

@ -44,25 +44,25 @@ DEFER: (read-json-string)
: (read-json-escape) ( stream accum -- accum )
{ sbuf } declare
over stream-read1 {
{ ch'\" [ ch'\" ] }
{ ch'\\ [ ch'\\ ] }
{ ch'/ [ ch'/ ] }
{ ch'b [ ch'\b ] }
{ ch'f [ ch'\f ] }
{ ch'n [ ch'\n ] }
{ ch'r [ ch'\r ] }
{ ch't [ ch'\t ] }
{ ch'u [ over read-json-escape-unicode ] }
{ char: \" [ char: \" ] }
{ char: \\ [ char: \\ ] }
{ char: / [ char: / ] }
{ char: b [ char: \b ] }
{ char: f [ char: \f ] }
{ char: n [ char: \n ] }
{ char: r [ char: \r ] }
{ char: t [ char: \t ] }
{ char: u [ over read-json-escape-unicode ] }
[ ]
} case [ suffix! (read-json-string) ] [ json-error ] if* ;
: (read-json-string) ( stream accum -- accum )
{ sbuf } declare
"\\\"" pick stream-read-until [ append! ] dip
ch'\" = [ nip ] [ (read-json-escape) ] if ;
char: \" = [ nip ] [ (read-json-escape) ] if ;
: read-json-string ( stream -- str )
"\\\"" over stream-read-until ch'\" =
"\\\"" over stream-read-until char: \" =
[ nip ] [ >sbuf (read-json-escape) { sbuf } declare "" like ] if ;
: second-last-unsafe ( seq -- second-last )
@ -108,20 +108,20 @@ DEFER: (read-json-string)
! 2dup 1string swap . . ! Great for debug...
{ object vector object } declare
{
{ ch'\" [ over read-json-string suffix! ] }
{ ch'\[ [ json-open-array ] }
{ ch', [ v-over-push ] }
{ ch'\] [ json-close-array ] }
{ ch'\{ [ json-open-hash ] }
{ ch'\: [ v-pick-push ] }
{ ch'\} [ json-close-hash ] }
{ ch'\s [ ] }
{ ch'\t [ ] }
{ ch'\r [ ] }
{ ch'\n [ ] }
{ ch't [ "rue" pick json-expect t suffix! ] }
{ ch'f [ "alse" pick json-expect f suffix! ] }
{ ch'n [ "ull" pick json-expect json-null suffix! ] }
{ char: \" [ over read-json-string suffix! ] }
{ char: \[ [ json-open-array ] }
{ char: , [ v-over-push ] }
{ char: \] [ json-close-array ] }
{ char: \{ [ json-open-hash ] }
{ char: \: [ v-pick-push ] }
{ char: \} [ json-close-hash ] }
{ char: \s [ ] }
{ char: \t [ ] }
{ char: \r [ ] }
{ char: \n [ ] }
{ char: t [ "rue" pick json-expect t suffix! ] }
{ char: f [ "alse" pick json-expect f suffix! ] }
{ char: n [ "ull" pick json-expect json-null suffix! ] }
[ pick json-number [ suffix! ] dip [ scan ] when* ]
} case ;

36
basis/json/writer/writer.factor
View File

@ -59,20 +59,20 @@ M: json-null stream-json-print
PRIVATE>
M: string stream-json-print
ch'\" over stream-write1 swap [
char: \" over stream-write1 swap [
{
{ ch'\" [ "\\\"" over stream-write ] }
{ ch'\\ [ "\\\\" over stream-write ] }
{ ch'/ [
{ char: \" [ "\\\"" over stream-write ] }
{ char: \\ [ "\\\\" over stream-write ] }
{ char: / [
json-escape-slashes? get
[ "\\/" over stream-write ]
[ ch'/ over stream-write1 ] if
[ char: / over stream-write1 ] if
] }
{ ch'\b [ "\\b" over stream-write ] }
{ ch'\f [ "\\f" over stream-write ] }
{ ch'\n [ "\\n" over stream-write ] }
{ ch'\r [ "\\r" over stream-write ] }
{ ch'\t [ "\\t" over stream-write ] }
{ char: \b [ "\\b" over stream-write ] }
{ char: \f [ "\\f" over stream-write ] }
{ char: \n [ "\\n" over stream-write ] }
{ char: \r [ "\\r" over stream-write ] }
{ char: \t [ "\\t" over stream-write ] }
{ 0x2028 [ "\\u2028" over stream-write ] }
{ 0x2029 [ "\\u2029" over stream-write ] }
[
@ -87,7 +87,7 @@ M: string stream-json-print
] if
]
} case
] each ch'\" swap stream-write1 ;
] each char: \" swap stream-write1 ;
M: integer stream-json-print
[ number>string ] [ stream-write ] bi* ;
@ -111,10 +111,10 @@ M: real stream-json-print
[ >float number>string ] [ stream-write ] bi* ;
M: sequence stream-json-print
ch'\[ over stream-write1 swap
over '[ ch', _ stream-write1 ]
char: \[ over stream-write1 swap
over '[ char: , _ stream-write1 ]
pick '[ _ stream-json-print ] interleave
ch'\] swap stream-write1 ;
char: \] swap stream-write1 ;
<PRIVATE
@ -130,8 +130,8 @@ M: float json-coerce float>json ;
M: real json-coerce >float number>string ;
:: json-print-assoc ( obj stream -- )
ch'\{ stream stream-write1 obj >alist
[ ch', stream stream-write1 ]
char: \{ stream stream-write1 obj >alist
[ char: , stream stream-write1 ]
json-friendly-keys? get
json-coerce-keys? get '[
first2 [
@ -140,11 +140,11 @@ M: real json-coerce >float number>string ;
[ _ [ json-coerce ] when ] if
stream stream-json-print
] [
ch'\: stream stream-write1
char: \: stream stream-write1
stream stream-json-print
] bi*
] interleave
ch'\} stream stream-write1 ;
char: \} stream stream-write1 ;
PRIVATE>

2
basis/lcs/diff2html/diff2html.factor
View File

@ -7,7 +7,7 @@ IN: lcs.diff2html
GENERIC: diff-line ( obj -- xml )
: item-string ( item -- string )
item>> [ ch'no-break-space 1string ] when-empty ;
item>> [ char: no-break-space 1string ] when-empty ;
M: retain diff-line
item-string

16
basis/lcs/lcs-tests.factor
View File

@ -14,12 +14,12 @@ USING: tools.test lcs ;
{ "abd" } [ "faxbcd" "abdef" lcs ] unit-test
{ {
T{ delete f ch'f }
T{ retain f ch'a }
T{ delete f ch'x }
T{ retain f ch'b }
T{ delete f ch'c }
T{ retain f ch'd }
T{ insert f ch'e }
T{ insert f ch'f }
T{ delete f char: f }
T{ retain f char: a }
T{ delete f char: x }
T{ retain f char: b }
T{ delete f char: c }
T{ retain f char: d }
T{ insert f char: e }
T{ insert f char: f }
} } [ "faxbcd" "abdef" lcs-diff ] unit-test

2
basis/listener/listener.factor
View File

@ -119,7 +119,7 @@ t error-summary? set-global
: datastack. ( datastack -- )
display-stacks? get [
! [ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
[ nl "data-stack" over length ch'\: <string> append title. trimmed-stack. ] unless-empty
[ nl "data-stack" over length char: \: <string> append title. trimmed-stack. ] unless-empty
] [ drop ] if ;
:: listener-step ( datastack -- datastack' )

2
basis/logging/server/server.factor
View File

@ -38,7 +38,7 @@ SYMBOL: log-files
: timestamp-header. ( -- )
"[" write now (timestamp>rfc3339) "] " write ;
: multiline-header ( -- str ) 20 ch'- <string> ; foldable
: multiline-header ( -- str ) 20 char: - <string> ; foldable
: multiline-header. ( -- )
"[" write multiline-header write "] " write ;

2
basis/mime/multipart/multipart-tests.factor
View File

@ -71,7 +71,7 @@ SYMBOL: mime-test-server
mime-test-server get insecure>> ;
: a-stream ( n -- stream )
ch'a <string> <string-reader> ;
char: a <string> <string-reader> ;
{ } [
[

90
basis/pack/pack.factor
View File

@ -33,64 +33,64 @@ M: object >n-byte-array ( n string -- byte-array ) heap-size >n-byte-array ;
: expand-pack-format ( str -- str' )
f swap [
dup digit?
[ [ 0 or 10 * ] [ ch'0 - ] bi* + f ]
[ [ 0 or 10 * ] [ char: 0 - ] bi* + f ]
[ [ 1 or ] [ <string> ] bi* f swap ] if
] { } map-as "" concat-as nip ; foldable
CONSTANT: pack-table
H{
{ ch'c s8>byte-array }
{ ch'C u8>byte-array }
{ ch's s16>byte-array }
{ ch'S u16>byte-array }
{ ch't s24>byte-array }
{ ch'T u24>byte-array }
{ ch'i s32>byte-array }
{ ch'I u32>byte-array }
{ ch'q s64>byte-array }
{ ch'Q u64>byte-array }
{ ch'f write-float }
{ ch'F write-float }
{ ch'd write-double }
{ ch'D write-double }
{ ch'a write-c-string }
{ char: c s8>byte-array }
{ char: C u8>byte-array }
{ char: s s16>byte-array }
{ char: S u16>byte-array }
{ char: t s24>byte-array }
{ char: T u24>byte-array }
{ char: i s32>byte-array }
{ char: I u32>byte-array }
{ char: q s64>byte-array }
{ char: Q u64>byte-array }
{ char: f write-float }
{ char: F write-float }
{ char: d write-double }
{ char: D write-double }
{ char: a write-c-string }
}
CONSTANT: unpack-table
H{
{ ch'c [ 8 signed-endian> ] }
{ ch'C [ unsigned-endian> ] }
{ ch's [ 16 signed-endian> ] }
{ ch'S [ unsigned-endian> ] }
{ ch't [ 24 signed-endian> ] }
{ ch'T [ unsigned-endian> ] }
{ ch'i [ 32 signed-endian> ] }
{ ch'I [ unsigned-endian> ] }
{ ch'q [ 64 signed-endian> ] }
{ ch'Q [ unsigned-endian> ] }
{ ch'f [ unsigned-endian> bits>float ] }
{ ch'F [ unsigned-endian> bits>float ] }
{ ch'd [ unsigned-endian> bits>double ] }
{ ch'D [ unsigned-endian> bits>double ] }
! { ch'a read-c-string }
{ char: c [ 8 signed-endian> ] }
{ char: C [ unsigned-endian> ] }
{ char: s [ 16 signed-endian> ] }
{ char: S [ unsigned-endian> ] }
{ char: t [ 24 signed-endian> ] }
{ char: T [ unsigned-endian> ] }
{ char: i [ 32 signed-endian> ] }
{ char: I [ unsigned-endian> ] }
{ char: q [ 64 signed-endian> ] }
{ char: Q [ unsigned-endian> ] }
{ char: f [ unsigned-endian> bits>float ] }
{ char: F [ unsigned-endian> bits>float ] }
{ char: d [ unsigned-endian> bits>double ] }
{ char: D [ unsigned-endian> bits>double ] }
! { char: a read-c-string }
}
CONSTANT: packed-length-table
H{
{ ch'c 1 }
{ ch'C 1 }
{ ch's 2 }
{ ch'S 2 }
{ ch't 3 }
{ ch'T 3 }
{ ch'i 4 }
{ ch'I 4 }
{ ch'q 8 }
{ ch'Q 8 }
{ ch'f 4 }
{ ch'F 4 }
{ ch'd 8 }
{ ch'D 8 }
{ char: c 1 }
{ char: C 1 }
{ char: s 2 }
{ char: S 2 }
{ char: t 3 }
{ char: T 3 }
{ char: i 4 }
{ char: I 4 }
{ char: q 8 }
{ char: Q 8 }
{ char: f 4 }
{ char: F 4 }
{ char: d 8 }
{ char: D 8 }
}
PRIVATE>

2
basis/peg/ebnf/ebnf-docs.factor
View File

@ -342,7 +342,7 @@ ARTICLE: "peg.ebnf.tokenizers" "EBNF Tokenizers"
}
}
"This parser when run with the string \"++--\" or the array "
"{ ch'+ ch'+ ch'- ch'- } will succeed with an AST of { \"++\" \"--\" }. "
"{ char: + char: + char: - char: - } will succeed with an AST of { \"++\" \"--\" }. "
"If you want to add whitespace handling to the grammar you need to put it "
"between the terminals:"
{ $examples

16
basis/peg/ebnf/ebnf-tests.factor
View File

@ -156,11 +156,11 @@ IN: peg.ebnf.tests
"ab" EBNF[=[ foo=('a') [[ drop 1 ]] ('b') [[ drop 2 ]] ]=]
] unit-test
{ ch'A } [
{ char: A } [
"A" EBNF[=[ foo=[A-Z] ]=]
] unit-test
{ ch'Z } [
{ char: Z } [
"Z" EBNF[=[ foo=[A-Z] ]=]
] unit-test
@ -168,7 +168,7 @@ IN: peg.ebnf.tests
"0" EBNF[=[ foo=[A-Z] ]=]
] must-fail
{ ch'0 } [
{ char: 0 } [
"0" EBNF[=[ foo=[^A-Z] ]=]
] unit-test
@ -498,7 +498,7 @@ foo=<foreign any-char> 'd'
"ac" parser3
] unit-test
{ V{ ch'a "d" } } [
{ V{ char: a "d" } } [
"ad" parser4
] unit-test
@ -517,7 +517,7 @@ foo=<foreign any-char> 'd'
] unit-test
! Tokenizer tests
{ V{ "a" ch'b } } [
{ V{ "a" char: b } } [
"ab" EBNF[=[ tokenizer=default foo="a" . ]=]
] unit-test
@ -541,7 +541,7 @@ Special = "(" | ")" | "{" | "}" | "[" | "]" | "," | "
Tok = Spaces (Number | Special )
]=]
{ V{ ch'1 T{ ast-number f 23 } ";" ch'x } } [
{ V{ char: 1 T{ ast-number f 23 } ";" char: x } } [
"123;x" EBNF[=[ bar = .
tokenizer = <foreign a-tokenizer Tok> foo=.
tokenizer=default baz=.
@ -549,7 +549,7 @@ Tok = Spaces (Number | Special )
]=]
] unit-test
{ V{ ch'5 "+" ch'2 } } [
{ V{ char: 5 "+" char: 2 } } [
"5+2" EBNF[=[
space=(" " | "\n")
number=[0-9]
@ -560,7 +560,7 @@ Tok = Spaces (Number | Special )
]=]
] unit-test
{ V{ ch'5 "+" ch'2 } } [
{ V{ char: 5 "+" char: 2 } } [
"5 + 2" EBNF[=[
space=(" " | "\n")
number=[0-9]

12
basis/peg/ebnf/ebnf.factor
View File

@ -112,11 +112,11 @@ C: <ebnf> ebnf
! between the quotes.
[
[
[ ch'\\ = ] satisfy
[ char: \\ = ] satisfy
[ "\"\\" member? ] satisfy 2seq ,
[ ch'\" = not ] satisfy ,
[ char: \" = not ] satisfy ,
] choice* repeat1 "\"" "\"" surrounded-by ,
[ ch'\' = not ] satisfy repeat1 "'" "'" surrounded-by ,
[ char: \' = not ] satisfy repeat1 "'" "'" surrounded-by ,
] choice* [ "" flatten-as unescape-string ] action ;
: non-terminal-parser ( -- parser )
@ -140,7 +140,7 @@ C: <ebnf> ebnf
[
{
[ blank? ]
[ ch'> = ]
[ char: > = ]
} 1|| not
] satisfy repeat1 [ >string ] action ;
@ -155,13 +155,13 @@ C: <ebnf> ebnf
: any-character-parser ( -- parser )
! A parser to match the symbol for any character match.
[ ch'. = ] satisfy [ drop <ebnf-any-character> ] action ;
[ char: . = ] satisfy [ drop <ebnf-any-character> ] action ;
: range-parser-parser ( -- parser )
! Match the syntax for declaring character ranges
[
[ "[" syntax , "[" token ensure-not , ] seq* hide ,
[ ch'\] = not ] satisfy repeat1 ,
[ char: \] = not ] satisfy repeat1 ,
"]" syntax ,
] seq* [ first >string unescape-string <ebnf-range> ] action ;

2
basis/peg/parsers/parsers-docs.factor
View File

@ -11,7 +11,7 @@ HELP: 1token
} { $description
"Calls 1string on a character and returns a parser that matches that character."
} { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"a\" ch'a 1token parse ." "\"a\"" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"a\" char: a 1token parse ." "\"a\"" }
} { $see-also string-parser } ;
HELP: (list-of)

8
basis/peg/parsers/parsers.factor
View File

@ -76,9 +76,9 @@ PRIVATE>
: string-parser ( -- parser )
[
[ ch'\" = ] satisfy hide ,
[ ch'\" = not ] satisfy repeat0 ,
[ ch'\" = ] satisfy hide ,
[ char: \" = ] satisfy hide ,
[ char: \" = not ] satisfy repeat0 ,
[ char: \" = ] satisfy hide ,
] seq* [ first >string ] action ;
: (range-pattern) ( pattern -- string )
@ -86,7 +86,7 @@ PRIVATE>
! all characters within that range.
[
any-char ,
[ ch'- = ] satisfy hide ,
[ char: - = ] satisfy hide ,
any-char ,
] seq* [
first2 [a,b] >string

4
basis/peg/peg-docs.factor
View File

@ -49,7 +49,7 @@ HELP: range
}
{ $description
"Returns a parser that matches a single character that lies within the range of characters given, inclusive." }
{ $examples { $code ": digit ( -- parser ) ch'0 ch'9 range ;" } } ;
{ $examples { $code ": digit ( -- parser ) char: 0 char: 9 range ;" } } ;
HELP: seq
{ $values
@ -137,7 +137,7 @@ HELP: action
"from that parse. The result of the quotation is then used as the final AST. This can be used "
"for manipulating the parse tree to produce a AST better suited for the task at hand rather than "
"the default AST. If the quotation returns " { $link fail } " then the parser fails." }
{ $code "ch'0 ch'9 range [ to-digit ] action" } ;
{ $code "char: 0 char: 9 range [ to-digit ] action" } ;
HELP: sp
{ $values

26
basis/peg/peg-tests.factor
View File

@ -18,19 +18,19 @@ IN: peg.tests
] unit-test
[
"" ch'a ch'z range parse
"" char: a char: z range parse
] must-fail
[
"1bcd" ch'a ch'z range parse
"1bcd" char: a char: z range parse
] must-fail
{ ch'a } [
"abcd" ch'a ch'z range parse
{ char: a } [
"abcd" char: a char: z range parse
] unit-test
{ ch'z } [
"zbcd" ch'a ch'z range parse
{ char: z } [
"zbcd" char: a char: z range parse
] unit-test
[
@ -93,12 +93,12 @@ IN: peg.tests
"cb" "a" token optional "b" token 2array seq parse
] must-fail
{ V{ ch'a ch'b } } [
"ab" "a" token ensure ch'a ch'z range dup 3array seq parse
{ V{ char: a char: b } } [
"ab" "a" token ensure char: a char: z range dup 3array seq parse
] unit-test
[
"bb" "a" token ensure ch'a ch'z range 2array seq parse
"bb" "a" token ensure char: a char: z range 2array seq parse
] must-fail
{ t } [
@ -138,11 +138,11 @@ IN: peg.tests
] must-fail
[
"b" [ ch'a = ] satisfy parse
"b" [ char: a = ] satisfy parse
] must-fail
{ ch'a } [
"a" [ ch'a = ] satisfy parse
{ char: a } [
"a" [ char: a = ] satisfy parse
] unit-test
{ "a" } [
@ -191,7 +191,7 @@ IN: peg.tests
"A" [ drop t ] satisfy [ 66 >= ] semantic parse
] must-fail
{ ch'B } [
{ char: B } [
"B" [ drop t ] satisfy [ 66 >= ] semantic parse
] unit-test

2
basis/persistent/hashtables/hashtables-tests.factor
View File

@ -82,7 +82,7 @@ M: hash-0-b hashcode* 2drop 0 ;
: random-string ( -- str )
1000000 random ;
! [ ch'a ch'z [a,b] random ] "" replicate-as ;
! [ char: a char: z [a,b] random ] "" replicate-as ;
: random-assocs ( n -- hash phash )
[ random-string ] replicate

8
basis/porter-stemmer/porter-stemmer.factor
View File

@ -5,7 +5,7 @@ IN: porter-stemmer
2dup nth dup "aeiou" member? [
3drop f
] [
ch'y = [
char: y = [
over zero?
[ 2drop t ] [ [ 1 - ] dip consonant? not ] if
] [
@ -67,7 +67,7 @@ IN: porter-stemmer
pick consonant-seq 0 > [ nip ] [ drop ] if append ;
: step1a ( str -- newstr )
dup last ch's = [
dup last char: s = [
{
{ [ "sses" ?tail ] [ "ss" append ] }
{ [ "ies" ?tail ] [ "i" append ] }
@ -199,13 +199,13 @@ IN: porter-stemmer
[ 1 = [ but-last-slice cvc? not ] [ drop f ] if ] if ;
: remove-e ( str -- newstr )
dup last ch'e = [
dup last char: e = [
dup remove-e? [ but-last-slice ] when
] when ;
: ll->l ( str -- newstr )
{
{ [ dup last ch'l = not ] [ ] }
{ [ dup last char: l = not ] [ ] }
{ [ dup length 1 - over double-consonant? not ] [ ] }
{ [ dup consonant-seq 1 > ] [ but-last-slice ] }
[ ]

2
basis/prettyprint/backend/backend-docs.factor
View File

@ -10,7 +10,7 @@ HELP: pprint-word
$prettyprinting-note ;
HELP: ch>ascii-escape
{ $values { "ch" "a character" } { "ch'" "a character" } { "?" boolean } }
{ $values { "ch" "a character" } { "char: " "a character" } { "?" boolean } }
{ $description "Converts a character to an escape code." } ;
HELP: unparse-ch

24
basis/prettyprint/backend/backend.factor
View File

@ -97,21 +97,21 @@ M: f pprint* drop \ f pprint-word ;
! Strings
: ch>ascii-escape ( ch -- ch' ? )
H{
{ ch'\a ch'a }
{ ch'\b ch'b }
{ ch'\e ch'e }
{ ch'\f ch'f }
{ ch'\n ch'n }
{ ch'\r ch'r }
{ ch'\t ch't }
{ ch'\v ch'v }
{ ch'\0 ch'0 }
{ ch'\\ ch'\\ }
{ ch'\" ch'\" }
{ char: \a char: a }
{ char: \b char: b }
{ char: \e char: e }
{ char: \f char: f }
{ char: \n char: n }
{ char: \r char: r }
{ char: \t char: t }
{ char: \v char: v }
{ char: \0 char: 0 }
{ char: \\ char: \\ }
{ char: \" char: \" }
} ?at ; inline
: unparse-ch ( ch -- )
ch>ascii-escape [ ch'\\ , , ] [
ch>ascii-escape [ char: \\ , , ] [
dup 32 < [ dup 16 < "\\x0" "\\x" ? % >hex % ] [ , ] if
] if ;

2
basis/prettyprint/prettyprint-tests.factor
View File

@ -468,7 +468,7 @@ TUPLE: fo { a intersection{ integer fixnum } initial: 0 } ;
: margin-test ( number-of-a-s -- str )
[
[ ch'a <string> text "b" text ] with-pprint
[ char: a <string> text "b" text ] with-pprint
] with-string-writer ;
{

2
basis/prettyprint/sections/sections.factor
View File

@ -43,7 +43,7 @@ M: maybe vocabulary-name
line-limit get dup [ pprinter get line-count>> <= ] when ;
: do-indent ( -- )
pprinter get indent>> [ ch'\s <string> write ] unless-zero ;
pprinter get indent>> [ char: \s <string> write ] unless-zero ;
: fresh-line ( n -- )
pprinter get 2dup last-newline>> = [

14
basis/quoted-printable/quoted-printable.factor
View File

@ -15,16 +15,16 @@ IN: quoted-printable
: printable? ( ch -- ? )
{
[ ch'\s ch'< between? ]
[ ch'> ch'~ between? ]
[ ch'\t = ]
[ char: \s char: < between? ]
[ char: > char: ~ between? ]
[ char: \t = ]
} 1|| ;
: char>quoted ( ch -- str )
dup printable? [ 1string ] [
assure-small >hex >upper
2 ch'0 pad-head
ch'= prefix
2 char: 0 pad-head
char: = prefix
] if ;
: take-some ( seqs -- seqs seq )
@ -46,8 +46,8 @@ PRIVATE>
<PRIVATE
: read-char ( byte -- ch )
dup ch'= = [
drop read1 dup ch'\n =
dup char: = = [
drop read1 dup char: \n =
[ drop read1 read-char ]
[ read1 2array hex> ] if
] when ;

6
basis/random/data/data.factor
View File

@ -10,11 +10,11 @@ CONSTANT: letters-count 26
>>
: random-digit ( -- ch )
digits-count random ch'0 + ;
digits-count random char: 0 + ;
: random-LETTER ( -- ch ) letters-count random ch'A + ;
: random-LETTER ( -- ch ) letters-count random char: A + ;
: random-letter ( -- ch ) letters-count random ch'a + ;
: random-letter ( -- ch ) letters-count random char: a + ;
: random-Letter ( -- ch )
{ random-LETTER random-letter } execute-random ;

8
basis/regexp/classes/classes-tests.factor
View File

@ -8,10 +8,10 @@ IN: regexp.classes.tests
{ f } [ { 1 2 } <and-class> ] unit-test
{ T{ or-class f { 1 2 } } } [ { 1 2 } <or-class> ] unit-test
{ 3 } [ { 1 2 } <and-class> 3 2array <or-class> ] unit-test
{ ch'A } [ ch'A LETTER-class <primitive-class> 2array <and-class> ] unit-test
{ ch'A } [ LETTER-class <primitive-class> ch'A 2array <and-class> ] unit-test
{ T{ primitive-class { class LETTER-class } } } [ ch'A LETTER-class <primitive-class> 2array <or-class> ] unit-test
{ T{ primitive-class { class LETTER-class } } } [ LETTER-class <primitive-class> ch'A 2array <or-class> ] unit-test
{ char: A } [ char: A LETTER-class <primitive-class> 2array <and-class> ] unit-test
{ char: A } [ LETTER-class <primitive-class> char: A 2array <and-class> ] unit-test
{ T{ primitive-class { class LETTER-class } } } [ char: A LETTER-class <primitive-class> 2array <or-class> ] unit-test
{ T{ primitive-class { class LETTER-class } } } [ LETTER-class <primitive-class> char: A 2array <or-class> ] unit-test
{ t } [ { t 1 } <or-class> ] unit-test
{ t } [ { 1 t } <or-class> ] unit-test
{ f } [ { f 1 } <and-class> ] unit-test

14
basis/regexp/classes/classes.factor
View File

@ -55,7 +55,7 @@ M: digit-class class-member? ( obj class -- ? )
drop digit? ; inline
: c-identifier-char? ( ch -- ? )
{ [ alpha? ] [ ch'_ = ] } 1|| ;
{ [ alpha? ] [ char: _ = ] } 1|| ;
M: c-identifier-class class-member? ( obj class -- ? )
drop c-identifier-char? ; inline
@ -76,16 +76,16 @@ M: java-printable-class class-member? ( obj class -- ? )
drop java-printable? ; inline
M: non-newline-blank-class class-member? ( obj class -- ? )
drop { [ blank? ] [ ch'\n = not ] } 1&& ; inline
drop { [ blank? ] [ char: \n = not ] } 1&& ; inline
M: control-character-class class-member? ( obj class -- ? )
drop control? ; inline
: hex-digit? ( ch -- ? )
{
[ ch'A ch'F between? ]
[ ch'a ch'f between? ]
[ ch'0 ch'9 between? ]
[ char: A char: F between? ]
[ char: a char: f between? ]
[ char: 0 char: 9 between? ]
} 1|| ;
M: hex-digit-class class-member? ( obj class -- ? )
@ -93,8 +93,8 @@ M: hex-digit-class class-member? ( obj class -- ? )
: java-blank? ( ch -- ? )
{
ch'\s ch'\t ch'\n
ch'\v ch'\a ch'\r
char: \s char: \t char: \n
char: \v char: \a char: \r
} member? ;
M: java-blank-class class-member? ( obj class -- ? )

4
basis/regexp/compiler/compiler.factor
View File

@ -37,10 +37,10 @@ M: ^ question>quot
drop [ { [ drop zero? ] [ [ 1 - ] dip ?nth "\r\n" member? ] } 2|| ] ;
M: $unix question>quot
drop [ { [ length = ] [ ?nth ch'\n = ] } 2|| ] ;
drop [ { [ length = ] [ ?nth char: \n = ] } 2|| ] ;
M: ^unix question>quot
drop [ { [ drop zero? ] [ [ 1 - ] dip ?nth ch'\n = ] } 2|| ] ;
drop [ { [ drop zero? ] [ [ 1 - ] dip ?nth char: \n = ] } 2|| ] ;
M: word-break question>quot
drop [ word-break-at? ] ;

16
basis/regexp/minimize/minimize-tests.factor
View File

@ -26,9 +26,9 @@ IN: regexp.minimize.tests
{
T{ transition-table
{ transitions H{
{ 0 H{ { ch'a 1 } { ch'b 1 } } }
{ 1 H{ { ch'a 2 } { ch'b 2 } } }
{ 2 H{ { ch'c 3 } } }
{ 0 H{ { char: a 1 } { char: b 1 } } }
{ 1 H{ { char: a 2 } { char: b 2 } } }
{ 2 H{ { char: c 3 } } }
{ 3 H{ } }
} }
{ start-state 0 }
@ -37,12 +37,12 @@ IN: regexp.minimize.tests
} [
T{ transition-table
{ transitions H{
{ 0 H{ { ch'a 1 } { ch'b 4 } } }
{ 1 H{ { ch'a 2 } { ch'b 5 } } }
{ 2 H{ { ch'c 3 } } }
{ 0 H{ { char: a 1 } { char: b 4 } } }
{ 1 H{ { char: a 2 } { char: b 5 } } }
{ 2 H{ { char: c 3 } } }
{ 3 H{ } }
{ 4 H{ { ch'a 2 } { ch'b 5 } } }
{ 5 H{ { ch'c 6 } } }
{ 4 H{ { char: a 2 } { char: b 5 } } }
{ 5 H{ { char: c 6 } } }
{ 6 H{ } }
} }
{ start-state 0 }

4
basis/regexp/negation/negation-tests.factor
View File

@ -7,7 +7,7 @@ IN: regexp.negation.tests
! R/ |[^a]|.+/
T{ transition-table
{ transitions H{
{ 0 H{ { ch'a 1 } { T{ not-class f ch'a } -1 } } }
{ 0 H{ { char: a 1 } { T{ not-class f char: a } -1 } } }
{ 1 H{ { t -1 } } }
{ -1 H{ { t -1 } } }
} }
@ -18,7 +18,7 @@ IN: regexp.negation.tests
! R/ a/
T{ transition-table
{ transitions H{
{ 0 H{ { ch'a 1 } } }
{ 0 H{ { char: a 1 } } }
{ 1 H{ } }
} }
{ start-state 0 }

4
basis/regexp/nfa/nfa.factor
View File

@ -116,10 +116,10 @@ M: not-class modify-class
class>> modify-class <not-class> ;
MEMO: unix-dot ( -- class )
ch'\n <not-class> ;
char: \n <not-class> ;
MEMO: nonl-dot ( -- class )
{ ch'\n ch'\r } <or-class> <not-class> ;
{ char: \n char: \r } <or-class> <not-class> ;
M: dot modify-class
drop dotall option? [ t ] [

52
basis/regexp/parser/parser.factor
View File

@ -71,39 +71,39 @@ MEMO: simple-category-table ( -- table )
: lookup-escape ( char -- ast )
{
{ ch'a [ 0x7 ] }
{ ch'e [ 0x1b ] }
{ ch'f [ 0xc ] }
! { ch'f [ ch'\f ] }
{ ch'n [ ch'\n ] }
{ ch'r [ ch'\r ] }
{ ch't [ ch'\t ] }
{ ch'v [ ch'\v ] }
{ ch'0 [ ch'\0 ] }
{ ch'\\ [ ch'\\ ] }
{ char: a [ 0x7 ] }
{ char: e [ 0x1b ] }
{ char: f [ 0xc ] }
! { char: f [ char: \f ] }
{ char: n [ char: \n ] }
{ char: r [ char: \r ] }
{ char: t [ char: \t ] }
{ char: v [ char: \v ] }
{ char: 0 [ char: \0 ] }
{ char: \\ [ char: \\ ] }
{ ch'w [ c-identifier-class <primitive-class> ] }
{ ch'W [ c-identifier-class <primitive-class> <not-class> ] }
{ ch's [ java-blank-class <primitive-class> ] }
{ ch'S [ java-blank-class <primitive-class> <not-class> ] }
{ ch'd [ digit-class <primitive-class> ] }
{ ch'D [ digit-class <primitive-class> <not-class> ] }
{ char: w [ c-identifier-class <primitive-class> ] }
{ char: W [ c-identifier-class <primitive-class> <not-class> ] }
{ char: s [ java-blank-class <primitive-class> ] }
{ char: S [ java-blank-class <primitive-class> <not-class> ] }
{ char: d [ digit-class <primitive-class> ] }
{ char: D [ digit-class <primitive-class> <not-class> ] }
{ ch'z [ end-of-input <tagged-epsilon> ] }
{ ch'Z [ end-of-file <tagged-epsilon> ] }
{ ch'A [ beginning-of-input <tagged-epsilon> ] }
{ ch'b [ word-break <tagged-epsilon> ] }
{ ch'B [ word-break <not-class> <tagged-epsilon> ] }
{ char: z [ end-of-input <tagged-epsilon> ] }
{ char: Z [ end-of-file <tagged-epsilon> ] }
{ char: A [ beginning-of-input <tagged-epsilon> ] }
{ char: b [ word-break <tagged-epsilon> ] }
{ char: B [ word-break <not-class> <tagged-epsilon> ] }
[ ]
} case ;
: options-assoc ( -- assoc )
H{
{ ch'i case-insensitive }
{ ch'd unix-lines }
{ ch'm multiline }
{ ch'r reversed-regexp }
{ ch's dotall }
{ char: i case-insensitive }
{ char: d unix-lines }
{ char: m multiline }
{ char: r reversed-regexp }
{ char: s dotall }
} ;
ERROR: nonexistent-option name ;

2
basis/regexp/regexp.factor
View File

@ -202,7 +202,7 @@ PRIVATE>
dup skip-blank [
dupd [
[ [ "\\/" member? ] find-from ] keep swap [
ch'\ = [ [ 2 + ] dip t ] [ f ] if
char: \ = [ [ 2 + ] dip t ] [ f ] if
] [
"Unterminated regexp" throw
] if*

2
basis/sequences/parser/parser-tests.factor
View File

@ -12,7 +12,7 @@ USING: tools.test sequences.parser unicode kernel accessors ;
{ "foo" ";bar" }
[
"foo;bar" [
[ ch'\; take-until-object ] [ take-rest ] bi
[ char: \; take-until-object ] [ take-rest ] bi
] parse-sequence
] unit-test

62
basis/serialize/serialize.factor
View File

@ -62,22 +62,22 @@ SYMBOL: serialized
: serialize-shared ( obj quot -- )
[
dup object-id
[ ch'o write1 serialize-cell drop ]
[ char: o write1 serialize-cell drop ]
] dip if* ; inline
M: f (serialize) ( obj -- )
drop ch'n write1 ;
drop char: n write1 ;
M: integer (serialize) ( obj -- )
[
ch'z write1
char: z write1
] [
dup 0 < [ neg ch'm ] [ ch'p ] if write1
dup 0 < [ neg char: m ] [ char: p ] if write1
serialize-cell
] if-zero ;
M: float (serialize) ( obj -- )
ch'F write1
char: F write1
double>bits serialize-cell ;
: serialize-seq ( obj code -- )
@ -90,7 +90,7 @@ M: float (serialize) ( obj -- )
M: tuple (serialize) ( obj -- )
[
ch'T write1
char: T write1
[ class-of (serialize) ]
[ add-object ]
[ tuple-slots (serialize) ]
@ -98,23 +98,23 @@ M: tuple (serialize) ( obj -- )
] serialize-shared ;
M: array (serialize) ( obj -- )
ch'a serialize-seq ;
char: a serialize-seq ;
M: quotation (serialize) ( obj -- )
[
ch'q write1
char: q write1
[ >array (serialize) ] [ add-object ] bi
] serialize-shared ;
M: hashtable (serialize) ( obj -- )
[
ch'h write1
char: h write1
[ add-object ] [ >alist (serialize) ] bi
] serialize-shared ;
M: byte-array (serialize) ( obj -- )
[
ch'A write1
char: A write1
[ add-object ]
[ length serialize-cell ]
[ write ] tri
@ -122,7 +122,7 @@ M: byte-array (serialize) ( obj -- )
M: string (serialize) ( obj -- )
[
ch's write1
char: s write1
[ add-object ]
[
utf8 encode
@ -132,11 +132,11 @@ M: string (serialize) ( obj -- )
] serialize-shared ;
: serialize-true ( word -- )
drop ch't write1 ;
drop char: t write1 ;
: serialize-gensym ( word -- )
[
ch'G write1
char: G write1
[ add-object ]
[ def>> (serialize) ]
[ props>> (serialize) ]
@ -144,7 +144,7 @@ M: string (serialize) ( obj -- )
] serialize-shared ;
: serialize-word ( word -- )
ch'w write1
char: w write1
[ name>> (serialize) ]
[ vocabulary>> (serialize) ]
bi ;
@ -157,7 +157,7 @@ M: word (serialize) ( obj -- )
} cond ;
M: wrapper (serialize) ( obj -- )
ch'W write1
char: W write1
wrapped>> (serialize) ;
DEFER: (deserialize)
@ -246,22 +246,22 @@ SYMBOL: deserialized
: deserialize* ( -- object ? )
read1 [
{
{ ch'A [ deserialize-byte-array ] }
{ ch'F [ deserialize-float ] }
{ ch'T [ deserialize-tuple ] }
{ ch'W [ deserialize-wrapper ] }
{ ch'a [ deserialize-array ] }
{ ch'h [ deserialize-hashtable ] }
{ ch'm [ deserialize-negative-integer ] }
{ ch'n [ deserialize-false ] }
{ ch't [ deserialize-true ] }
{ ch'o [ deserialize-unknown ] }
{ ch'p [ deserialize-positive-integer ] }
{ ch'q [ deserialize-quotation ] }
{ ch's [ deserialize-string ] }
{ ch'w [ deserialize-word ] }
{ ch'G [ deserialize-word ] }
{ ch'z [ deserialize-zero ] }
{ char: A [ deserialize-byte-array ] }
{ char: F [ deserialize-float ] }
{ char: T [ deserialize-tuple ] }
{ char: W [ deserialize-wrapper ] }
{ char: a [ deserialize-array ] }
{ char: h [ deserialize-hashtable ] }
{ char: m [ deserialize-negative-integer ] }
{ char: n [ deserialize-false ] }
{ char: t [ deserialize-true ] }
{ char: o [ deserialize-unknown ] }
{ char: p [ deserialize-positive-integer ] }
{ char: q [ deserialize-quotation ] }
{ char: s [ deserialize-string ] }
{ char: w [ deserialize-word ] }
{ char: G [ deserialize-word ] }
{ char: z [ deserialize-zero ] }
} case t
] [
f f

2
basis/smtp/smtp.factor
View File

@ -97,7 +97,7 @@ ERROR: bad-email-address email ;
LOG: smtp-response DEBUG
: multiline? ( response -- ? )
3 swap ?nth ch'- = ;
3 swap ?nth char: - = ;
: (receive-response) ( -- )
read-crlf

2
basis/strings/tables/tables.factor
View File

@ -9,7 +9,7 @@ IN: strings.tables
dup longest length '[ _ "" pad-tail ] map! ;
: format-column ( seq -- seq )
dup longest length '[ _ ch'\s pad-tail ] map! ;
dup longest length '[ _ char: \s pad-tail ] map! ;
PRIVATE>

4
basis/tools/deploy/config/config-docs.factor
View File

@ -82,9 +82,9 @@ $nl
"Off by default. Programs wishing to use the UI must be deployed with this flag on." } ;
HELP: deploy-unicode?
{ $description "Deploy flag. If set, full Unicode " { $snippet "ch'" } " syntax is included."
{ $description "Deploy flag. If set, full Unicode " { $snippet "char: " } " syntax is included."
$nl
"Off by default. If your program needs to use " { $snippet "ch'" } " with named characters, enable this flag." } ;
"Off by default. If your program needs to use " { $snippet "char: " } " with named characters, enable this flag." } ;
HELP: deploy-console?
{ $description "Deploy flag. If set, the deployed executable will be configured as a console application. On Windows, this means the application will be deployed in the console subsystem and will be attached to a console window. On Mac OS X, this means the application will be deployed as a Unix executable instead of a Mac application bundle. On other Unix platforms, the flag has no effect."

4
basis/tools/disassembler/udis/udis.factor
View File

@ -63,8 +63,8 @@ SINGLETON: udis-disassembler
dup [ second length ] [ max ] map-reduce
'[
[
[ first >hex cell 2 * ch'0 pad-head % ": " % ]
[ second _ ch'\s pad-tail % " " % ]
[ first >hex cell 2 * char: 0 pad-head % ": " % ]
[ second _ char: \s pad-tail % " " % ]
[ third resolve-call % ]
tri
] "" make

Some files were not shown because too many files have changed in this diff Show More