steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

factor: decimal: and more

locals-and-roots
Doug Coleman 2016-06-05 18:08:46 -07:00
parent 4a09f254cf
commit 534433b44d
55 changed files with 197 additions and 180 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
benchmarks/benchmark/e-decimals/e-decimals.factor
View File

@ -5,11 +5,11 @@ sequences ;
in: benchmark.e-decimals in: benchmark.e-decimals
: D-factorial ( n -- D! ) : D-factorial ( n -- D! )
iota DECIMAL: 1 [ 0 <decimal> DECIMAL: 1 D+ D* ] reduce ; inline iota decimal: 1 [ 0 <decimal> decimal: 1 D+ D* ] reduce ; inline
:: calculate-e-decimals ( n -- e ) :: calculate-e-decimals ( n -- e )
n [1,b] DECIMAL: 1 n [1,b] decimal: 1
[ D-factorial DECIMAL: 1 swap n D/ D+ ] reduce ; [ D-factorial decimal: 1 swap n D/ D+ ] reduce ;
: e-decimals-benchmark ( -- ) : e-decimals-benchmark ( -- )
5 [ 800 calculate-e-decimals drop ] times ; 5 [ 800 calculate-e-decimals drop ] times ;

12
collections/io/binary/fast/fast.factor
View File

@ -3,12 +3,12 @@
USING: alien.c-types alien.data byte-arrays combinators USING: alien.c-types alien.data byte-arrays combinators
combinators.smart endian fry hints kernel locals macros math combinators.smart endian fry hints kernel locals macros math
math.ranges sequences sequences.generalizations ; math.ranges sequences sequences.generalizations ;
RENAME: be> io.binary => slow-be> RENAME: be> io.binary => slow-be> ;
RENAME: le> io.binary => slow-le> RENAME: le> io.binary => slow-le> ;
RENAME: signed-be> io.binary => slow-signed-be> RENAME: signed-be> io.binary => slow-signed-be> ;
RENAME: signed-le> io.binary => slow-signed-le> RENAME: signed-le> io.binary => slow-signed-le> ;
RENAME: >be io.binary => >slow-be RENAME: >be io.binary => >slow-be ;
RENAME: >le io.binary => >slow-le RENAME: >le io.binary => >slow-le ;
in: io.binary.fast in: io.binary.fast
ERROR: bad-length bytes n ; ERROR: bad-length bytes n ;

2
core/parser/parser-tests.factor
View File

@ -526,7 +526,7 @@ qualified: qualified.tests.bar
QUALIFIED-WITH: qualified.tests.bar p ; QUALIFIED-WITH: qualified.tests.bar p ;
{ 2 } [ p:x ] unit-test { 2 } [ p:x ] unit-test
RENAME: x qualified.tests.baz => y RENAME: x qualified.tests.baz => y ;
{ 3 } [ y ] unit-test { 3 } [ y ] unit-test
FROM: qualified.tests.baz => x ; FROM: qualified.tests.baz => x ;

4
core/strings/parser/parser.factor
View File

@ -22,10 +22,14 @@ ERROR: bad-escape char ;
{ char: 0 char: \0 } { char: 0 char: \0 }
{ char: \\ char: \\ } { char: \\ char: \\ }
{ char: \: char: \: } { char: \: char: \: }
{ char: \; char: \; }
{ char: \" char: \" } { 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 ;

4
core/syntax/syntax-docs.factor
View File

@ -574,12 +574,12 @@ HELP: EXCLUDE:
"EXCLUDE: math.parser => bin> hex> ;" "! imports everything but bin> and hex>" } } ; "EXCLUDE: math.parser => bin> hex> ;" "! imports everything but bin> and hex>" } } ;
HELP: RENAME: HELP: RENAME:
{ $syntax "RENAME: word vocab => new-name" } { $syntax "RENAME: word vocab => new-name ;" }
{ $description "Imports " { $snippet "word" } " from " { $snippet "vocab" } ", but renamed to " { $snippet "new-name" } "." } { $description "Imports " { $snippet "word" } " from " { $snippet "vocab" } ", but renamed to " { $snippet "new-name" } "." }
{ $notes "If adding the words introduces ambiguity, the words will take precedence when resolving any ambiguous names." } { $notes "If adding the words introduces ambiguity, the words will take precedence when resolving any ambiguous names." }
{ $examples { $example { $examples { $example
"USING: prettyprint ;" "USING: prettyprint ;"
"RENAME: + math => -" "RENAME: + math => - ;"
"2 3 - ." "2 3 - ."
"5" "5"
} } ; } } ;

2
core/syntax/syntax.factor
View File

@ -96,7 +96,7 @@ in: bootstrap.syntax
] define-core-syntax ] define-core-syntax
"RENAME:" [ "RENAME:" [
scan-token scan-token "=>" expect scan-token add-renamed-word scan-token scan-token "=>" expect scan-token ";" expect add-renamed-word
] define-core-syntax ] define-core-syntax
"NAN:" [ 16 scan-base <fp-nan> suffix! ] define-core-syntax "NAN:" [ 16 scan-base <fp-nan> suffix! ] define-core-syntax

2
core/vocabs/parser/parser-tests.factor
View File

@ -6,7 +6,7 @@ in: vocabs.parser.tests
[ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ] [ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ]
must-fail-with must-fail-with
[ "RENAME: doesnotexist kernel => newname" eval( -- ) ] [ "RENAME: doesnotexist kernel => newname ;" eval( -- ) ]
[ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ] [ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ]
must-fail-with must-fail-with

2
language/multi-methods/tests/syntax.factor
View File

@ -1,7 +1,7 @@
USING: multi-methods tools.test math sequences namespaces system USING: multi-methods tools.test math sequences namespaces system
kernel strings definitions prettyprint debugger arrays kernel strings definitions prettyprint debugger arrays
hashtables continuations classes assocs accessors see ; hashtables continuations classes assocs accessors see ;
RENAME: GENERIC: multi-methods => multi-methods:GENERIC: RENAME: GENERIC: multi-methods => multi-methods:GENERIC: ;
in: multi-methods.tests in: multi-methods.tests
multi-methods:GENERIC: first-test ( -- ) ; multi-methods:GENERIC: first-test ( -- ) ;

