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

factor: CHAR: -> ch', URL", NAN: fixes

modern-harvey3
Doug Coleman 2019-09-27 16:02:48 -05:00
parent 3eda5056c7
commit fdf13141bc
7 changed files with 30 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/alien/libraries/freebsd/freebsd.factor
View File

@ -16,7 +16,7 @@ IN: alien.libraries.finder.freebsd
rest parse-ldconfig-lines ; rest parse-ldconfig-lines ;
: name-matches? ( lib double -- ? ) : name-matches? ( lib double -- ? )
first swap ?head [ ?first CHAR: . = ] [ drop f ] if ; first swap ?head [ ?first ch'. = ] [ drop f ] if ;
PRIVATE> PRIVATE>

8
extra/base32-crockford/base32-crockford.factor
View File

@ -16,10 +16,10 @@ CONSTANT: INVERSE $[ 256 [ ALPHABET index 0xff or ] B{ } map-integers ]
CONSTANT: CHECKSUM $[ ALPHABET "*~$=U" append ] CONSTANT: CHECKSUM $[ ALPHABET "*~$=U" append ]
: normalize-base32 ( base32 -- base32' ) : normalize-base32 ( base32 -- base32' )
CHAR: - swap remove >upper H{ ch'- swap remove >upper H{
{ CHAR: I CHAR: 1 } { ch'I ch'1 }
{ CHAR: L CHAR: 1 } { ch'L ch'1 }
{ CHAR: O CHAR: 0 } { ch'O ch'0 }
} substitute ; } substitute ;
: parse-base32 ( base32 -- n ) : parse-base32 ( base32 -- n )

8
extra/base32/base32.factor
View File

