factor: CHAR: : -> CHAR: \:, same for [{(

modern-harvey2
Doug Coleman 2017-08-26 01:46:04 -05:00
parent f049487021
commit 84e40810cd
28 changed files with 54 additions and 54 deletions

View File

@ -37,7 +37,7 @@ ERROR: invalid-timestamp-format ;
[ [
[ [
read-00 hours read-00 hours
read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes read1 { { CHAR: \: [ read-00 ] } { f [ 0 ] } } case minutes
time+ time+
] dip signed-gmt-offset ] dip signed-gmt-offset
] ]

View File

@ -210,8 +210,8 @@ ERROR: no-objc-type name ;
[ [ 1 + ] dip ] [ nth ] 2bi { [ [ 1 + ] dip ] [ nth ] 2bi {
{ [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] } { [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
{ [ dup CHAR: ^ = ] [ 3drop void* ] } { [ dup CHAR: ^ = ] [ 3drop void* ] }
{ [ dup CHAR: { = ] [ drop objc-struct-type ] } { [ dup CHAR: \{ = ] [ drop objc-struct-type ] }
{ [ dup CHAR: [ = ] [ 3drop void* ] } { [ dup CHAR: \[ = ] [ 3drop void* ] }
[ 2nip decode-type ] [ 2nip decode-type ]
} cond ; } cond ;

View File

@ -82,9 +82,9 @@ DEFER: (parse-paragraph)
] dip [ (parse-paragraph) cons ] [ 1list ] if* ; ] dip [ (parse-paragraph) cons ] [ 1list ] if* ;
: parse-big-link ( before after -- link rest ) : parse-big-link ( before after -- link rest )
dup ?first CHAR: [ = dup ?first CHAR: \[ =
[ parse-link ] [ parse-link ]
[ [ CHAR: [ suffix ] [ (parse-paragraph) ] bi* ] [ [ CHAR: \[ suffix ] [ (parse-paragraph) ] bi* ]
if ; if ;
: escape ( before after -- before' after' ) : escape ( before after -- before' after' )
@ -94,7 +94,7 @@ DEFER: (parse-paragraph)
[ nil ] [ [ nil ] [
[ "*_^~%[\\" member? ] find-cut [ [ "*_^~%[\\" member? ] find-cut [
{ {
{ CHAR: [ [ parse-big-link ] } { CHAR: \[ [ parse-big-link ] }
{ CHAR: \\ [ escape ] } { CHAR: \\ [ escape ] }
[ dup delimiter-class parse-delimiter ] [ dup delimiter-class parse-delimiter ]
} case cons } case cons
@ -181,7 +181,7 @@ DEFER: (parse-paragraph)
CHAR: # ordered-list parse-list ; CHAR: # ordered-list parse-list ;
: parse-code ( state -- state' item ) : parse-code ( state -- state' item )
dup 1 look CHAR: [ = dup 1 look CHAR: \[ =
[ unclip-slice make-paragraph ] [ [ unclip-slice make-paragraph ] [
dup "{" take-until [ dup "{" take-until [
[ nip rest ] dip [ nip rest ] dip
@ -197,7 +197,7 @@ DEFER: (parse-paragraph)
{ CHAR: _ [ parse-line ] } { CHAR: _ [ parse-line ] }
{ CHAR: - [ parse-ul ] } { CHAR: - [ parse-ul ] }
{ CHAR: # [ parse-ol ] } { CHAR: # [ parse-ol ] }
{ CHAR: [ [ parse-code ] } { CHAR: \[ [ parse-code ] }
{ f [ rest-slice f ] } { f [ rest-slice f ] }
[ drop unclip-slice make-paragraph ] [ drop unclip-slice make-paragraph ]
} case ; } case ;
@ -212,7 +212,7 @@ CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
{ [ dup empty? ] [ drop invalid-url ] } { [ dup empty? ] [ drop invalid-url ] }
{ [ dup [ 127 > ] any? ] [ drop invalid-url ] } { [ dup [ 127 > ] any? ] [ drop invalid-url ] }
{ [ dup first "/\\" member? ] [ drop invalid-url ] } { [ dup first "/\\" member? ] [ drop invalid-url ] }
{ [ CHAR: : 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 ] [ relative-link-prefix get prepend "" like url-encode ]
} cond ; } cond ;

View File

@ -17,7 +17,7 @@ IN: help.html
dup H{ dup H{
{ CHAR: \" "__quo__" } { CHAR: \" "__quo__" }
{ CHAR: * "__star__" } { CHAR: * "__star__" }
{ CHAR: : "__colon__" } { CHAR: \: "__colon__" }
{ CHAR: < "__lt__" } { CHAR: < "__lt__" }
{ CHAR: > "__gt__" } { CHAR: > "__gt__" }
{ CHAR: ? "__que__" } { CHAR: ? "__que__" }

View File

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

View File

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

View File

@ -109,11 +109,11 @@ DEFER: (read-json-string)
{ object vector object } declare { object vector object } declare
{ {
{ CHAR: \" [ over read-json-string suffix! ] } { CHAR: \" [ over read-json-string suffix! ] }
{ CHAR: [ [ json-open-array ] } { CHAR: \[ [ json-open-array ] }
{ CHAR: , [ v-over-push ] } { CHAR: , [ v-over-push ] }
{ CHAR: ] [ json-close-array ] } { CHAR: ] [ json-close-array ] }
{ CHAR: { [ json-open-hash ] } { CHAR: \{ [ json-open-hash ] }
{ CHAR: : [ v-pick-push ] } { CHAR: \: [ v-pick-push ] }
{ CHAR: } [ json-close-hash ] } { CHAR: } [ json-close-hash ] }
{ CHAR: \s [ ] } { CHAR: \s [ ] }
{ CHAR: \t [ ] } { CHAR: \t [ ] }

View File

@ -111,7 +111,7 @@ M: real stream-json-print
[ >float number>string ] [ stream-write ] bi* ; [ >float number>string ] [ stream-write ] bi* ;
M: sequence stream-json-print M: sequence stream-json-print
CHAR: [ over stream-write1 swap CHAR: \[ over stream-write1 swap
over '[ CHAR: , _ stream-write1 ] over '[ CHAR: , _ stream-write1 ]
pick '[ _ stream-json-print ] interleave pick '[ _ stream-json-print ] interleave
CHAR: ] swap stream-write1 ; CHAR: ] swap stream-write1 ;
@ -130,7 +130,7 @@ M: float json-coerce float>json ;
M: real json-coerce >float number>string ; M: real json-coerce >float number>string ;
:: json-print-assoc ( obj stream -- ) :: json-print-assoc ( obj stream -- )
CHAR: { stream stream-write1 obj >alist CHAR: \{ stream stream-write1 obj >alist
[ CHAR: , stream stream-write1 ] [ CHAR: , stream stream-write1 ]
json-friendly-keys? get json-friendly-keys? get
json-coerce-keys? get '[ json-coerce-keys? get '[
@ -140,7 +140,7 @@ M: real json-coerce >float number>string ;
[ _ [ json-coerce ] when ] if [ _ [ json-coerce ] when ] if
stream stream-json-print stream stream-json-print
] [ ] [
CHAR: : stream stream-write1 CHAR: \: stream stream-write1
stream stream-json-print stream stream-json-print
] bi* ] bi*
] interleave ] interleave

View File

@ -132,7 +132,7 @@ DEFER: make-tag ! Is this unavoidable?
[ take-external-id ] [ f ] if ; [ take-external-id ] [ f ] if ;
: take-internal ( -- dtd/f ) : take-internal ( -- dtd/f )
get-char CHAR: [ eq? get-char CHAR: \[ eq?
[ next take-internal-subset ] [ f ] if ; [ next take-internal-subset ] [ f ] if ;
: take-doctype-decl ( -- doctype-decl ) : take-doctype-decl ( -- doctype-decl )
@ -152,7 +152,7 @@ DEFER: make-tag ! Is this unavoidable?
: direct ( -- object ) : direct ( -- object )
get-char { get-char {
{ CHAR: - [ take-comment ] } { CHAR: - [ take-comment ] }
{ CHAR: [ [ take-cdata ] } { CHAR: \[ [ take-cdata ] }
[ drop take-directive ] [ drop take-directive ]
} case ; } case ;

View File

@ -65,8 +65,8 @@ SYMBOL: ns-stack
} 2&& [ f <name> ] [ 2drop f ] if ; } 2&& [ f <name> ] [ 2drop f ] if ;
: prefixed-name ( str -- name/f ) : prefixed-name ( str -- name/f )
CHAR: : over index [ CHAR: \: over index [
CHAR: : 2over 1 + swap index-from CHAR: \: 2over 1 + swap index-from
[ 2drop f ] [ 2drop f ]
[ [ head ] [ 1 + tail ] 2bi maybe-name ] [ [ head ] [ 1 + tail ] 2bi maybe-name ]
if if

View File

@ -34,7 +34,7 @@ DEFER: read-bencode
] [ ] produce nip >hashtable ; ] [ ] produce nip >hashtable ;
: read-string ( prefix -- obj ) : read-string ( prefix -- obj )
":" read-until CHAR: : assert= swap prefix ":" read-until CHAR: \: assert= swap prefix
string>number read ascii decode ; string>number read ascii decode ;
: read-bencode ( -- obj ) : read-bencode ( -- obj )

View File

@ -74,7 +74,7 @@ CONSTANT: default-uuids-to-cache 100
default-couch-host default-couch-port <server> ; default-couch-host default-couch-port <server> ;
: (server-url) ( server -- ) : (server-url) ( server -- )
"http://" % [ host>> % ] [ CHAR: : , port>> number>string % ] bi CHAR: / , ; inline "http://" % [ host>> % ] [ CHAR: \: , port>> number>string % ] bi CHAR: / , ; inline
: server-url ( server -- url ) : server-url ( server -- url )
[ (server-url) ] "" make ; [ (server-url) ] "" make ;

View File

@ -74,9 +74,9 @@ CONSTANT: CHARS H{
{ CHAR: \" 0x201E } { CHAR: \" 0x201E }
{ CHAR: . 0x02D9 } { CHAR: . 0x02D9 }
{ CHAR: ; 0x061B } { CHAR: ; 0x061B }
{ CHAR: [ CHAR: ] } { CHAR: \[ CHAR: ] }
{ CHAR: ( CHAR: ) } { CHAR: ( CHAR: ) }
{ CHAR: { CHAR: } } { CHAR: \{ CHAR: } }
{ CHAR: ? 0x00BF } { CHAR: ? 0x00BF }
{ CHAR: ! 0x00A1 } { CHAR: ! 0x00A1 }
{ CHAR: ' CHAR: , } { CHAR: ' CHAR: , }

View File

@ -35,7 +35,7 @@ CONSTANT: A_WHOIS CHAR: w
CONSTANT: A_QUERY CHAR: q CONSTANT: A_QUERY CHAR: q
CONSTANT: A_GIF CHAR: g CONSTANT: A_GIF CHAR: g
CONSTANT: A_WWW CHAR: w CONSTANT: A_WWW CHAR: w
CONSTANT: A_PLUS_IMAGE CHAR: : CONSTANT: A_PLUS_IMAGE CHAR: \:
CONSTANT: A_PLUS_MOVIE CHAR: ; CONSTANT: A_PLUS_MOVIE CHAR: ;
CONSTANT: A_PLUS_SOUND CHAR: < CONSTANT: A_PLUS_SOUND CHAR: <

View File

@ -25,7 +25,7 @@ IN: hashcash
! Random salt is formed by ascii characters ! Random salt is formed by ascii characters
! between 33 and 126 ! between 33 and 126
: available-chars ( -- seq ) : available-chars ( -- seq )
33 126 [a,b] [ CHAR: : = ] reject ; 33 126 [a,b] [ CHAR: \: = ] reject ;
PRIVATE> PRIVATE>

View File

@ -8,7 +8,7 @@ IN: infix.tokenizer.tests
{ V{ T{ ast-value f 3 } CHAR: / CHAR: ( T{ ast-value f 3 } CHAR: + T{ ast-value f 4 } CHAR: ) } } { V{ T{ ast-value f 3 } CHAR: / CHAR: ( T{ ast-value f 3 } CHAR: + T{ ast-value f 4 } CHAR: ) } }
[ "3/(3+4)" tokenize-infix ] unit-test [ "3/(3+4)" tokenize-infix ] unit-test
{ V{ "foo" CHAR: ( "x" CHAR: , "y" CHAR: , "z" CHAR: ) } } [ "foo(x,y,z)" tokenize-infix ] unit-test { V{ "foo" CHAR: ( "x" CHAR: , "y" CHAR: , "z" CHAR: ) } } [ "foo(x,y,z)" tokenize-infix ] unit-test
{ V{ "arr" CHAR: [ "x" CHAR: + T{ ast-value f 3 } CHAR: ] } } { V{ "arr" CHAR: \[ "x" CHAR: + T{ ast-value f 3 } CHAR: ] } }
[ "arr[x+3]" tokenize-infix ] unit-test [ "arr[x+3]" tokenize-infix ] unit-test
[ "1.0.4" tokenize-infix ] must-fail [ "1.0.4" tokenize-infix ] must-fail
{ V{ CHAR: + CHAR: ] T{ ast-value f 3.4 } CHAR: , "bar" } } { V{ CHAR: + CHAR: ] T{ ast-value f 3.4 } CHAR: , "bar" } }

View File

@ -17,8 +17,8 @@ NameFirst = Letter | "_" => [[ CHAR: _ ]]
NameRest = NameFirst | Digit NameRest = NameFirst | Digit
Name = NameFirst NameRest* => [[ first2 swap prefix >string ]] Name = NameFirst NameRest* => [[ first2 swap prefix >string ]]
Special = [+*/%(),] | "-" => [[ CHAR: - ]] Special = [+*/%(),] | "-" => [[ CHAR: - ]]
| "[" => [[ CHAR: [ ]] | "]" => [[ CHAR: ] ]] | "[" => [[ CHAR: \[ ]] | "]" => [[ CHAR: ] ]]
| ":" => [[ CHAR: : ]] | ":" => [[ CHAR: \: ]]
Tok = Spaces (Name | Number | String | Special ) Tok = Spaces (Name | Number | String | Special )
End = !(.) End = !(.)
Toks = Tok* Spaces End Toks = Tok* Spaces End

View File

@ -23,7 +23,7 @@ IN: ini-file
{ CHAR: \\ CHAR: \\ } { CHAR: \\ CHAR: \\ }
{ CHAR: ? CHAR: ? } { CHAR: ? CHAR: ? }
{ CHAR: ; CHAR: ; } { CHAR: ; CHAR: ; }
{ CHAR: [ CHAR: [ } { CHAR: \[ CHAR: \[ }
{ CHAR: ] CHAR: ] } { CHAR: ] CHAR: ] }
{ CHAR: = CHAR: = } { CHAR: = CHAR: = }
} ?at [ bad-escape ] unless ; } ?at [ bad-escape ] unless ;
@ -54,7 +54,7 @@ USE: xml.entities
{ CHAR: \\ "\\\\" } { CHAR: \\ "\\\\" }
{ CHAR: ? "\\?" } { CHAR: ? "\\?" }
{ CHAR: ; "\\;" } { CHAR: ; "\\;" }
{ CHAR: [ "\\[" } { CHAR: \[ "\\[" }
{ CHAR: ] "\\]" } { CHAR: ] "\\]" }
{ CHAR: = "\\=" } { CHAR: = "\\=" }
} escape-string-by ; } escape-string-by ;
@ -87,7 +87,7 @@ SYMBOL: option
: section? ( line -- index/f ) : section? ( line -- index/f )
{ {
[ length 1 > ] [ length 1 > ]
[ first CHAR: [ = ] [ first CHAR: \[ = ]
[ CHAR: ] swap last-index ] [ CHAR: ] swap last-index ]
} 1&& ; } 1&& ;

View File

@ -81,7 +81,7 @@ M: irc-message set-irc-command
[ prefix>> ] [ prefix>> ]
[ command>> ] [ command>> ]
[ parameters>> " " join ] [ parameters>> " " join ]
[ trailing>> dup [ CHAR: : prefix ] when ] [ trailing>> dup [ CHAR: \: prefix ] when ]
} cleave 4array sift " " join ; } cleave 4array sift " " join ;
<PRIVATE <PRIVATE

View File

@ -6,7 +6,7 @@ ui.gadgets.labels ;
IN: lcd IN: lcd
: lcd-digit ( digit row -- str ) : lcd-digit ( digit row -- str )
[ dup CHAR: : = [ drop 10 ] [ CHAR: 0 - ] if ] dip { [ dup CHAR: \: = [ drop 10 ] [ CHAR: 0 - ] if ] dip {
" _ _ _ _ _ _ _ _ " " _ _ _ _ _ _ _ _ "
" | | | _| _| |_| |_ |_ | |_| |_| * " " | | | _| _| |_| |_ |_ | |_| |_| * "
" |_| | |_ _| | _| |_| | |_| | * " " |_| | |_ _| | _| |_| | |_| | * "

View File

@ -45,8 +45,8 @@ MACRO:: read-double-matched ( open-ch -- quot: ( n string tag ch -- n' string se
] ; ] ;
: read-double-matched-paren ( n string tag ch -- n' string seq ) CHAR: ( read-double-matched ; : read-double-matched-paren ( n string tag ch -- n' string seq ) CHAR: ( read-double-matched ;
: read-double-matched-bracket ( n string tag ch -- n' string seq ) CHAR: [ read-double-matched ; : read-double-matched-bracket ( n string tag ch -- n' string seq ) CHAR: \[ read-double-matched ;
: read-double-matched-brace ( n string tag ch -- n' string seq ) CHAR: { read-double-matched ; : read-double-matched-brace ( n string tag ch -- n' string seq ) CHAR: \{ read-double-matched ;
DEFER: lex-factor DEFER: lex-factor
ERROR: lex-expected-but-got-eof n string expected ; ERROR: lex-expected-but-got-eof n string expected ;
@ -103,8 +103,8 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
} cond } cond
] ; ] ;
: read-bracket ( n string slice -- n' string slice' ) CHAR: [ read-matched ; : read-bracket ( n string slice -- n' string slice' ) CHAR: \[ read-matched ;
: read-brace ( n string slice -- n' string slice' ) CHAR: { read-matched ; : read-brace ( n string slice -- n' string slice' ) CHAR: \{ read-matched ;
: read-paren ( n string slice -- n' string slice' ) CHAR: ( read-matched ; : read-paren ( n string slice -- n' string slice' ) CHAR: ( read-matched ;
: read-string-payload ( n string -- n' string ) : read-string-payload ( n string -- n' string )
over [ over [
@ -126,7 +126,7 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
tag 1 cut-slice* 4array ; tag 1 cut-slice* 4array ;
: take-comment ( n string slice -- n' string comment ) : take-comment ( n string slice -- n' string comment )
2over ?nth CHAR: [ = [ 2over ?nth CHAR: \[ = [
[ 1 + ] 2dip 2over ?nth read-double-matched-bracket [ 1 + ] 2dip 2over ?nth read-double-matched-bracket
] [ ] [
[ slice-til-eol drop ] dip swap 2array [ slice-til-eol drop ] dip swap 2array
@ -233,7 +233,7 @@ ERROR: mismatched-terminator n string slice ;
{ CHAR: " [ read-string ] } { CHAR: " [ read-string ] }
{ CHAR: \ [ read-backslash ] } { CHAR: \ [ read-backslash ] }
{ CHAR: ! [ read-exclamation ] } { CHAR: ! [ read-exclamation ] }
{ CHAR: : [ { CHAR: \: [
dup strict-upper? strict-upper get and [ dup strict-upper? strict-upper get and [
length swap [ - ] dip f length swap [ - ] dip f
strict-upper off strict-upper off
@ -267,8 +267,8 @@ ERROR: mismatched-terminator n string slice ;
[ slice-til-whitespace drop ] dip span-slices ! >= >> etc [ slice-til-whitespace drop ] dip span-slices ! >= >> etc
] if ] if
] } ] }
{ CHAR: [ [ read-bracket ] } { CHAR: \[ [ read-bracket ] }
{ CHAR: { [ read-brace ] } { CHAR: \{ [ read-brace ] }
{ CHAR: ( [ read-paren ] } { CHAR: ( [ read-paren ] }
{ CHAR: \s [ read-token-or-whitespace ] } { CHAR: \s [ read-token-or-whitespace ] }
{ CHAR: \r [ read-token-or-whitespace ] } { CHAR: \r [ read-token-or-whitespace ] }

View File

@ -10,10 +10,10 @@ IN: modern.slices
: matching-delimiter ( ch -- ch' ) : matching-delimiter ( ch -- ch' )
H{ H{
{ CHAR: ( CHAR: ) } { CHAR: ( CHAR: ) }
{ CHAR: [ CHAR: ] } { CHAR: \[ CHAR: ] }
{ CHAR: { CHAR: } } { CHAR: \{ CHAR: } }
{ CHAR: < CHAR: > } { CHAR: < CHAR: > }
{ CHAR: : CHAR: ; } { CHAR: \: CHAR: ; }
} ?at drop ; } ?at drop ;
: matching-delimiter-string ( string -- string' ) : matching-delimiter-string ( string -- string' )

View File

@ -65,7 +65,7 @@ CONSTANT: morse-code-table $[
{ CHAR: ( "-.--." } { CHAR: ( "-.--." }
{ CHAR: ) "-.--.-" } { CHAR: ) "-.--.-" }
{ CHAR: & ".-..." } { CHAR: & ".-..." }
{ CHAR: : "---..." } { CHAR: \: "---..." }
{ CHAR: ; "-.-.-." } { CHAR: ; "-.-.-." }
{ CHAR: = "-...- " } { CHAR: = "-...- " }
{ CHAR: + ".-.-." } { CHAR: + ".-.-." }

View File

@ -30,7 +30,7 @@ PRIVATE>
: read-response ( -- response ) : read-response ( -- response )
readln unclip { readln unclip {
{ CHAR: : [ string>number ] } { CHAR: \: [ string>number ] }
{ CHAR: + [ handle-response ] } { CHAR: + [ handle-response ] }
{ CHAR: $ [ string>number read-bulk ] } { CHAR: $ [ string>number read-bulk ] }
{ CHAR: * [ string>number read-multi-bulk ] } { CHAR: * [ string>number read-multi-bulk ] }

View File

@ -26,7 +26,7 @@ IN: rosetta-code.balanced-brackets
t :> ok! t :> ok!
str [ str [
{ {
{ CHAR: [ [ 1 ] } { CHAR: \[ [ 1 ] }
{ CHAR: ] [ -1 ] } { CHAR: ] [ -1 ] }
[ drop 0 ] [ drop 0 ]
} case counter + counter! } case counter + counter!

View File

@ -9,7 +9,7 @@ SYMBOLS: unary binary keyword ;
: selector-type ( selector -- type ) : selector-type ( selector -- type )
{ {
{ [ dup [ "~!@%&*-+=|\\<>,?/" member? ] all? ] [ binary ] } { [ dup [ "~!@%&*-+=|\\<>,?/" member? ] all? ] [ binary ] }
{ [ CHAR: : over member? ] [ keyword ] } { [ CHAR: \: over member? ] [ keyword ] }
[ unary ] [ unary ]
} cond nip ; } cond nip ;
@ -17,7 +17,7 @@ SYMBOLS: unary binary keyword ;
dup selector-type { dup selector-type {
{ unary [ drop { } ] } { unary [ drop { } ] }
{ binary [ drop { "x" } ] } { binary [ drop { "x" } ] }
{ keyword [ [ CHAR: : = ] count "x" <array> ] } { keyword [ [ CHAR: \: = ] count "x" <array> ] }
} case "receiver" suffix { "result" } <effect> ; } case "receiver" suffix { "result" } <effect> ;
: selector>generic ( selector -- generic ) : selector>generic ( selector -- generic )

View File

@ -32,7 +32,7 @@ DEFER: name/values
: parse-value ( string -- remain value ) : parse-value ( string -- remain value )
dup find-` [ dup find-` [
dup 1 - pick ?nth CHAR: : = dup 1 - pick ?nth CHAR: \: =
[ drop name/values ] [ cut swap (parse-value) ] if [ drop name/values ] [ cut swap (parse-value) ] if
[ rest [ blank? ] trim-head ] dip [ rest [ blank? ] trim-head ] dip
] [ f swap ] if* ; ] [ f swap ] if* ;

View File

@ -111,7 +111,7 @@ CONSTANT: YAML_SET_TAG "tag:yaml.org,2002:set"
R/ -[0-9][^0-9]/ [ [ CHAR: 0 1 ] dip insert-nth ] re-replace-with R/ -[0-9][^0-9]/ [ [ CHAR: 0 1 ] dip insert-nth ] re-replace-with
R/ [^0-9][0-9]:/ [ [ CHAR: 0 1 ] dip insert-nth ] re-replace-with R/ [^0-9][0-9]:/ [ [ CHAR: 0 1 ] dip insert-nth ] re-replace-with
R/ [ \t]+/ " " re-replace R/ [ \t]+/ " " re-replace
CHAR: : over index cut CHAR: space swap remove append ; CHAR: \: over index cut CHAR: space swap remove append ;
: construct-timestamp ( obj -- obj' ) : construct-timestamp ( obj -- obj' )
dup R/ [0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]/ matches? dup R/ [0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]/ matches?