2
libs/bencode/bencode.factor
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 )

2
libs/c/lexer/lexer.factor
View File

@ -40,7 +40,7 @@ in: c.lexer
: take-define-identifier ( sequence-parser -- string ) : take-define-identifier ( sequence-parser -- string )
skip-whitespace/comments skip-whitespace/comments
[ current { [ blank? ] [ char: ( = ] } 1|| ] take-until ; [ current { [ blank? ] [ char: \( = ] } 1|| ] take-until ;
:: take-quoted-string ( sequence-parser escape-char quote-char -- string ) :: take-quoted-string ( sequence-parser escape-char quote-char -- string )
sequence-parser n>> :> start-n sequence-parser n>> :> start-n

2
libs/c/preprocessor/preprocessor.factor
View File

@ -85,7 +85,7 @@ ERROR: header-file-missing path ;
: take-define-identifier ( sequence-parser -- string ) : take-define-identifier ( sequence-parser -- string )
skip-whitespace/comments skip-whitespace/comments
[ current { [ blank? ] [ char: ( = ] } 1|| ] take-until ; [ current { [ blank? ] [ char: \( = ] } 1|| ] take-until ;
:: handle-define ( preprocessor-state sequence-parser -- ) :: handle-define ( preprocessor-state sequence-parser -- )
sequence-parser take-define-identifier :> ident sequence-parser take-define-identifier :> ident

2
libs/calendar/format/format.factor
View File

@ -171,7 +171,7 @@ M: timestamp year. ( timestamp -- )
[ [
[ [
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
] ]

2
libs/couchdb/couchdb.factor
View File

@ -71,7 +71,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 ;

10
libs/csv/csv.factor
View File

@ -20,7 +20,7 @@ defer: quoted-field,
2over stream-read1 swap over = 2over stream-read1 swap over =
[ nip ] [ [ nip ] [
{ {
{ char: " [ [ char: " , ] when quoted-field, ] } { char: \" [ [ char: \" , ] when quoted-field, ] }
{ char: \n [ ] } ! Error: cr inside string? { char: \n [ ] } ! Error: cr inside string?
{ char: \r [ ] } ! Error: lf inside string? { char: \r [ ] } ! Error: lf inside string?
[ [ , drop f maybe-escaped-quote ] when* ] [ [ , drop f maybe-escaped-quote ] when* ]
@ -45,7 +45,7 @@ defer: quoted-field,
swap ?trim [ drop ] 2dip ; inline swap ?trim [ drop ] 2dip ; inline
: field ( delimiter stream field-seps quote-seps -- sep/f field ) : field ( delimiter stream field-seps quote-seps -- sep/f field )
pick stream-read-until dup char: " = [ pick stream-read-until dup char: \" = [
drop [ drop quoted-field ] [ continue-field ] if-empty drop [ drop quoted-field ] [ continue-field ] if-empty
] [ [ 3drop ] 2dip swap ?trim ] if ; ] [ [ 3drop ] 2dip swap ?trim ] if ;
@ -89,10 +89,10 @@ PRIVATE>
'[ dup "\n\"\r" member? [ drop t ] [ _ = ] if ] any? ; inline '[ dup "\n\"\r" member? [ drop t ] [ _ = ] if ] any? ; inline
: escape-quotes ( cell stream -- ) : escape-quotes ( cell stream -- )
char: " over stream-write1 swap [ char: \" over stream-write1 swap [
[ over stream-write1 ] [ over stream-write1 ]
[ dup char: " = [ over stream-write1 ] [ drop ] if ] bi [ dup char: \" = [ over stream-write1 ] [ drop ] if ] bi
] each char: " swap stream-write1 ; ] each char: \" swap stream-write1 ;
: escape-if-required ( cell delimiter stream -- ) : escape-if-required ( cell delimiter stream -- )
[ dupd needs-escaping? ] dip [ dupd needs-escaping? ] dip

2
libs/cuesheet/cuesheet.factor
View File

@ -58,7 +58,7 @@ ERROR: unknown-syntax syntax ;
dup [ char: ; = ] find drop [ head ] when* ; dup [ char: ; = ] find drop [ head ] when* ;
: trim-quotes ( str -- str' ) : trim-quotes ( str -- str' )
[ char: " = ] trim ; [ char: \" = ] trim ;
: last-track ( cuesheet -- cuesheet track ) : last-track ( cuesheet -- cuesheet track )
dup files>> last tracks>> last ; dup files>> last tracks>> last ;

18
libs/decimals/decimals-tests.factor
View File

@ -5,7 +5,7 @@ locals math math.functions math.order random tools.test ;
in: decimals.tests in: decimals.tests
{ t } [ { t } [
DECIMAL: 12.34 DECIMAL: 00012.34000 = decimal: 12.34 decimal: 00012.34000 =
] unit-test ] unit-test
: random-test-int ( -- n ) : random-test-int ( -- n )
@ -37,15 +37,15 @@ ERROR: decimal-test-failure D1 D2 quot ;
] unit-test ] unit-test
{ t } [ { t } [
{ DECIMAL: 0. DECIMAL: .0 DECIMAL: 0.0 DECIMAL: 00.00 DECIMAL: . } all-equal? { decimal: 0. decimal: .0 decimal: 0.0 decimal: 00.00 decimal: . } all-equal?
] unit-test ] unit-test
{ t } [ T{ decimal f 90 0 } T{ decimal f 9 1 } = ] unit-test { t } [ T{ decimal f 90 0 } T{ decimal f 9 1 } = ] unit-test
{ t } [ DECIMAL: 1 DECIMAL: 2 before? ] unit-test { t } [ decimal: 1 decimal: 2 before? ] unit-test
{ f } [ DECIMAL: 2 DECIMAL: 2 before? ] unit-test { f } [ decimal: 2 decimal: 2 before? ] unit-test
{ f } [ DECIMAL: 3 DECIMAL: 2 before? ] unit-test { f } [ decimal: 3 decimal: 2 before? ] unit-test
{ f } [ DECIMAL: -1 DECIMAL: -2 before? ] unit-test { f } [ decimal: -1 decimal: -2 before? ] unit-test
{ f } [ DECIMAL: -2 DECIMAL: -2 before? ] unit-test { f } [ decimal: -2 decimal: -2 before? ] unit-test
{ t } [ DECIMAL: -3 DECIMAL: -2 before? ] unit-test { t } [ decimal: -3 decimal: -2 before? ] unit-test
{ t } [ DECIMAL: .5 DECIMAL: 0 DECIMAL: 1.0 between? ] unit-test { t } [ decimal: .5 decimal: 0 decimal: 1.0 between? ] unit-test

2
libs/decimals/decimals.factor
View File

@ -19,7 +19,7 @@ C: <decimal> decimal ;
: parse-decimal ( -- decimal ) scan-token string>decimal ; : parse-decimal ( -- decimal ) scan-token string>decimal ;
SYNTAX: DECIMAL: parse-decimal suffix! ; SYNTAX: decimal: parse-decimal suffix! ;
: decimal>ratio ( decimal -- ratio ) >decimal< 10^ * ; : decimal>ratio ( decimal -- ratio ) >decimal< 10^ * ;

12
libs/farkup/farkup.factor
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 ;

2
libs/fjsc/fjsc.factor
View File

@ -32,7 +32,7 @@ TUPLE: ast-hashtable elements ;
[ [
{ {
[ blank? not ] [ blank? not ]
[ char: " = not ] [ char: \" = not ]
[ char: ; = not ] [ char: ; = not ]
[ LETTER? not ] [ LETTER? not ]
[ letter? not ] [ letter? not ]

12
libs/flip-text/flip-text.factor
View File

@ -70,15 +70,15 @@ CONSTANT: CHARS H{
! { char: 8 char: 8 } ! { char: 8 char: 8 }
{ char: 9 char: 6 } { char: 9 char: 6 }
{ char: & 0x214B } { char: & 0x214B }
{ char: ! 0x00A1 } { char: \! 0x00A1 }
{ 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: , }
{ char: < char: > } { char: < char: > }
{ char: _ 0x203E } { char: _ 0x203E }

2
libs/hashcash/hashcash.factor
View File

@ -26,7 +26,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>

4
libs/html/parser/parser.factor
View File

@ -43,7 +43,7 @@ symbol: tagstack
char: ' (read-quote) ; char: ' (read-quote) ;
: read-double-quote ( sequence-parser -- string ) : read-double-quote ( sequence-parser -- string )
char: " (read-quote) ; char: \" (read-quote) ;
: read-quote ( sequence-parser -- string ) : read-quote ( sequence-parser -- string )
dup get+increment char: ' = dup get+increment char: ' =
@ -108,7 +108,7 @@ symbol: tagstack
: read-< ( sequence-parser -- string/f ) : read-< ( sequence-parser -- string/f )
advance dup current [ advance dup current [
char: ! = [ read-bang f ] [ read-tag ] if char: \! = [ read-bang f ] [ read-tag ] if
] [ ] [
drop f drop f
] if* ; ] if* ;

8
libs/html/templates/chloe/chloe-docs.factor
View File

@ -28,8 +28,8 @@ HELP: CHLOE:
{ $values { "name" "the tag name" } { "definition" { $quotation ( tag -- ) } } } { $values { "name" "the tag name" } { "definition" { $quotation ( tag -- ) } } }
{ $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ; { $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ;
HELP: COMPONENT: HELP: component:
{ $syntax "COMPONENT: name" } { $syntax "component: name" }
{ $description "Defines a Chloe tag named " { $snippet "name" } " rendering the HTML component with class word " { $snippet "name" } ". See " { $link "html.components" } "." } ; { $description "Defines a Chloe tag named " { $snippet "name" } " rendering the HTML component with class word " { $snippet "name" } ". See " { $link "html.components" } "." } ;
HELP: reset-cache HELP: reset-cache
@ -276,14 +276,14 @@ ARTICLE: "html.templates.chloe.extend.components.example" "An example of a custo
"Now we define a method on the " { $link render* } " generic word which renders the image using " { $link { "xml.syntax" "literals" } } ":" "Now we define a method on the " { $link render* } " generic word which renders the image using " { $link { "xml.syntax" "literals" } } ":"
{ $code "M: image render* 2drop XML[[ <img src=<-> /> XML]] ;" } { $code "M: image render* 2drop XML[[ <img src=<-> /> XML]] ;" }
"Finally, we can define a Chloe component:" "Finally, we can define a Chloe component:"
{ $code "COMPONENT: image" } { $code "component: image" }
"We can use it as follows, assuming the current form has a value named " { $snippet "image" } ":" "We can use it as follows, assuming the current form has a value named " { $snippet "image" } ":"
{ $code "<t:image t:name='image' />" } ; { $code "<t:image t:name='image' />" } ;
ARTICLE: "html.templates.chloe.extend.components" "Extending Chloe with custom components" ARTICLE: "html.templates.chloe.extend.components" "Extending Chloe with custom components"
"Custom HTML components implementing the " { $link render* } " word can be wired up with Chloe using the following syntax from " { $vocab-link "html.templates.chloe.components" } ":" "Custom HTML components implementing the " { $link render* } " word can be wired up with Chloe using the following syntax from " { $vocab-link "html.templates.chloe.components" } ":"
{ $subsections { $subsections
postpone\ COMPONENT: postpone\ component:
"html.templates.chloe.extend.components.example" "html.templates.chloe.extend.components.example"
} ; } ;

28
libs/html/templates/chloe/chloe.factor
View File

@ -74,20 +74,20 @@ CHLOE: validation-errors
CHLOE: if dup if>quot [ swap when ] append process-children ; CHLOE: if dup if>quot [ swap when ] append process-children ;
COMPONENT: label component: label
COMPONENT: link component: link
COMPONENT: inspector component: inspector
COMPONENT: comparison component: comparison
COMPONENT: html component: html
COMPONENT: hidden component: hidden
COMPONENT: farkup component: farkup
COMPONENT: field component: field
COMPONENT: textarea component: textarea
COMPONENT: password component: password
COMPONENT: choice component: choice
COMPONENT: checkbox component: checkbox
COMPONENT: code component: code
COMPONENT: xml component: xml
symbol: template-cache symbol: template-cache

2
libs/html/templates/chloe/components/components.factor
View File

@ -31,7 +31,7 @@ M: tuple-class component-tag ( tag class -- )
[ compile-component-attrs ] 2bi [ compile-component-attrs ] 2bi
render-quot [code] ; render-quot [code] ;
SYNTAX: COMPONENT: SYNTAX: component:
scan-word scan-word
[ name>> ] [ '[ _ component-tag ] ] bi [ name>> ] [ '[ _ component-tag ] ] bi
define-chloe-tag ; define-chloe-tag ;

2
libs/html/templates/fhtml/fhtml.factor
View File

@ -16,7 +16,7 @@ TUPLE: template-lexer < lexer ;
M: template-lexer skip-word M: template-lexer skip-word
[ [
{ {
{ [ 2dup nth char: " = ] [ drop 1 + ] } { [ 2dup nth char: \" = ] [ drop 1 + ] }
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] } { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
[ f skip ] [ f skip ]
} cond } cond

2
libs/http/parsers/parsers.factor
View File

@ -97,7 +97,7 @@ PEG: parse-response-line ( string -- triple )
[ " \t" member? ] satisfy repeat1 ; [ " \t" member? ] satisfy repeat1 ;
: qdtext-parser ( -- parser ) : qdtext-parser ( -- parser )
{ [ char: " = ] [ control? ] } except-these ; { [ char: \" = ] [ control? ] } except-these ;
: quoted-char-parser ( -- parser ) : quoted-char-parser ( -- parser )
"\\" token hide any-char 2seq ; "\\" token hide any-char 2seq ;

14
libs/ini-file/ini-file.factor
View File

@ -19,11 +19,11 @@ in: ini-file
{ char: t char: \t } { char: t char: \t }
{ char: v char: \v } { char: v char: \v }
{ char: ' char: ' } { char: ' char: ' }
{ char: " char: " } { char: \" char: \" }
{ 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,8 +54,8 @@ use: xml.entities
{ char: \\ "\\\\" } { char: \\ "\\\\" }
{ char: ? "\\?" } { char: ? "\\?" }
{ char: ; "\\;" } { char: ; "\\;" }
{ char: [ "\\[" } { char: \[ "\\[" }
{ char: ] "\\]" } { char: \] "\\]" }
{ char: = "\\=" } { char: = "\\=" }
} escape-string-by ; } escape-string-by ;
@ -87,12 +87,12 @@ 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&& ;
: line-continues? ( line -- ? ) : line-continues? ( line -- ? )
{ [ empty? not ] [ last char: \ = ] } 1&& ; { [ empty? not ] [ last char: \\ = ] } 1&& ;
: section, ( -- ) : section, ( -- )
section get [ , ] when* ; section get [ , ] when* ;

2
libs/irc/client/internals/internals-tests.factor
View File

@ -6,7 +6,7 @@ calendar concurrency.mailboxes classes assocs combinators
irc.messages.parser irc.client.base irc.client.chats irc.messages.parser irc.client.base irc.client.chats
irc.client.participants irc.client.internals ; irc.client.participants irc.client.internals ;
EXCLUDE: irc.messages => join ; EXCLUDE: irc.messages => join ;
RENAME: join irc.messages => join_ RENAME: join irc.messages => join_ ;
in: irc.client.internals.tests in: irc.client.internals.tests
! Streams for testing ! Streams for testing

42
libs/irc/messages/messages.factor
View File

@ -8,24 +8,24 @@ in: irc.messages
! connection ! connection
IRC: pass "PASS" password ; IRC: pass "PASS" password ;
IRC: nick "NICK" : nickname ; IRC: nick "NICK" \ : nickname ;
IRC: user "USER" user mode _ : realname ; IRC: user "USER" user mode _ \ : realname ;
IRC: oper "OPER" name password ; IRC: oper "OPER" name password ;
IRC: mode "MODE" name mode parameter ; IRC: mode "MODE" name mode parameter ;
IRC: service "SERVICE" nickname _ distribution type _ : info ; IRC: service "SERVICE" nickname _ distribution type _ \ : info ;
IRC: quit "QUIT" : comment ; IRC: quit "QUIT" \ : comment ;
IRC: squit "SQUIT" server : comment ; IRC: squit "SQUIT" server \ : comment ;
! channel operations ! channel operations
IRC: join "JOIN" : channel ; IRC: join "JOIN" \ : channel ;
IRC: part "PART" channel : comment ; IRC: part "PART" channel \ : comment ;
IRC: topic "TOPIC" channel : topic ; IRC: topic "TOPIC" channel \ : topic ;
IRC: names "NAMES" channel ; IRC: names "NAMES" channel ;
IRC: list "LIST" channel ; IRC: list "LIST" channel ;
IRC: invite "INVITE" nickname channel ; IRC: invite "INVITE" nickname channel ;
IRC: kick "KICK" channel user : comment ; IRC: kick "KICK" channel user \ : comment ;
! chating ! chating
IRC: privmsg "PRIVMSG" target : text ; IRC: privmsg "PRIVMSG" target \ : text ;
IRC: notice "NOTICE" target : text ; IRC: notice "NOTICE" target \ : text ;
! server queries ! server queries
IRC: motd "MOTD" target ; IRC: motd "MOTD" target ;
IRC: lusers "LUSERS" mask target ; IRC: lusers "LUSERS" mask target ;
@ -39,28 +39,28 @@ IRC: admin "ADMIN" target ;
IRC: info "INFO" target ; IRC: info "INFO" target ;
! service queries ! service queries
IRC: servlist "SERVLIST" mask type ; IRC: servlist "SERVLIST" mask type ;
IRC: squery "SQUERY" service-name : text ; IRC: squery "SQUERY" service-name \ : text ;
! user queries ! user queries
IRC: who "WHO" mask operator ; IRC: who "WHO" mask operator ;
IRC: whois "WHOIS" target mask ; IRC: whois "WHOIS" target mask ;
IRC: whowas "WHOWAS" nickname count target ; IRC: whowas "WHOWAS" nickname count target ;
! misc ! misc
IRC: kill "KILL" nickname : comment ; IRC: kill "KILL" nickname \ : comment ;
IRC: ping "PING" server1 server2 ; IRC: ping "PING" server1 server2 ;
IRC: pong "PONG" server1 server2 ; IRC: pong "PONG" server1 server2 ;
IRC: error "ERROR" : message ; IRC: error "ERROR" \ : message ;
! numeric replies ! numeric replies
IRC: rpl-welcome "001" nickname : comment ; IRC: rpl-welcome "001" nickname \ : comment ;
IRC: rpl-whois-user "311" nicnamek user host _ : real-name ; IRC: rpl-whois-user "311" nicnamek user host _ \ : real-name ;
IRC: rpl-channel-modes "324" channel mode params ; IRC: rpl-channel-modes "324" channel mode params ;
IRC: rpl-notopic "331" channel : topic ; IRC: rpl-notopic "331" channel \ : topic ;
IRC: rpl-topic "332" channel : topic ; IRC: rpl-topic "332" channel \ : topic ;
IRC: rpl-inviting "341" channel nickname ; IRC: rpl-inviting "341" channel nickname ;
IRC: rpl-names "353" nickname _ channel : nicks ; IRC: rpl-names "353" nickname _ channel \ : nicks ;
IRC: rpl-names-end "366" nickname channel : comment ; IRC: rpl-names-end "366" nickname channel \ : comment ;
! error replies ! error replies
IRC: rpl-nickname-in-use "433" _ name ; IRC: rpl-nickname-in-use "433" _ name ;
IRC: rpl-nick-collision "436" nickname : comment ; IRC: rpl-nick-collision "436" nickname \ : comment ;
PREDICATE: channel-mode < mode name>> first "#&" member? ; PREDICATE: channel-mode < mode name>> first "#&" member? ;
PREDICATE: participant-mode < channel-mode parameter>> ; PREDICATE: participant-mode < channel-mode parameter>> ;

8
libs/json/reader/reader.factor
View File

@ -44,7 +44,7 @@ defer: (read-json-string)
: (read-json-escape) ( stream accum -- accum ) : (read-json-escape) ( stream accum -- accum )
{ sbuf } declare { sbuf } declare
over stream-read1 { over stream-read1 {
{ char: " [ char: " ] } { char: \" [ char: \" ] }
{ char: \\ [ char: \\ ] } { char: \\ [ char: \\ ] }
{ char: / [ char: / ] } { char: / [ char: / ] }
{ char: b [ char: \b ] } { char: b [ char: \b ] }
@ -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 [ ] }

12
libs/json/writer/writer.factor
View File

@ -59,9 +59,9 @@ M: json-null stream-json-print
PRIVATE> PRIVATE>
M: string stream-json-print M: string stream-json-print
char: " over stream-write1 swap [ char: \" over stream-write1 swap [
{ {
{ char: " [ "\\\"" over stream-write ] } { char: \" [ "\\\"" over stream-write ] }
{ char: \\ [ "\\\\" over stream-write ] } { char: \\ [ "\\\\" over stream-write ] }
{ char: / [ { char: / [
json-escape-slashes? get json-escape-slashes? get
@ -87,7 +87,7 @@ M: string stream-json-print
] if ] if
] ]
} case } case
] each char: " swap stream-write1 ; ] each char: \" swap stream-write1 ;
M: integer stream-json-print M: integer stream-json-print
[ number>string ] [ stream-write ] bi* ; [ number>string ] [ stream-write ] bi* ;
@ -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

6
libs/math/floats/env/ppc/ppc.factor vendored
View File

@ -72,7 +72,7 @@ CONSTANT: ppc-exception-flag>bit
{ +fp-underflow+ 0x0800,0000 } { +fp-underflow+ 0x0800,0000 }
{ +fp-zero-divide+ 0x0400,0000 } { +fp-zero-divide+ 0x0400,0000 }
{ +fp-inexact+ 0x0200,0000 } { +fp-inexact+ 0x0200,0000 }
} } ;
CONSTANT: ppc-fp-traps-bits 0xf8 ; CONSTANT: ppc-fp-traps-bits 0xf8 ;
CONSTANT: ppc-fp-traps>bit CONSTANT: ppc-fp-traps>bit
@ -82,7 +82,7 @@ CONSTANT: ppc-fp-traps>bit
{ +fp-underflow+ 0x20 } { +fp-underflow+ 0x20 }
{ +fp-zero-divide+ 0x10 } { +fp-zero-divide+ 0x10 }
{ +fp-inexact+ 0x08 } { +fp-inexact+ 0x08 }
} } ;
CONSTANT: ppc-rounding-mode-bits 0x3 ; CONSTANT: ppc-rounding-mode-bits 0x3 ;
CONSTANT: ppc-rounding-mode>bit CONSTANT: ppc-rounding-mode>bit
@ -91,7 +91,7 @@ CONSTANT: ppc-rounding-mode>bit
{ +round-zero+ 0x1 } { +round-zero+ 0x1 }
{ +round-up+ 0x2 } { +round-up+ 0x2 }
{ +round-down+ 0x3 } { +round-down+ 0x3 }
} >biassoc ] } >biassoc ] ;
CONSTANT: ppc-denormal-mode-bits 0x4 ; CONSTANT: ppc-denormal-mode-bits 0x4 ;

10
libs/math/floats/env/x86/x86.factor vendored
View File

@ -40,7 +40,7 @@ CONSTANT: sse-exception-flag>bit
{ +fp-underflow+ 0x10 } { +fp-underflow+ 0x10 }
{ +fp-zero-divide+ 0x04 } { +fp-zero-divide+ 0x04 }
{ +fp-inexact+ 0x20 } { +fp-inexact+ 0x20 }
} } ;
CONSTANT: sse-fp-traps-bits 0x1f80 ; CONSTANT: sse-fp-traps-bits 0x1f80 ;
CONSTANT: sse-fp-traps>bit CONSTANT: sse-fp-traps>bit
@ -50,7 +50,7 @@ CONSTANT: sse-fp-traps>bit
{ +fp-underflow+ 0x0800 } { +fp-underflow+ 0x0800 }
{ +fp-zero-divide+ 0x0200 } { +fp-zero-divide+ 0x0200 }
{ +fp-inexact+ 0x1000 } { +fp-inexact+ 0x1000 }
} } ;
CONSTANT: sse-rounding-mode-bits 0x6000 ; CONSTANT: sse-rounding-mode-bits 0x6000 ;
CONSTANT: sse-rounding-mode>bit CONSTANT: sse-rounding-mode>bit
@ -59,7 +59,7 @@ CONSTANT: sse-rounding-mode>bit
{ +round-down+ 0x2000 } { +round-down+ 0x2000 }
{ +round-up+ 0x4000 } { +round-up+ 0x4000 }
{ +round-zero+ 0x6000 } { +round-zero+ 0x6000 }
} >biassoc ] } >biassoc ] ;
CONSTANT: sse-denormal-mode-bits 0x8040 ; CONSTANT: sse-denormal-mode-bits 0x8040 ;
@ -99,7 +99,7 @@ CONSTANT: x87-exception>bit
{ +fp-zero-divide+ 0x04 } { +fp-zero-divide+ 0x04 }
{ +fp-inexact+ 0x20 } { +fp-inexact+ 0x20 }
{ +fp-x87-stack-fault+ 0x40 } { +fp-x87-stack-fault+ 0x40 }
} } ;
CONSTANT: x87-rounding-mode-bits 0x0c00 ; CONSTANT: x87-rounding-mode-bits 0x0c00 ;
CONSTANT: x87-rounding-mode>bit CONSTANT: x87-rounding-mode>bit
@ -108,7 +108,7 @@ CONSTANT: x87-rounding-mode>bit
{ +round-down+ 0x0400 } { +round-down+ 0x0400 }
{ +round-up+ 0x0800 } { +round-up+ 0x0800 }
{ +round-zero+ 0x0c00 } { +round-zero+ 0x0c00 }
} >biassoc ] } >biassoc ] ;
M: x87-env (get-exception-flags) ( register -- exceptions ) M: x87-env (get-exception-flags) ( register -- exceptions )
status>> x87-exception>bit mask> ; inline status>> x87-exception>bit mask> ; inline

