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
: 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 )
n [1,b] DECIMAL: 1
[ D-factorial DECIMAL: 1 swap n D/ D+ ] reduce ;
n [1,b] decimal: 1
[ D-factorial decimal: 1 swap n D/ D+ ] reduce ;
: e-decimals-benchmark ( -- )
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
combinators.smart endian fry hints kernel locals macros math
math.ranges sequences sequences.generalizations ;
RENAME: be> io.binary => slow-be>
RENAME: le> io.binary => slow-le>
RENAME: signed-be> io.binary => slow-signed-be>
RENAME: signed-le> io.binary => slow-signed-le>
RENAME: >be io.binary => >slow-be
RENAME: >le io.binary => >slow-le
RENAME: be> io.binary => slow-be> ;
RENAME: le> io.binary => slow-le> ;
RENAME: signed-be> io.binary => slow-signed-be> ;
RENAME: signed-le> io.binary => slow-signed-le> ;
RENAME: >be io.binary => >slow-be ;
RENAME: >le io.binary => >slow-le ;
in: io.binary.fast
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 ;
{ 2 } [ p:x ] unit-test
RENAME: x qualified.tests.baz => y
RENAME: x qualified.tests.baz => y ;
{ 3 } [ y ] unit-test
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: \\ 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 ;

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>" } } ;
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" } "." }
{ $notes "If adding the words introduces ambiguity, the words will take precedence when resolving any ambiguous names." }
{ $examples { $example
"USING: prettyprint ;"
"RENAME: + math => -"
"RENAME: + math => - ;"
"2 3 - ."
"5"
} } ;

2
core/syntax/syntax.factor
View File

@ -96,7 +96,7 @@ in: bootstrap.syntax
] define-core-syntax
"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
"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" } } = ]
must-fail-with
[ "RENAME: doesnotexist kernel => newname" eval( -- ) ]
[ "RENAME: doesnotexist kernel => newname ;" eval( -- ) ]
[ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ]
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
kernel strings definitions prettyprint debugger arrays
hashtables continuations classes assocs accessors see ;
RENAME: GENERIC: multi-methods => multi-methods:GENERIC:
RENAME: GENERIC: multi-methods => multi-methods:GENERIC: ;
in: multi-methods.tests
multi-methods:GENERIC: first-test ( -- ) ;

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

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

