factor: CHAR: : -> CHAR: \:, same for [{(
parent
f049487021
commit
84e40810cd
|
@ -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
|
||||||
]
|
]
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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__" }
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ]
|
||||||
|
|
|
@ -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 [ ] }
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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: , }
|
||||||
|
|
|
@ -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: <
|
||||||
|
|
||||||
|
|
|
@ -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>
|
||||||
|
|
||||||
|
|
|
@ -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" } }
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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&& ;
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 {
|
||||||
" _ _ _ _ _ _ _ _ "
|
" _ _ _ _ _ _ _ _ "
|
||||||
" | | | _| _| |_| |_ |_ | |_| |_| * "
|
" | | | _| _| |_| |_ |_ | |_| |_| * "
|
||||||
" |_| | |_ _| | _| |_| | |_| | * "
|
" |_| | |_ _| | _| |_| | |_| | * "
|
||||||
|
|
|
@ -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 ] }
|
||||||
|
|
|
@ -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' )
|
||||||
|
|
|
@ -65,7 +65,7 @@ CONSTANT: morse-code-table $[
|
||||||
{ CHAR: ( "-.--." }
|
{ CHAR: ( "-.--." }
|
||||||
{ CHAR: ) "-.--.-" }
|
{ CHAR: ) "-.--.-" }
|
||||||
{ CHAR: & ".-..." }
|
{ CHAR: & ".-..." }
|
||||||
{ CHAR: : "---..." }
|
{ CHAR: \: "---..." }
|
||||||
{ CHAR: ; "-.-.-." }
|
{ CHAR: ; "-.-.-." }
|
||||||
{ CHAR: = "-...- " }
|
{ CHAR: = "-...- " }
|
||||||
{ CHAR: + ".-.-." }
|
{ CHAR: + ".-.-." }
|
||||||
|
|
|
@ -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 ] }
|
||||||
|
|
|
@ -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!
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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* ;
|
||||||
|
|
|
@ -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?
|
||||||
|
|
Loading…
Reference in New Issue