2
libs/math/text/french/french.factor
View File

@ -17,7 +17,7 @@ CONSTANT: literals
{ 40 "quarante" } { 50 "cinquante" } { 60 "soixante" } { 40 "quarante" } { 50 "cinquante" } { 60 "soixante" }
{ 71 "soixante et onze" } { 80 "quatre-vingts" } { 71 "soixante et onze" } { 80 "quatre-vingts" }
{ 81 "quatre-vingt-un" } { 81 "quatre-vingt-un" }
{ 100 "cent" } { 1000 "mille" } } { 100 "cent" } { 1000 "mille" } } ;
MEMO: units ( -- seq ) ! up to 10^99 MEMO: units ( -- seq ) ! up to 10^99
{ "m" "b" "tr" "quadr" "quint" "sext" "sept" "oct" { "m" "b" "tr" "quadr" "quint" "sext" "sept" "oct"

38
libs/money/money-tests.factor
View File

@ -1,25 +1,25 @@
USING: money parser tools.test eval ; USING: money parser tools.test eval ;
in: money.tests in: money.tests
{ -1/10 } [ DECIMAL: -.1 ] unit-test { -1/10 } [ decimal: -.1 ] unit-test
{ -1/10 } [ DECIMAL: -0.1 ] unit-test { -1/10 } [ decimal: -0.1 ] unit-test
{ -1/10 } [ DECIMAL: -00.10 ] unit-test { -1/10 } [ decimal: -00.10 ] unit-test
{ 0 } [ DECIMAL: .0 ] unit-test { 0 } [ decimal: .0 ] unit-test
{ 0 } [ DECIMAL: 0.0 ] unit-test { 0 } [ decimal: 0.0 ] unit-test
{ 0 } [ DECIMAL: 0. ] unit-test { 0 } [ decimal: 0. ] unit-test
{ 0 } [ DECIMAL: 0 ] unit-test { 0 } [ decimal: 0 ] unit-test
{ 1/10 } [ DECIMAL: .1 ] unit-test { 1/10 } [ decimal: .1 ] unit-test
{ 1/10 } [ DECIMAL: 0.1 ] unit-test { 1/10 } [ decimal: 0.1 ] unit-test
{ 1/10 } [ DECIMAL: 00.10 ] unit-test { 1/10 } [ decimal: 00.10 ] unit-test
{ 23 } [ DECIMAL: 23 ] unit-test { 23 } [ decimal: 23 ] unit-test
{ -23 } [ DECIMAL: -23 ] unit-test { -23 } [ decimal: -23 ] unit-test
{ -23-1/100 } [ DECIMAL: -23.01 ] unit-test { -23-1/100 } [ decimal: -23.01 ] unit-test
[ "DECIMAL: ." eval ] must-fail [ "decimal: ." eval ] must-fail
[ "DECIMAL: f" eval ] must-fail [ "decimal: f" eval ] must-fail
[ "DECIMAL: 0.f" eval ] must-fail [ "decimal: 0.f" eval ] must-fail
[ "DECIMAL: f.0" eval ] must-fail [ "decimal: f.0" eval ] must-fail
{ "$100.00" } [ DECIMAL: 100.0 money>string ] unit-test { "$100.00" } [ decimal: 100.0 money>string ] unit-test
{ "$0.00" } [ DECIMAL: 0.0 money>string ] unit-test { "$0.00" } [ decimal: 0.0 money>string ] unit-test

2
libs/money/money.factor
View File

@ -31,4 +31,4 @@ ERROR: not-an-integer x ;
[ dup string>number [ nip ] [ not-an-integer ] if* ] bi@ [ dup string>number [ nip ] [ not-an-integer ] if* ] bi@
] keep length 10^ / + swap [ neg ] when ; ] keep length 10^ / + swap [ neg ] when ;
SYNTAX: DECIMAL: scan-token parse-decimal suffix! ; SYNTAX: decimal: scan-token parse-decimal suffix! ;

