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

View File

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

View File

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

View File

@ -21,7 +21,7 @@ CONSTANT: alphabet $[ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567" >byte-array ]
alphabet nth ; inline
: 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
: encode5 ( seq -- byte-array )
@ -31,7 +31,7 @@ CONSTANT: alphabet $[ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567" >byte-array ]
: encode-pad ( seq n -- byte-array )
[ 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 -- )
5 pick stream-read dup length {
@ -52,14 +52,14 @@ PRIVATE>
: decode8 ( seq -- )
[ 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
: (decode-base32) ( stream -- )
8 "\n\r" pick read-ignoring dup length {
{ 0 [ 2drop ] }
{ 8 [ decode8 (decode-base32) ] }
[ drop 8 CHAR: = pad-tail decode8 (decode-base32) ]
[ drop 8 ch'= pad-tail decode8 (decode-base32) ]
} case ;
PRIVATE>

View File

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

View File

@ -34,13 +34,13 @@ math.parser math.ranges tools.test urls ;
{ -4.0 "f9c400" }
{ -4.1 "fbc010666666666666" }
{ 1/0. "f97c00" }
{ NAN: 8000000000000 "f97e00" }
{ nan: 8000000000000 "f97e00" }
{ -1/0. "f9fc00" }
{ 1/0. "fa7f800000" }
{ NAN: 8000000000000 "fa7fc00000" }
{ nan: 8000000000000 "fa7fc00000" }
{ -1/0. "faff800000" }
{ 1/0. "fb7ff0000000000000" }
{ NAN: 8000000000000 "fb7ff8000000000000" }
{ nan: 8000000000000 "fb7ff8000000000000" }
{ -1/0. "fbfff0000000000000" }
{ f "f4" }
{ 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 24 B{ 0x64 0x49 0x45 0x54 0x46 } } "d818456449455446" }
{ URL" http://www.example.com" "d82076687474703a2f2f7777772e6578616d706c652e636f6d" }
{ url"http://www.example.com" "d82076687474703a2f2f7777772e6578616d706c652e636f6d" }
{ B{ } "40" }
{ B{ 1 2 3 4 } "4401020304" }
{ 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" { { "b" "c" } } } "826161bf61626163ff" }
{ { { "Fun" t } { "Amt" -2 } } "bf6346756ef563416d7421ff" }
} [| value hex-string |
} |[ value hex-string |
hex-string hex-string>bytes :> bytes

View File

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

View File

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