@ -21,7 +21,7 @@ CONSTANT: alphabet $[ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567" >byte-array ]
alphabet nth ; inline alphabet nth ; inline
: base32>ch ( ch -- ch ) : base32>ch ( ch -- ch )
$[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth $[ alphabet alphabet-inverse 0 ch'= pick set-nth ] nth
[ malformed-base32 ] unless* { fixnum } declare ; inline [ malformed-base32 ] unless* { fixnum } declare ; inline
: encode5 ( seq -- byte-array ) : encode5 ( seq -- byte-array )
@ -31,7 +31,7 @@ CONSTANT: alphabet $[ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567" >byte-array ]
: encode-pad ( seq n -- byte-array ) : encode-pad ( seq n -- byte-array )
[ 5 0 pad-tail encode5 ] [ B{ 0 2 4 5 7 } nth ] bi* head-slice [ 5 0 pad-tail encode5 ] [ B{ 0 2 4 5 7 } nth ] bi* head-slice
8 CHAR: = pad-tail ; inline 8 ch'= pad-tail ; inline
: (encode-base32) ( stream column -- ) : (encode-base32) ( stream column -- )
5 pick stream-read dup length { 5 pick stream-read dup length {
@ -52,14 +52,14 @@ PRIVATE>
: decode8 ( seq -- ) : decode8 ( seq -- )
[ 0 [ base32>ch swap 5 shift bitor ] reduce 5 >be ] [ 0 [ base32>ch swap 5 shift bitor ] reduce 5 >be ]
[ [ CHAR: = = ] count ] bi [ [ ch'= = ] count ] bi
[ write ] [ B{ 0 4 0 3 2 0 1 } nth head-slice write ] if-zero ; inline [ write ] [ B{ 0 4 0 3 2 0 1 } nth head-slice write ] if-zero ; inline
: (decode-base32) ( stream -- ) : (decode-base32) ( stream -- )
8 "\n\r" pick read-ignoring dup length { 8 "\n\r" pick read-ignoring dup length {
{ 0 [ 2drop ] } { 0 [ 2drop ] }
{ 8 [ decode8 (decode-base32) ] } { 8 [ decode8 (decode-base32) ] }
[ drop 8 CHAR: = pad-tail decode8 (decode-base32) ] [ drop 8 ch'= pad-tail decode8 (decode-base32) ]
} case ; } case ;
PRIVATE> PRIVATE>

2
extra/base85/base85.factor
View File

@ -57,7 +57,7 @@ PRIVATE>
{ 5 [ decode5 write (decode-base85) ] } { 5 [ decode5 write (decode-base85) ] }
[ [
drop drop
[ 5 CHAR: ~ pad-tail decode5 ] [ 5 ch'~ pad-tail decode5 ]
[ length 5 swap - head-slice* write ] bi [ length 5 swap - head-slice* write ] bi
(decode-base85) (decode-base85)
] ]

10
extra/cbor/cbor-tests.factor
View File

@ -34,13 +34,13 @@ math.parser math.ranges tools.test urls ;
{ -4.0 "f9c400" } { -4.0 "f9c400" }
{ -4.1 "fbc010666666666666" } { -4.1 "fbc010666666666666" }
{ 1/0. "f97c00" } { 1/0. "f97c00" }
{ NAN: 8000000000000 "f97e00" } { nan: 8000000000000 "f97e00" }
{ -1/0. "f9fc00" } { -1/0. "f9fc00" }
{ 1/0. "fa7f800000" } { 1/0. "fa7f800000" }
{ NAN: 8000000000000 "fa7fc00000" } { nan: 8000000000000 "fa7fc00000" }
{ -1/0. "faff800000" } { -1/0. "faff800000" }
{ 1/0. "fb7ff0000000000000" } { 1/0. "fb7ff0000000000000" }
{ NAN: 8000000000000 "fb7ff8000000000000" } { nan: 8000000000000 "fb7ff8000000000000" }
{ -1/0. "fbfff0000000000000" } { -1/0. "fbfff0000000000000" }
{ f "f4" } { f "f4" }
{ t "f5" } { t "f5" }
@ -63,7 +63,7 @@ math.parser math.ranges tools.test urls ;
} }
{ T{ cbor-tagged f 23 B{ 1 2 3 4 } } "d74401020304" } { T{ cbor-tagged f 23 B{ 1 2 3 4 } } "d74401020304" }
{ T{ cbor-tagged f 24 B{ 0x64 0x49 0x45 0x54 0x46 } } "d818456449455446" } { T{ cbor-tagged f 24 B{ 0x64 0x49 0x45 0x54 0x46 } } "d818456449455446" }
{ URL" http://www.example.com" "d82076687474703a2f2f7777772e6578616d706c652e636f6d" } { url"http://www.example.com" "d82076687474703a2f2f7777772e6578616d706c652e636f6d" }
{ B{ } "40" } { B{ } "40" }
{ B{ 1 2 3 4 } "4401020304" } { B{ 1 2 3 4 } "4401020304" }
{ B{ 0xaa 0xbb 0xcc 0xdd 0xee 0xff 0x99 } "5F44aabbccdd43eeff99ff" } { B{ 0xaa 0xbb 0xcc 0xdd 0xee 0xff 0x99 } "5F44aabbccdd43eeff99ff" }
@ -94,7 +94,7 @@ math.parser math.ranges tools.test urls ;
{ { { "a" 1 } { "b" { 2 3 } } } "bf61610161629f0203ffff" } { { { "a" 1 } { "b" { 2 3 } } } "bf61610161629f0203ffff" }
{ { "a" { { "b" "c" } } } "826161bf61626163ff" } { { "a" { { "b" "c" } } } "826161bf61626163ff" }
{ { { "Fun" t } { "Amt" -2 } } "bf6346756ef563416d7421ff" } { { { "Fun" t } { "Amt" -2 } } "bf6346756ef563416d7421ff" }
} [| value hex-string | } |[ value hex-string |
hex-string hex-string>bytes :> bytes hex-string hex-string>bytes :> bytes

26
extra/toml/toml.factor
View File

@ -32,28 +32,28 @@ TUPLE: entry key value ;
: hexdigit ( -- parser ) : hexdigit ( -- parser )
[ [
CHAR: 0 CHAR: 9 range , ch'0 ch'9 range ,
CHAR: a CHAR: f range , ch'a ch'f range ,
CHAR: A CHAR: F range , ch'A ch'F range ,
] choice* ; ] choice* ;
: hex ( -- parser ) : hex ( -- parser )
"0x" token hide hexdigit digits 2seq [ first hex> ] action ; "0x" token hide hexdigit digits 2seq [ first hex> ] action ;
: decdigit ( -- parser ) : decdigit ( -- parser )
CHAR: 0 CHAR: 9 range ; ch'0 ch'9 range ;
: dec ( -- parser ) : dec ( -- parser )
decdigit digits [ dec> ] action ; decdigit digits [ dec> ] action ;
: octdigit ( -- parser ) : octdigit ( -- parser )
CHAR: 0 CHAR: 7 range ; ch'0 ch'7 range ;
: oct ( -- parser ) : oct ( -- parser )
"0o" token hide octdigit digits 2seq [ first oct> ] action ; "0o" token hide octdigit digits 2seq [ first oct> ] action ;
: bindigit ( -- parser ) : bindigit ( -- parser )
CHAR: 0 CHAR: 1 range ; ch'0 ch'1 range ;
: bin ( -- parser ) : bin ( -- parser )
"0b" token hide bindigit digits 2seq [ first bin> ] action ; "0b" token hide bindigit digits 2seq [ first bin> ] action ;
@ -80,7 +80,7 @@ TUPLE: entry key value ;
: nan ( -- parser ) : nan ( -- parser )
sign optional "nan" token 2seq sign optional "nan" token 2seq
[ drop NAN: 8000000000000 ] action ; [ drop nan: 8000000000000 ] action ;
: float-parser ( -- parser ) : float-parser ( -- parser )
float +inf -inf nan 4choice ; float +inf -inf nan 4choice ;
@ -106,11 +106,11 @@ TUPLE: entry key value ;
basic-string literal-string 2choice [ "" like ] action ; basic-string literal-string 2choice [ "" like ] action ;
: multi-basic-string ( -- parser ) : multi-basic-string ( -- parser )
escaped unicode [ CHAR: \" = not ] satisfy 3choice repeat0 escaped unicode [ ch'\" = not ] satisfy 3choice repeat0
"\"\"\"" dup surrounded-by ; "\"\"\"" dup surrounded-by ;
: multi-literal-string ( -- parser ) : multi-literal-string ( -- parser )
[ CHAR: ' = not ] satisfy repeat0 [ ch'\' = not ] satisfy repeat0
"'''" dup surrounded-by ; "'''" dup surrounded-by ;
: multi-string ( -- parser ) : multi-string ( -- parser )
@ -203,9 +203,9 @@ DEFER: key-value-parser
: name-parser ( -- parser ) : name-parser ( -- parser )
[ [
CHAR: A CHAR: Z range , ch'A ch'Z range ,
CHAR: a CHAR: z range , ch'a ch'z range ,
CHAR: 0 CHAR: 9 range , ch'0 ch'9 range ,
"_" token [ first ] action , "_" token [ first ] action ,
"-" token [ first ] action , "-" token [ first ] action ,
] choice* repeat1 [ "" like ] action single-string 2choice ; ] choice* repeat1 [ "" like ] action single-string 2choice ;
@ -214,7 +214,7 @@ DEFER: key-value-parser
[ [
space hide , space hide ,
"#" token , "#" token ,
[ CHAR: \n = not ] satisfy repeat0 , [ ch'\n = not ] satisfy repeat0 ,
] seq* [ drop f ] action ; ] seq* [ drop f ] action ;
: key-parser ( -- parser ) : key-parser ( -- parser )

4
extra/ulid/ulid-tests.factor
View File

@ -15,11 +15,11 @@ IN: ulid.tests
] must-fail-with ] must-fail-with
[ "aBCDEFGH1JK1MN0PQRSTUVWXYZ" ulid>bytes ] [ [ "aBCDEFGH1JK1MN0PQRSTUVWXYZ" ulid>bytes ] [
[ ulid>bytes-bad-character? ] keep ch>> CHAR: a = and [ ulid>bytes-bad-character? ] keep ch>> ch'a = and
] must-fail-with ] must-fail-with
[ "ABCDEFGH1JK1MN0PQRSTUVWXYZ" ulid>bytes ] [ [ "ABCDEFGH1JK1MN0PQRSTUVWXYZ" ulid>bytes ] [
[ ulid>bytes-bad-character? ] keep ch>> CHAR: U = and [ ulid>bytes-bad-character? ] keep ch>> ch'U = and
] must-fail-with ] must-fail-with
[ "ABCDEFGH1JK1MN0PQRST0VWXYZ" ulid>bytes ] [ "ABCDEFGH1JK1MN0PQRST0VWXYZ" ulid>bytes ]