2
libs/redis/response-parser/response-parser.factor
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 ] }

28
libs/taxes/usa/federal/federal.factor
View File

@ -10,24 +10,24 @@ in: taxes.usa.federal
: federal-single ( -- triples ) : federal-single ( -- triples )
{ {
{ 0 2650 DECIMAL: 0 } { 0 2650 decimal: 0 }
{ 2650 10300 DECIMAL: .10 } { 2650 10300 decimal: .10 }
{ 10300 33960 DECIMAL: .15 } { 10300 33960 decimal: .15 }
{ 33960 79725 DECIMAL: .25 } { 33960 79725 decimal: .25 }
{ 79725 166500 DECIMAL: .28 } { 79725 166500 decimal: .28 }
{ 166500 359650 DECIMAL: .33 } { 166500 359650 decimal: .33 }
{ 359650 1/0. DECIMAL: .35 } { 359650 1/0. decimal: .35 }
} ; } ;
: federal-married ( -- triples ) : federal-married ( -- triples )
{ {
{ 0 8000 DECIMAL: 0 } { 0 8000 decimal: 0 }
{ 8000 23550 DECIMAL: .10 } { 8000 23550 decimal: .10 }
{ 23550 72150 DECIMAL: .15 } { 23550 72150 decimal: .15 }
{ 72150 137850 DECIMAL: .25 } { 72150 137850 decimal: .25 }
{ 137850 207700 DECIMAL: .28 } { 137850 207700 decimal: .28 }
{ 207700 365100 DECIMAL: .33 } { 207700 365100 decimal: .33 }
{ 365100 1/0. DECIMAL: .35 } { 365100 1/0. decimal: .35 }
} ; } ;
singleton: federal singleton: federal

