factor: CHAR: : -> CHAR: \:, same for [{(
parent
f049487021
commit
84e40810cd
|
@ -37,7 +37,7 @@ ERROR: invalid-timestamp-format ;
|
|||
[
|
||||
[
|
||||
read-00 hours
|
||||
read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
|
||||
read1 { { CHAR: \: [ read-00 ] } { f [ 0 ] } } case minutes
|
||||
time+
|
||||
] dip signed-gmt-offset
|
||||
]
|
||||
|
|
|
@ -210,8 +210,8 @@ ERROR: no-objc-type name ;
|
|||
[ [ 1 + ] dip ] [ nth ] 2bi {
|
||||
{ [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
|
||||
{ [ dup CHAR: ^ = ] [ 3drop void* ] }
|
||||
{ [ dup CHAR: { = ] [ drop objc-struct-type ] }
|
||||
{ [ dup CHAR: [ = ] [ 3drop void* ] }
|
||||
{ [ dup CHAR: \{ = ] [ drop objc-struct-type ] }
|
||||
{ [ dup CHAR: \[ = ] [ 3drop void* ] }
|
||||
[ 2nip decode-type ]
|
||||
} cond ;
|
||||
|
||||
|
|
|
@ -82,9 +82,9 @@ DEFER: (parse-paragraph)
|
|||
] dip [ (parse-paragraph) cons ] [ 1list ] if* ;
|
||||
|
||||
: parse-big-link ( before after -- link rest )
|
||||
dup ?first CHAR: [ =
|
||||
dup ?first CHAR: \[ =
|
||||
[ parse-link ]
|
||||
[ [ CHAR: [ suffix ] [ (parse-paragraph) ] bi* ]
|
||||
[ [ CHAR: \[ suffix ] [ (parse-paragraph) ] bi* ]
|
||||
if ;
|
||||
|
||||
: escape ( before after -- before' after' )
|
||||
|
@ -94,7 +94,7 @@ DEFER: (parse-paragraph)
|
|||
[ nil ] [
|
||||
[ "*_^~%[\\" member? ] find-cut [
|
||||
{
|
||||
{ CHAR: [ [ parse-big-link ] }
|
||||
{ CHAR: \[ [ parse-big-link ] }
|
||||
{ CHAR: \\ [ escape ] }
|
||||
[ dup delimiter-class parse-delimiter ]
|
||||
} case cons
|
||||
|
@ -181,7 +181,7 @@ DEFER: (parse-paragraph)
|
|||
CHAR: # ordered-list parse-list ;
|
||||
|
||||
: parse-code ( state -- state' item )
|
||||
dup 1 look CHAR: [ =
|
||||
dup 1 look CHAR: \[ =
|
||||
[ unclip-slice make-paragraph ] [
|
||||
dup "{" take-until [
|
||||
[ nip rest ] dip
|
||||
|
@ -197,7 +197,7 @@ DEFER: (parse-paragraph)
|
|||
{ CHAR: _ [ parse-line ] }
|
||||
{ CHAR: - [ parse-ul ] }
|
||||
{ CHAR: # [ parse-ol ] }
|
||||
{ CHAR: [ [ parse-code ] }
|
||||
{ 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 ] }
|
||||
{ [ 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 ]
|
||||
} cond ;
|
||||
|
||||
|
|
|
@ -17,7 +17,7 @@ IN: help.html
|
|||
dup H{
|
||||
{ CHAR: \" "__quo__" }
|
||||
{ CHAR: * "__star__" }
|
||||
{ CHAR: : "__colon__" }
|
||||
{ CHAR: \: "__colon__" }
|
||||
{ CHAR: < "__lt__" }
|
||||
{ CHAR: > "__gt__" }
|
||||
{ CHAR: ? "__que__" }
|
||||
|
|
|
@ -147,7 +147,7 @@ ERROR: not-absolute-path ;
|
|||
unicode-prefix ?head drop
|
||||
dup {
|
||||
[ length 2 >= ]
|
||||
[ second CHAR: : = ]
|
||||
[ second CHAR: \: = ]
|
||||
[ first Letter? ]
|
||||
} 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;
|
||||
|
||||
|
|
|
@ -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 CHAR: : = ] } 1&& ] [ drop t ] }
|
||||
[ second CHAR: \: = ] } 1&& ] [ drop t ] }
|
||||
{ [ dup unicode-prefix head? ]
|
||||
[ trim-tail-separators length unicode-prefix length 2 + = ] }
|
||||
[ drop f ]
|
||||
|
|
|
@ -109,11 +109,11 @@ DEFER: (read-json-string)
|
|||
{ object vector object } declare
|
||||
{
|
||||
{ CHAR: \" [ over read-json-string suffix! ] }
|
||||
{ CHAR: [ [ json-open-array ] }
|
||||
{ CHAR: \[ [ json-open-array ] }
|
||||
{ CHAR: , [ v-over-push ] }
|
||||
{ CHAR: ] [ json-close-array ] }
|
||||
{ CHAR: { [ json-open-hash ] }
|
||||
{ CHAR: : [ v-pick-push ] }
|
||||
{ CHAR: \{ [ json-open-hash ] }
|
||||
{ CHAR: \: [ v-pick-push ] }
|
||||
{ CHAR: } [ json-close-hash ] }
|
||||
{ CHAR: \s [ ] }
|
||||
{ CHAR: \t [ ] }
|
||||
|
|
|
@ -111,7 +111,7 @@ M: real stream-json-print
|
|||
[ >float number>string ] [ stream-write ] bi* ;
|
||||
|
||||
M: sequence stream-json-print
|
||||
CHAR: [ over stream-write1 swap
|
||||
CHAR: \[ over stream-write1 swap
|
||||
over '[ CHAR: , _ stream-write1 ]
|
||||
pick '[ _ stream-json-print ] interleave
|
||||
CHAR: ] swap stream-write1 ;
|
||||
|
@ -130,7 +130,7 @@ M: float json-coerce float>json ;
|
|||
M: real json-coerce >float number>string ;
|
||||
|
||||
:: json-print-assoc ( obj stream -- )
|
||||
CHAR: { stream stream-write1 obj >alist
|
||||
CHAR: \{ stream stream-write1 obj >alist
|
||||
[ CHAR: , stream stream-write1 ]
|
||||
json-friendly-keys? get
|
||||
json-coerce-keys? get '[
|
||||
|
@ -140,7 +140,7 @@ M: real json-coerce >float number>string ;
|
|||
[ _ [ json-coerce ] when ] if
|
||||
stream stream-json-print
|
||||
] [
|
||||
CHAR: : stream stream-write1
|
||||
CHAR: \: stream stream-write1
|
||||
stream stream-json-print
|
||||
] bi*
|
||||
] interleave
|
||||
|
|
|
@ -132,7 +132,7 @@ DEFER: make-tag ! Is this unavoidable?
|
|||
[ take-external-id ] [ f ] if ;
|
||||
|
||||
: take-internal ( -- dtd/f )
|
||||
get-char CHAR: [ eq?
|
||||
get-char CHAR: \[ eq?
|
||||
[ next take-internal-subset ] [ f ] if ;
|
||||
|
||||
: take-doctype-decl ( -- doctype-decl )
|
||||
|
@ -152,7 +152,7 @@ DEFER: make-tag ! Is this unavoidable?
|
|||
: direct ( -- object )
|
||||
get-char {
|
||||
{ CHAR: - [ take-comment ] }
|
||||
{ CHAR: [ [ take-cdata ] }
|
||||
{ CHAR: \[ [ take-cdata ] }
|
||||
[ drop take-directive ]
|
||||
} case ;
|
||||
|
||||
|
|
|
@ -65,8 +65,8 @@ SYMBOL: ns-stack
|
|||
} 2&& [ f <name> ] [ 2drop f ] if ;
|
||||
|
||||
: prefixed-name ( str -- name/f )
|
||||
CHAR: : over index [
|
||||
CHAR: : 2over 1 + swap index-from
|
||||
CHAR: \: over index [
|
||||
CHAR: \: 2over 1 + swap index-from
|
||||
[ 2drop f ]
|
||||
[ [ head ] [ 1 + tail ] 2bi maybe-name ]
|
||||
if
|
||||
|
|
|
@ -34,7 +34,7 @@ DEFER: read-bencode
|
|||
] [ ] produce nip >hashtable ;
|
||||
|
||||
: read-string ( prefix -- obj )
|
||||
":" read-until CHAR: : assert= swap prefix
|
||||
":" read-until CHAR: \: assert= swap prefix
|
||||
string>number read ascii decode ;
|
||||
|
||||
: read-bencode ( -- obj )
|
||||
|
|
|
@ -74,7 +74,7 @@ CONSTANT: default-uuids-to-cache 100
|
|||
default-couch-host default-couch-port <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) ] "" make ;
|
||||
|
|
|
@ -74,9 +74,9 @@ CONSTANT: CHARS H{
|
|||
{ CHAR: \" 0x201E }
|
||||
{ CHAR: . 0x02D9 }
|
||||
{ CHAR: ; 0x061B }
|
||||
{ CHAR: [ CHAR: ] }
|
||||
{ CHAR: \[ CHAR: ] }
|
||||
{ CHAR: ( CHAR: ) }
|
||||
{ CHAR: { CHAR: } }
|
||||
{ CHAR: \{ CHAR: } }
|
||||
{ CHAR: ? 0x00BF }
|
||||
{ CHAR: ! 0x00A1 }
|
||||
{ CHAR: ' CHAR: , }
|
||||
|
|
|
@ -35,7 +35,7 @@ CONSTANT: A_WHOIS CHAR: w
|
|||
CONSTANT: A_QUERY CHAR: q
|
||||
CONSTANT: A_GIF CHAR: g
|
||||
CONSTANT: A_WWW CHAR: w
|
||||
CONSTANT: A_PLUS_IMAGE CHAR: :
|
||||
CONSTANT: A_PLUS_IMAGE CHAR: \:
|
||||
CONSTANT: A_PLUS_MOVIE CHAR: ;
|
||||
CONSTANT: A_PLUS_SOUND CHAR: <
|
||||
|
||||
|
|
|
@ -25,7 +25,7 @@ IN: hashcash
|
|||
! Random salt is formed by ascii characters
|
||||
! between 33 and 126
|
||||
: available-chars ( -- seq )
|
||||
33 126 [a,b] [ CHAR: : = ] reject ;
|
||||
33 126 [a,b] [ CHAR: \: = ] reject ;
|
||||
|
||||
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: ) } }
|
||||
[ "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{ "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
|
||||
[ "1.0.4" tokenize-infix ] must-fail
|
||||
{ V{ CHAR: + CHAR: ] T{ ast-value f 3.4 } CHAR: , "bar" } }
|
||||
|
|
|
@ -17,8 +17,8 @@ NameFirst = Letter | "_" => [[ CHAR: _ ]]
|
|||
NameRest = NameFirst | Digit
|
||||
Name = NameFirst NameRest* => [[ first2 swap prefix >string ]]
|
||||
Special = [+*/%(),] | "-" => [[ CHAR: - ]]
|
||||
| "[" => [[ CHAR: [ ]] | "]" => [[ CHAR: ] ]]
|
||||
| ":" => [[ CHAR: : ]]
|
||||
| "[" => [[ CHAR: \[ ]] | "]" => [[ CHAR: ] ]]
|
||||
| ":" => [[ CHAR: \: ]]
|
||||
Tok = Spaces (Name | Number | String | Special )
|
||||
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: = }
|
||||
} ?at [ bad-escape ] unless ;
|
||||
|
@ -54,7 +54,7 @@ USE: xml.entities
|
|||
{ CHAR: \\ "\\\\" }
|
||||
{ CHAR: ? "\\?" }
|
||||
{ CHAR: ; "\\;" }
|
||||
{ CHAR: [ "\\[" }
|
||||
{ CHAR: \[ "\\[" }
|
||||
{ CHAR: ] "\\]" }
|
||||
{ CHAR: = "\\=" }
|
||||
} escape-string-by ;
|
||||
|
@ -87,7 +87,7 @@ SYMBOL: option
|
|||
: section? ( line -- index/f )
|
||||
{
|
||||
[ length 1 > ]
|
||||
[ first CHAR: [ = ]
|
||||
[ first CHAR: \[ = ]
|
||||
[ CHAR: ] swap last-index ]
|
||||
} 1&& ;
|
||||
|
||||
|
|
|
@ -81,7 +81,7 @@ M: irc-message set-irc-command
|
|||
[ prefix>> ]
|
||||
[ command>> ]
|
||||
[ parameters>> " " join ]
|
||||
[ trailing>> dup [ CHAR: : prefix ] when ]
|
||||
[ trailing>> dup [ CHAR: \: prefix ] when ]
|
||||
} cleave 4array sift " " join ;
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
@ -6,7 +6,7 @@ ui.gadgets.labels ;
|
|||
IN: lcd
|
||||
|
||||
: 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-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-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 ;
|
||||
|
||||
DEFER: lex-factor
|
||||
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
|
||||
] ;
|
||||
|
||||
: read-bracket ( n string slice -- n' string slice' ) CHAR: [ read-matched ;
|
||||
: read-brace ( 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-paren ( n string slice -- n' string slice' ) CHAR: ( read-matched ;
|
||||
: read-string-payload ( n string -- n' string )
|
||||
over [
|
||||
|
@ -126,7 +126,7 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
|
|||
tag 1 cut-slice* 4array ;
|
||||
|
||||
: take-comment ( n string slice -- n' string comment )
|
||||
2over ?nth CHAR: [ = [
|
||||
2over ?nth CHAR: \[ = [
|
||||
[ 1 + ] 2dip 2over ?nth read-double-matched-bracket
|
||||
] [
|
||||
[ slice-til-eol drop ] dip swap 2array
|
||||
|
@ -233,7 +233,7 @@ ERROR: mismatched-terminator n string slice ;
|
|||
{ CHAR: " [ read-string ] }
|
||||
{ CHAR: \ [ read-backslash ] }
|
||||
{ CHAR: ! [ read-exclamation ] }
|
||||
{ CHAR: : [
|
||||
{ CHAR: \: [
|
||||
dup strict-upper? strict-upper get and [
|
||||
length swap [ - ] dip f
|
||||
strict-upper off
|
||||
|
@ -267,8 +267,8 @@ ERROR: mismatched-terminator n string slice ;
|
|||
[ slice-til-whitespace drop ] dip span-slices ! >= >> etc
|
||||
] if
|
||||
] }
|
||||
{ CHAR: [ [ read-bracket ] }
|
||||
{ CHAR: { [ read-brace ] }
|
||||
{ CHAR: \[ [ read-bracket ] }
|
||||
{ CHAR: \{ [ read-brace ] }
|
||||
{ CHAR: ( [ read-paren ] }
|
||||
{ CHAR: \s [ read-token-or-whitespace ] }
|
||||
{ CHAR: \r [ read-token-or-whitespace ] }
|
||||
|
|
|
@ -10,10 +10,10 @@ IN: modern.slices
|
|||
: matching-delimiter ( ch -- ch' )
|
||||
H{
|
||||
{ CHAR: ( CHAR: ) }
|
||||
{ CHAR: [ CHAR: ] }
|
||||
{ CHAR: { CHAR: } }
|
||||
{ CHAR: \[ CHAR: ] }
|
||||
{ CHAR: \{ CHAR: } }
|
||||
{ CHAR: < CHAR: > }
|
||||
{ CHAR: : CHAR: ; }
|
||||
{ CHAR: \: CHAR: ; }
|
||||
} ?at drop ;
|
||||
|
||||
: matching-delimiter-string ( string -- string' )
|
||||
|
|
|
@ -65,7 +65,7 @@ CONSTANT: morse-code-table $[
|
|||
{ CHAR: ( "-.--." }
|
||||
{ CHAR: ) "-.--.-" }
|
||||
{ CHAR: & ".-..." }
|
||||
{ CHAR: : "---..." }
|
||||
{ CHAR: \: "---..." }
|
||||
{ CHAR: ; "-.-.-." }
|
||||
{ CHAR: = "-...- " }
|
||||
{ CHAR: + ".-.-." }
|
||||
|
|
|
@ -30,7 +30,7 @@ PRIVATE>
|
|||
|
||||
: read-response ( -- response )
|
||||
readln unclip {
|
||||
{ CHAR: : [ string>number ] }
|
||||
{ CHAR: \: [ string>number ] }
|
||||
{ CHAR: + [ handle-response ] }
|
||||
{ CHAR: $ [ string>number read-bulk ] }
|
||||
{ CHAR: * [ string>number read-multi-bulk ] }
|
||||
|
|
|
@ -26,7 +26,7 @@ IN: rosetta-code.balanced-brackets
|
|||
t :> ok!
|
||||
str [
|
||||
{
|
||||
{ CHAR: [ [ 1 ] }
|
||||
{ CHAR: \[ [ 1 ] }
|
||||
{ CHAR: ] [ -1 ] }
|
||||
[ drop 0 ]
|
||||
} case counter + counter!
|
||||
|
|
|
@ -9,7 +9,7 @@ SYMBOLS: unary binary keyword ;
|
|||
: selector-type ( selector -- type )
|
||||
{
|
||||
{ [ dup [ "~!@%&*-+=|\\<>,?/" member? ] all? ] [ binary ] }
|
||||
{ [ CHAR: : over member? ] [ keyword ] }
|
||||
{ [ CHAR: \: over member? ] [ keyword ] }
|
||||
[ unary ]
|
||||
} cond nip ;
|
||||
|
||||
|
@ -17,7 +17,7 @@ SYMBOLS: unary binary keyword ;
|
|||
dup selector-type {
|
||||
{ unary [ drop { } ] }
|
||||
{ binary [ drop { "x" } ] }
|
||||
{ keyword [ [ CHAR: : = ] count "x" <array> ] }
|
||||
{ keyword [ [ CHAR: \: = ] count "x" <array> ] }
|
||||
} case "receiver" suffix { "result" } <effect> ;
|
||||
|
||||
: selector>generic ( selector -- generic )
|
||||
|
|
|
@ -32,7 +32,7 @@ DEFER: name/values
|
|||
|
||||
: parse-value ( string -- remain value )
|
||||
dup find-` [
|
||||
dup 1 - pick ?nth CHAR: : =
|
||||
dup 1 - pick ?nth CHAR: \: =
|
||||
[ drop name/values ] [ cut swap (parse-value) ] if
|
||||
[ rest [ blank? ] trim-head ] dip
|
||||
] [ 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/ [ \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' )
|
||||
dup R/ [0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]/ matches?
|
||||
|
|
Loading…
Reference in New Issue