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
read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
read1 { { CHAR: \: [ read-00 ] } { f [ 0 ] } } case minutes
time+
] dip signed-gmt-offset
]

View File

@ -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 ;

View File

@ -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 ;

View File

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

View File

@ -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 ;

View File

@ -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 ]

View File

@ -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 [ ] }

View File

@ -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

View File

@ -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 ;

View File

@ -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

View File

@ -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 )

View File

@ -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 ;

View File

@ -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: , }

View File

@ -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: <

View File

@ -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>

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: ) } }
[ "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" } }

View File

@ -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

View File

@ -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&& ;

View File

@ -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

View File

@ -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 {
" _ _ _ _ _ _ _ _ "
" | | | _| _| |_| |_ |_ | |_| |_| * "
" |_| | |_ _| | _| |_| | |_| | * "

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-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 ] }

View File

@ -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' )

View File

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

View File

@ -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 ] }

View File

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

View File

@ -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 )

View File

@ -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* ;

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/ [ \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?