2
libs/taxes/usa/fica/fica.factor
View File

@ -3,7 +3,7 @@
USING: accessors math math.order money kernel assocs ; USING: accessors math math.order money kernel assocs ;
in: taxes.usa.fica in: taxes.usa.fica
: fica-tax-rate ( -- x ) DECIMAL: .062 ; inline : fica-tax-rate ( -- x ) decimal: .062 ; inline
ERROR: fica-base-unknown ; ERROR: fica-base-unknown ;

4
libs/taxes/usa/futa/futa.factor
View File

@ -5,9 +5,9 @@ namespaces sequences money math.order ;
in: taxes.usa.futa in: taxes.usa.futa
! Employer tax only, not withheld ! Employer tax only, not withheld
: futa-tax-rate ( -- x ) DECIMAL: .062 ; inline : futa-tax-rate ( -- x ) decimal: .062 ; inline
: futa-base-rate ( -- x ) 7000 ; inline : futa-base-rate ( -- x ) 7000 ; inline
: futa-tax-offset-credit ( -- x ) DECIMAL: .054 ; inline : futa-tax-offset-credit ( -- x ) decimal: .054 ; inline
: futa-tax ( salary w4 -- x ) : futa-tax ( salary w4 -- x )
drop futa-base-rate min drop futa-base-rate min