@ -40,7 +40,7 @@ in: c.lexer
: take-define-identifier ( sequence-parser -- string )
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 )
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 )
skip-whitespace/comments
[ current { [ blank? ] [ char: ( = ] } 1|| ] take-until ;
[ current { [ blank? ] [ char: \( = ] } 1|| ] take-until ;
:: handle-define ( preprocessor-state sequence-parser -- )
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
read1 { { char: : [ read-00 ] } { f [ 0 ] } } case minutes
read1 { { char: \: [ read-00 ] } { f [ 0 ] } } case minutes
time+
] 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> ;
: (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 ;

10
libs/csv/csv.factor
View File

@ -20,7 +20,7 @@ defer: quoted-field,
2over stream-read1 swap over =
[ nip ] [
{
{ char: " [ [ char: " , ] when quoted-field, ] }
{ char: \" [ [ char: \" , ] when quoted-field, ] }
{ char: \n [ ] } ! Error: cr inside string?
{ char: \r [ ] } ! Error: lf inside string?
[ [ , drop f maybe-escaped-quote ] when* ]
@ -45,7 +45,7 @@ defer: quoted-field,
swap ?trim [ drop ] 2dip ; inline
: 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
] [ [ 3drop ] 2dip swap ?trim ] if ;
@ -89,10 +89,10 @@ PRIVATE>
'[ dup "\n\"\r" member? [ drop t ] [ _ = ] if ] any? ; inline
: escape-quotes ( cell stream -- )
char: " over stream-write1 swap [
char: \" over stream-write1 swap [
[ over stream-write1 ]
[ dup char: " = [ over stream-write1 ] [ drop ] if ] bi
] each char: " swap stream-write1 ;
[ dup char: \" = [ over stream-write1 ] [ drop ] if ] bi
] each char: \" swap stream-write1 ;
: escape-if-required ( cell delimiter stream -- )
[ 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* ;
: trim-quotes ( str -- str' )
[ char: " = ] trim ;
[ char: \" = ] trim ;
: last-track ( cuesheet -- cuesheet track )
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
{ t } [
DECIMAL: 12.34 DECIMAL: 00012.34000 =
decimal: 12.34 decimal: 00012.34000 =
] unit-test
: random-test-int ( -- n )
@ -37,15 +37,15 @@ ERROR: decimal-test-failure D1 D2 quot ;
] unit-test
{ 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
{ t } [ T{ decimal f 90 0 } T{ decimal f 9 1 } = ] unit-test
{ t } [ DECIMAL: 1 DECIMAL: 2 before? ] unit-test
{ f } [ DECIMAL: 2 DECIMAL: 2 before? ] unit-test
{ f } [ DECIMAL: 3 DECIMAL: 2 before? ] unit-test
{ f } [ DECIMAL: -1 DECIMAL: -2 before? ] unit-test
{ f } [ DECIMAL: -2 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: 1 decimal: 2 before? ] unit-test
{ f } [ decimal: 2 decimal: 2 before? ] unit-test
{ f } [ decimal: 3 decimal: 2 before? ] unit-test
{ f } [ decimal: -1 decimal: -2 before? ] unit-test
{ f } [ decimal: -2 decimal: -2 before? ] unit-test
{ t } [ decimal: -3 decimal: -2 before? ] 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 ;
SYNTAX: DECIMAL: parse-decimal suffix! ;
SYNTAX: decimal: parse-decimal suffix! ;
: 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* ;
: 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 ;

2
libs/fjsc/fjsc.factor
View File

@ -32,7 +32,7 @@ TUPLE: ast-hashtable elements ;
[
{
[ blank? not ]
[ char: " = not ]
[ char: \" = not ]
[ char: ; = 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: 9 char: 6 }
{ char: & 0x214B }
{ char: ! 0x00A1 }
{ char: " 0x201E }
{ char: \! 0x00A1 }
{ char: \" 0x201E }
{ char: . 0x02D9 }
{ char: ; 0x061B }
{ char: [ char: ] }
{ char: ( char: ) }
{ char: { char: } }
{ char: \[ char: ] }
{ char: \( char: ) }
{ char: \{ char: } }
{ char: ? 0x00BF }
{ char: ! 0x00A1 }
{ char: \! 0x00A1 }
{ char: ' char: , }
{ char: < char: > }
{ char: _ 0x203E }

2
libs/hashcash/hashcash.factor
View File

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

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

@ -43,7 +43,7 @@ symbol: tagstack
char: ' (read-quote) ;
: read-double-quote ( sequence-parser -- string )
char: " (read-quote) ;
char: \" (read-quote) ;
: read-quote ( sequence-parser -- string )
dup get+increment char: ' =
@ -108,7 +108,7 @@ symbol: tagstack
: read-< ( sequence-parser -- string/f )
advance dup current [
char: ! = [ read-bang f ] [ read-tag ] if
char: \! = [ read-bang f ] [ read-tag ] if
] [
drop f
] 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 -- ) } } }
{ $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ;
HELP: COMPONENT:
{ $syntax "COMPONENT: name" }
HELP: component:
{ $syntax "component: name" }
{ $description "Defines a Chloe tag named " { $snippet "name" } " rendering the HTML component with class word " { $snippet "name" } ". See " { $link "html.components" } "." } ;
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" } } ":"
{ $code "M: image render* 2drop XML[[ <img src=<-> /> XML]] ;" }
"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" } ":"
{ $code "<t:image t:name='image' />" } ;
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" } ":"
{ $subsections
postpone\ COMPONENT:
postpone\ component:
"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 ;
COMPONENT: label
COMPONENT: link
COMPONENT: inspector
COMPONENT: comparison
COMPONENT: html
COMPONENT: hidden
COMPONENT: farkup
COMPONENT: field
COMPONENT: textarea
COMPONENT: password
COMPONENT: choice
COMPONENT: checkbox
COMPONENT: code
COMPONENT: xml
component: label
component: link
component: inspector
component: comparison
component: html
component: hidden
component: farkup
component: field
component: textarea
component: password
component: choice
component: checkbox
component: code
component: xml
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
render-quot [code] ;
SYNTAX: COMPONENT:
SYNTAX: component:
scan-word
[ name>> ] [ '[ _ component-tag ] ] bi
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
[
{
{ [ 2dup nth char: " = ] [ drop 1 + ] }
{ [ 2dup nth char: \" = ] [ drop 1 + ] }
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
[ f skip ]
} cond

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

@ -97,7 +97,7 @@ PEG: parse-response-line ( string -- triple )
[ " \t" member? ] satisfy repeat1 ;
: qdtext-parser ( -- parser )
{ [ char: " = ] [ control? ] } except-these ;
{ [ char: \" = ] [ control? ] } except-these ;
: quoted-char-parser ( -- parser )
"\\" 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: v char: \v }
{ char: ' char: ' }
{ char: " char: " }
{ char: \" char: \" }
{ char: \\ char: \\ }
{ char: ? char: ? }
{ char: ; char: ; }
{ char: [ char: [ }
{ char: \[ char: \[ }
{ char: ] char: ] }
{ char: = char: = }
} ?at [ bad-escape ] unless ;
@ -54,8 +54,8 @@ use: xml.entities
{ char: \\ "\\\\" }
{ char: ? "\\?" }
{ char: ; "\\;" }
{ char: [ "\\[" }
{ char: ] "\\]" }
{ char: \[ "\\[" }
{ char: \] "\\]" }
{ char: = "\\=" }
} escape-string-by ;
@ -87,12 +87,12 @@ symbol: option
: section? ( line -- index/f )
{
[ length 1 > ]
[ first char: [ = ]
[ char: ] swap last-index ]
[ first char: \[ = ]
[ char: \] swap last-index ]
} 1&& ;
: line-continues? ( line -- ? )
{ [ empty? not ] [ last char: \ = ] } 1&& ;
{ [ empty? not ] [ last char: \\ = ] } 1&& ;
: section, ( -- )
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.client.participants irc.client.internals ;
EXCLUDE: irc.messages => join ;
RENAME: join irc.messages => join_
RENAME: join irc.messages => join_ ;
in: irc.client.internals.tests
! Streams for testing

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

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

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

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

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-zero-divide+ 0x0400,0000 }
{ +fp-inexact+ 0x0200,0000 }
}
} ;
CONSTANT: ppc-fp-traps-bits 0xf8 ;
CONSTANT: ppc-fp-traps>bit
@ -82,7 +82,7 @@ CONSTANT: ppc-fp-traps>bit
{ +fp-underflow+ 0x20 }
{ +fp-zero-divide+ 0x10 }
{ +fp-inexact+ 0x08 }
}
} ;
CONSTANT: ppc-rounding-mode-bits 0x3 ;
CONSTANT: ppc-rounding-mode>bit
@ -91,7 +91,7 @@ CONSTANT: ppc-rounding-mode>bit
{ +round-zero+ 0x1 }
{ +round-up+ 0x2 }
{ +round-down+ 0x3 }
} >biassoc ]
} >biassoc ] ;
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-zero-divide+ 0x04 }
{ +fp-inexact+ 0x20 }
}
} ;
CONSTANT: sse-fp-traps-bits 0x1f80 ;
CONSTANT: sse-fp-traps>bit
@ -50,7 +50,7 @@ CONSTANT: sse-fp-traps>bit
{ +fp-underflow+ 0x0800 }
{ +fp-zero-divide+ 0x0200 }
{ +fp-inexact+ 0x1000 }
}
} ;
CONSTANT: sse-rounding-mode-bits 0x6000 ;
CONSTANT: sse-rounding-mode>bit
@ -59,7 +59,7 @@ CONSTANT: sse-rounding-mode>bit
{ +round-down+ 0x2000 }
{ +round-up+ 0x4000 }
{ +round-zero+ 0x6000 }
} >biassoc ]
} >biassoc ] ;
CONSTANT: sse-denormal-mode-bits 0x8040 ;
@ -99,7 +99,7 @@ CONSTANT: x87-exception>bit
{ +fp-zero-divide+ 0x04 }
{ +fp-inexact+ 0x20 }
{ +fp-x87-stack-fault+ 0x40 }
}
} ;
CONSTANT: x87-rounding-mode-bits 0x0c00 ;
CONSTANT: x87-rounding-mode>bit
@ -108,7 +108,7 @@ CONSTANT: x87-rounding-mode>bit
{ +round-down+ 0x0400 }
{ +round-up+ 0x0800 }
{ +round-zero+ 0x0c00 }
} >biassoc ]
} >biassoc ] ;
M: x87-env (get-exception-flags) ( register -- exceptions )
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" }
{ 71 "soixante et onze" } { 80 "quatre-vingts" }
{ 81 "quatre-vingt-un" }
{ 100 "cent" } { 1000 "mille" } }
{ 100 "cent" } { 1000 "mille" } } ;
MEMO: units ( -- seq ) ! up to 10^99
{ "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 ;
in: money.tests
{ -1/10 } [ DECIMAL: -.1 ] unit-test
{ -1/10 } [ DECIMAL: -0.1 ] unit-test
{ -1/10 } [ DECIMAL: -00.10 ] unit-test
{ -1/10 } [ decimal: -.1 ] unit-test
{ -1/10 } [ decimal: -0.1 ] unit-test
{ -1/10 } [ decimal: -00.10 ] unit-test
{ 0 } [ DECIMAL: .0 ] unit-test
{ 0 } [ DECIMAL: 0.0 ] unit-test
{ 0 } [ DECIMAL: 0. ] unit-test
{ 0 } [ DECIMAL: 0 ] unit-test
{ 1/10 } [ DECIMAL: .1 ] unit-test
{ 1/10 } [ DECIMAL: 0.1 ] unit-test
{ 1/10 } [ DECIMAL: 00.10 ] unit-test
{ 23 } [ DECIMAL: 23 ] unit-test
{ -23 } [ DECIMAL: -23 ] unit-test
{ -23-1/100 } [ DECIMAL: -23.01 ] unit-test
{ 0 } [ decimal: .0 ] unit-test
{ 0 } [ decimal: 0.0 ] unit-test
{ 0 } [ decimal: 0. ] unit-test
{ 0 } [ decimal: 0 ] unit-test
{ 1/10 } [ decimal: .1 ] unit-test
{ 1/10 } [ decimal: 0.1 ] unit-test
{ 1/10 } [ decimal: 00.10 ] unit-test
{ 23 } [ decimal: 23 ] unit-test
{ -23 } [ decimal: -23 ] unit-test
{ -23-1/100 } [ decimal: -23.01 ] unit-test
[ "DECIMAL: ." eval ] must-fail
[ "DECIMAL: f" eval ] must-fail
[ "DECIMAL: 0.f" eval ] must-fail
[ "DECIMAL: f.0" eval ] must-fail
[ "decimal: ." eval ] must-fail
[ "decimal: f" eval ] must-fail
[ "decimal: 0.f" eval ] must-fail
[ "decimal: f.0" eval ] must-fail
{ "$100.00" } [ DECIMAL: 100.0 money>string ] unit-test
{ "$0.00" } [ DECIMAL: 0.0 money>string ] unit-test
{ "$100.00" } [ decimal: 100.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@
] 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 )
readln unclip {
{ char: : [ string>number ] }
{ char: \: [ string>number ] }
{ char: + [ handle-response ] }
{ char: $ [ string>number read-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 )
{
{ 0 2650 DECIMAL: 0 }
{ 2650 10300 DECIMAL: .10 }
{ 10300 33960 DECIMAL: .15 }
{ 33960 79725 DECIMAL: .25 }
{ 79725 166500 DECIMAL: .28 }
{ 166500 359650 DECIMAL: .33 }
{ 359650 1/0. DECIMAL: .35 }
{ 0 2650 decimal: 0 }
{ 2650 10300 decimal: .10 }
{ 10300 33960 decimal: .15 }
{ 33960 79725 decimal: .25 }
{ 79725 166500 decimal: .28 }
{ 166500 359650 decimal: .33 }
{ 359650 1/0. decimal: .35 }
} ;
: federal-married ( -- triples )
{
{ 0 8000 DECIMAL: 0 }
{ 8000 23550 DECIMAL: .10 }
{ 23550 72150 DECIMAL: .15 }
{ 72150 137850 DECIMAL: .25 }
{ 137850 207700 DECIMAL: .28 }
{ 207700 365100 DECIMAL: .33 }
{ 365100 1/0. DECIMAL: .35 }
{ 0 8000 decimal: 0 }
{ 8000 23550 decimal: .10 }
{ 23550 72150 decimal: .15 }
{ 72150 137850 decimal: .25 }
{ 137850 207700 decimal: .28 }
{ 207700 365100 decimal: .33 }
{ 365100 1/0. decimal: .35 }
} ;
singleton: federal

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

@ -3,7 +3,7 @@
USING: accessors math math.order money kernel assocs ;
in: taxes.usa.fica
: fica-tax-rate ( -- x ) DECIMAL: .062 ; inline
: fica-tax-rate ( -- x ) decimal: .062 ; inline
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
! 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-tax-offset-credit ( -- x ) DECIMAL: .054 ; inline
: futa-tax-offset-credit ( -- x ) decimal: .054 ; inline
: futa-tax ( salary w4 -- x )
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
! 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 * ;

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

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

4
libs/tnetstrings/tnetstrings.factor
View File

@ -44,10 +44,10 @@ defer: parse-tnetstring
: parse-tnetstring ( data -- remain value )
parse-payload {
{ char: # [ string>number ] }
{ char: " [ ] }
{ char: \" [ ] }
{ char: } [ parse-dict ] }
{ char: ] [ parse-list ] }
{ char: ! [ parse-bool ] }
{ char: \! [ parse-bool ] }
{ char: ~ [ parse-null ] }
{ char: , [ ] }
[ "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 )
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* ;

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

@ -109,7 +109,7 @@ M: server-error error.
"Description: " write dup message>> print
"Tag: " write tag>> xml>string print ;
TAGS: xml>item ( tag -- object )
TAGS: xml>item ( tag -- object ) ;
TAG: string xml>item
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: } ;
HELP: TAGS:
{ $syntax "TAGS: word" }
{ $syntax "TAGS: word effect ;" }
{ $values { "word" "a new word to define" } }
{ $description "Creates a new word to which dispatches on XML tag names." }
{ $see-also postpone\ TAG: } ;

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

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

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

@ -28,7 +28,7 @@ M: no-tag summary
PRIVATE>
SYNTAX: TAGS:
scan-new-word scan-effect
scan-new-word scan-effect ";" expect
[ drop H{ } clone "xtable" set-word-prop ]
[ define-tags ]
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 ;
TAGS: parse-mode-tag ( modes tag -- )
TAGS: parse-mode-tag ( modes tag -- ) ;
TAG: MODE parse-mode-tag
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
! RULES and its children
TAGS: parse-rule-tag ( rule-set tag -- )
TAGS: parse-rule-tag ( rule-set tag -- ) ;
TAG: PROPS parse-rule-tag
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 ] , ;
! SPAN's children
TAGS: parse-begin/end-tag ( rule tag -- )
TAGS: parse-begin/end-tag ( rule tag -- ) ;
TAG: BEGIN parse-begin/end-tag
! XXX

13
modern-transition.factor
View File

@ -15,6 +15,19 @@
[ 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
{ "constructors" "descriptive" "eval" "functors" "literals"
"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 )
"," split [ string>number ] map ;
TAGS: adsoda-read-model ( tag -- model )
TAGS: adsoda-read-model ( tag -- model ) ;
TAG: dimension adsoda-read-model
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.ui.commandparser irc.ui.load vocabs.loader classes prettyprint ;
RENAME: join sequences => sjoin
RENAME: join sequences => sjoin ;
in: irc.ui