2
libs/taxes/usa/medicare/medicare.factor
View File

@ -4,5 +4,5 @@ USING: kernel math money ;
in: taxes.usa.medicare in: taxes.usa.medicare
! No base rate for medicare; all wages subject ! No base rate for medicare; all wages subject
: medicare-tax-rate ( -- x ) DECIMAL: .0145 ; inline : medicare-tax-rate ( -- x ) decimal: .0145 ; inline
: medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ; : medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ;

16
libs/taxes/usa/mn/mn.factor
View File

@ -8,18 +8,18 @@ in: taxes.usa.mn
! Minnesota ! Minnesota
: mn-single ( -- triples ) : mn-single ( -- triples )
{ {
{ 0 1950 DECIMAL: 0 } { 0 1950 decimal: 0 }
{ 1950 23750 DECIMAL: .0535 } { 1950 23750 decimal: .0535 }
{ 23750 73540 DECIMAL: .0705 } { 23750 73540 decimal: .0705 }
{ 73540 1/0. DECIMAL: .0785 } { 73540 1/0. decimal: .0785 }
} ; } ;
: mn-married ( -- triples ) : mn-married ( -- triples )
{ {
{ 0 7400 DECIMAL: 0 } { 0 7400 decimal: 0 }
{ 7400 39260 DECIMAL: .0535 } { 7400 39260 decimal: .0535 }
{ 39260 133980 DECIMAL: .0705 } { 39260 133980 decimal: .0705 }
{ 133980 1/0. DECIMAL: .0785 } { 133980 1/0. decimal: .0785 }
} ; } ;
: <mn> ( -- obj ) : <mn> ( -- obj )

4
libs/tnetstrings/tnetstrings.factor
View File

@ -44,10 +44,10 @@ defer: parse-tnetstring
: parse-tnetstring ( data -- remain value ) : parse-tnetstring ( data -- remain value )
parse-payload { parse-payload {
{ char: # [ string>number ] } { char: # [ string>number ] }
{ char: " [ ] } { char: \" [ ] }
{ char: } [ parse-dict ] } { char: } [ parse-dict ] }
{ char: ] [ parse-list ] } { char: ] [ parse-list ] }
{ char: ! [ parse-bool ] } { char: \! [ parse-bool ] }
{ char: ~ [ parse-null ] } { char: ~ [ parse-null ] }
{ char: , [ ] } { char: , [ ] }
[ "Invalid payload type: %c" sprintf throw ] [ "Invalid payload type: %c" sprintf throw ]

2
libs/txon/txon.factor
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* ;

2
libs/xml-rpc/xml-rpc.factor
View File

@ -109,7 +109,7 @@ M: server-error error.
"Description: " write dup message>> print "Description: " write dup message>> print
"Tag: " write tag>> xml>string print ; "Tag: " write tag>> xml>string print ;
TAGS: xml>item ( tag -- object ) TAGS: xml>item ( tag -- object ) ;
TAG: string xml>item TAG: string xml>item
children>string ; children>string ;

2
libs/xml/syntax/syntax-docs.factor
View File

@ -20,7 +20,7 @@ ARTICLE: { "xml.syntax" "tags" } "Dispatch on XML tag names"
{ $subsections postpone\ TAG: } ; { $subsections postpone\ TAG: } ;
HELP: TAGS: HELP: TAGS:
{ $syntax "TAGS: word" } { $syntax "TAGS: word effect ;" }
{ $values { "word" "a new word to define" } } { $values { "word" "a new word to define" } }
{ $description "Creates a new word to which dispatches on XML tag names." } { $description "Creates a new word to which dispatches on XML tag names." }
{ $see-also postpone\ TAG: } ; { $see-also postpone\ TAG: } ;

2
libs/xml/syntax/syntax-tests.factor
View File

@ -8,7 +8,7 @@ in: xml.syntax.tests
! TAGS test ! TAGS test
TAGS: calculate ( tag -- n ) TAGS: calculate ( tag -- n ) ;
: calc-2children ( tag -- n n ) : calc-2children ( tag -- n n )
children-tags first2 [ calculate ] dip calculate ; children-tags first2 [ calculate ] dip calculate ;

2
libs/xml/syntax/syntax.factor
View File

@ -28,7 +28,7 @@ M: no-tag summary
PRIVATE> PRIVATE>
SYNTAX: TAGS: SYNTAX: TAGS:
scan-new-word scan-effect scan-new-word scan-effect ";" expect
[ drop H{ } clone "xtable" set-word-prop ] [ drop H{ } clone "xtable" set-word-prop ]
[ define-tags ] [ define-tags ]
2bi ; 2bi ;

2
libs/xmode/catalog/catalog.factor
View File

@ -6,7 +6,7 @@ in: xmode.catalog
TUPLE: mode file file-name-glob first-line-glob ; TUPLE: mode file file-name-glob first-line-glob ;
TAGS: parse-mode-tag ( modes tag -- ) TAGS: parse-mode-tag ( modes tag -- ) ;
TAG: MODE parse-mode-tag TAG: MODE parse-mode-tag
dup "NAME" attr [ dup "NAME" attr [

2
libs/xmode/loader/loader.factor
View File

@ -6,7 +6,7 @@ in: xmode.loader
! Based on org.gjt.sp.jedit.XModeHandler ! Based on org.gjt.sp.jedit.XModeHandler
! RULES and its children ! RULES and its children
TAGS: parse-rule-tag ( rule-set tag -- ) TAGS: parse-rule-tag ( rule-set tag -- ) ;
TAG: PROPS parse-rule-tag TAG: PROPS parse-rule-tag
parse-props-tag >>props drop ; parse-props-tag >>props drop ;

2
libs/xmode/loader/syntax/syntax.factor
View File

@ -81,7 +81,7 @@ SYNTAX: RULE:
[ parse-literal-matcher >>end drop ] , ; [ parse-literal-matcher >>end drop ] , ;
! SPAN's children ! SPAN's children
TAGS: parse-begin/end-tag ( rule tag -- ) TAGS: parse-begin/end-tag ( rule tag -- ) ;
TAG: BEGIN parse-begin/end-tag TAG: BEGIN parse-begin/end-tag
! XXX ! XXX

13
modern-transition.factor
View File

@ -15,6 +15,19 @@
[ dup <vocab-link> . flush vocab>literals ] map-zip [ dup <vocab-link> . flush vocab>literals ] map-zip
"resource:collections" vocabs-from
{ "bit-arrays"
"bit-vectors" "dlists" "linked-assocs" "nibble-arrays"
"specialized-arrays" "specialized-vectors" "suffix-arrays"
"trees" "vlists" "arrays.shaped" "byte-arrays.hex"
"hash-sets.identity" "hash-sets.numbers" "hash-sets.sequences"
"hashtables.numbers" "hashtables.sequences" "persistent.hashtables"
"memory.pools" "persistent.vectors" "trees.avl" "trees.splay"
} diff
[ dup <vocab-link> . flush vocab>literals ] map-zip
"resource:language" vocabs-from "resource:language" vocabs-from
{ "constructors" "descriptive" "eval" "functors" "literals" { "constructors" "descriptive" "eval" "functors" "literals"
"match" "method-chains" "multi-methods" "multiline" "match" "method-chains" "multi-methods" "multiline"

2
unmaintained/4DNav/space-file-decoder/space-file-decoder.factor
View File

@ -8,7 +8,7 @@ in: 4DNav.space-file-decoder
: decode-number-array ( x -- y ) : decode-number-array ( x -- y )
"," split [ string>number ] map ; "," split [ string>number ] map ;
TAGS: adsoda-read-model ( tag -- model ) TAGS: adsoda-read-model ( tag -- model ) ;
TAG: dimension adsoda-read-model TAG: dimension adsoda-read-model
children>> first string>number ; children>> first string>number ;

2
unmaintained/irc-ui/ui.factor
View File

@ -11,7 +11,7 @@ USING: accessors kernel threads combinators concurrency.mailboxes
irc.client irc.client.private irc.messages irc.client irc.client.private irc.messages
irc.ui.commandparser irc.ui.load vocabs.loader classes prettyprint ; irc.ui.commandparser irc.ui.load vocabs.loader classes prettyprint ;
RENAME: join sequences => sjoin RENAME: join sequences => sjoin ;
in: irc.ui in: irc.ui