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

Merge branch 'master' of git://factorcode.org/git/factor

db4
U-SLAVA-DFB8FF805\Slava 2009-04-08 18:13:47 -05:00
parent 94baa7d7fa 30191f87e5
commit 2bca28e4dc
166 changed files with 4181 additions and 1206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -166,7 +166,7 @@ factor-ffi-test: vm/ffi_test.o
clean:
rm -f vm/*.o
rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib}
rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib} Factor.app/Contents/Frameworks/libfactor.dylib
vm/resources.o:
$(WINDRES) vm/factor.rs vm/resources.o

7
basis/alien/fortran/fortran.factor
View File

@ -8,7 +8,7 @@ io.encodings.ascii io.encodings.string shuffle effects math.ranges
math.order sorting strings system alien.libraries ;
IN: alien.fortran
SINGLETONS: f2c-abi gfortran-abi intel-unix-abi intel-windows-abi ;
SINGLETONS: f2c-abi g95-abi gfortran-abi intel-unix-abi intel-windows-abi ;
<<
: add-f2c-libraries ( -- )
@ -42,30 +42,35 @@ library-fortran-abis [ H{ } clone ] initialize
HOOK: fortran-c-abi fortran-abi ( -- abi )
M: f2c-abi fortran-c-abi "cdecl" ;
M: g95-abi fortran-c-abi "cdecl" ;
M: gfortran-abi fortran-c-abi "cdecl" ;
M: intel-unix-abi fortran-c-abi "cdecl" ;
M: intel-windows-abi fortran-c-abi "cdecl" ;
HOOK: real-functions-return-double? fortran-abi ( -- ? )
M: f2c-abi real-functions-return-double? t ;
M: g95-abi real-functions-return-double? f ;
M: gfortran-abi real-functions-return-double? f ;
M: intel-unix-abi real-functions-return-double? f ;
M: intel-windows-abi real-functions-return-double? f ;
HOOK: complex-functions-return-by-value? fortran-abi ( -- ? )
M: f2c-abi complex-functions-return-by-value? f ;
M: g95-abi complex-functions-return-by-value? f ;
M: gfortran-abi complex-functions-return-by-value? t ;
M: intel-unix-abi complex-functions-return-by-value? f ;
M: intel-windows-abi complex-functions-return-by-value? f ;
HOOK: character(1)-maps-to-char? fortran-abi ( -- ? )
M: f2c-abi character(1)-maps-to-char? f ;
M: g95-abi character(1)-maps-to-char? f ;
M: gfortran-abi character(1)-maps-to-char? f ;
M: intel-unix-abi character(1)-maps-to-char? t ;
M: intel-windows-abi character(1)-maps-to-char? t ;
HOOK: mangle-name fortran-abi ( name -- name' )
M: f2c-abi mangle-name lowercase-name-with-extra-underscore ;
M: g95-abi mangle-name lowercase-name-with-extra-underscore ;
M: gfortran-abi mangle-name lowercase-name-with-underscore ;
M: intel-unix-abi mangle-name lowercase-name-with-underscore ;
M: intel-windows-abi mangle-name >upper ;

1
basis/alien/syntax/tags.txt Normal file
View File

@ -0,0 +1 @@
extensions

2
basis/binary-search/binary-search-docs.factor
View File

@ -14,7 +14,7 @@ $nl
HELP: sorted-index
{ $values { "obj" object } { "seq" "a sorted sequence" } { "i" "an index, or " { $link f } } }
{ $description "Outputs the index and value of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." }
{ $description "Outputs the index of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." }
{ $notes "If the sequence has at least one element, this word always outputs a valid index, because it finds the closest match, not necessarily an exact one. In this respect its behavior differs from " { $link index } "." } ;
{ index index-from last-index last-index-from sorted-index } related-words

12
basis/bootstrap/stage2.factor
View File

@ -45,11 +45,18 @@ SYMBOL: bootstrap-time
[ optimized>> ] count-words " compiled words" print
[ symbol? ] count-words " symbol words" print
[ ] count-words " words total" print
"Bootstrapping is complete." print
"Now, you can run Factor:" print
vm write " -i=" write "output-image" get print flush ;
: save/restore-error ( quot -- )
error get-global
error-continuation get-global
[ call ] 2dip
error-continuation set-global
error set-global ; inline
[
! We time bootstrap
millis
@ -104,6 +111,7 @@ SYMBOL: bootstrap-time
drop
[
load-help? off
"vocab:bootstrap/bootstrap-error.factor" run-file
[ "vocab:bootstrap/bootstrap-error.factor" parse-file ] save/restore-error
call
] with-scope
] recover

2
basis/colors/colors-docs.factor
View File

@ -23,7 +23,7 @@ $nl
ARTICLE: "colors" "Colors"
"The " { $vocab-link "colors" } " vocabulary defines a protocol for colors, with a concrete implementation for RGBA colors. This vocabulary is used by " { $vocab-link "io.styles" } ", " { $vocab-link "ui" } " and other vocabularies, but it is independent of them."
$nl
"RGBA colors:"
"RGBA colors with floating point components in the range " { $snippet "[0,1]" } ":"
{ $subsection rgba }
{ $subsection <rgba> }
"Converting a color to RGBA:"

1
basis/combinators/short-circuit/smart/tags.txt Normal file
View File

@ -0,0 +1 @@
extensions

1
basis/combinators/short-circuit/tags.txt Normal file
View File

@ -0,0 +1 @@
extensions

14
basis/combinators/smart/smart-docs.factor
View File

@ -108,17 +108,19 @@ HELP: append-outputs-as
ARTICLE: "combinators.smart" "Smart combinators"
"The " { $vocab-link "combinators.smart" } " vocabulary implements " { $emphasis "smart combinators" } ". A smart combinator is one whose behavior depends on the static stack effect of an input quotation." $nl
"Smart inputs from a sequence:"
"The macros in the " { $vocab-link "combinators.smart" } " vocabulary look at the static stack effects of input quotations and generate code which produces or consumes the relevant number of stack values." $nl
"Call a quotation and discard all output values:"
{ $subsection drop-outputs }
"Take all input values from a sequence:"
{ $subsection input<sequence }
"Smart outputs to a sequence:"
"Store all output values to a sequence:"
{ $subsection output>sequence }
{ $subsection output>array }
"Reducing the output of a quotation:"
"Reducing the set of output values:"
{ $subsection reduce-outputs }
"Summing the output of a quotation:"
"Summing output values:"
{ $subsection sum-outputs }
"Appending the results of a quotation:"
"Concatenating output values:"
{ $subsection append-outputs }
{ $subsection append-outputs-as } ;

1
basis/combinators/smart/tags.txt Normal file
View File

@ -0,0 +1 @@
extensions

1
basis/command-line/command-line.factor
View File

@ -60,7 +60,6 @@ SYMBOL: main-vocab-hook
: default-cli-args ( -- )
global [
"quiet" off
"script" off
"e" off
"user-init" on
embedded? "quiet" set

2
basis/compiler/cfg/linear-scan/allocation/allocation.factor
View File

@ -99,7 +99,7 @@ SYMBOL: spill-counts
: interval-to-spill ( active-intervals current -- live-interval )
#! We spill the interval with the most distant use location.
start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
unclip-slice [ [ [ second ] bi@ > ] most ] reduce first ;
[ ] [ [ [ second ] bi@ > ] most ] map-reduce first ;
: assign-spill ( before after -- before after )
#! If it has been spilled already, reuse spill location.

2
basis/compiler/tree/debugger/debugger.factor
View File

@ -130,8 +130,6 @@ M: node node>quot drop ;
GENERIC: optimized. ( quot/word -- )
M: method-spec optimized. first2 method optimized. ;
M: word optimized. specialized-def optimized. ;
M: callable optimized. build-tree optimize-tree nodes>quot . ;

2
basis/compiler/tree/propagation/info/info.factor
View File

@ -238,7 +238,7 @@ DEFER: (value-info-union)
: value-infos-union ( infos -- info )
[ null-info ]
[ unclip-slice [ value-info-union ] reduce ] if-empty ;
[ [ ] [ value-info-union ] map-reduce ] if-empty ;
: literals<= ( info1 info2 -- ? )
{

4
basis/concurrency/conditions/conditions.factor
View File

@ -20,10 +20,12 @@ IN: concurrency.conditions
]
] dip later ;
ERROR: wait-timeout ;
: wait ( queue timeout status -- )
over [
[ queue-timeout [ drop ] ] dip suspend
[ "Timeout" throw ] [ cancel-alarm ] if
[ wait-timeout ] [ cancel-alarm ] if
] [
[ drop '[ _ push-front ] ] dip suspend drop
] if ;

16
basis/concurrency/mailboxes/mailboxes-tests.factor
View File

@ -1,6 +1,6 @@
IN: concurrency.mailboxes.tests
USING: concurrency.mailboxes concurrency.count-downs vectors
sequences threads tools.test math kernel strings namespaces
USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions
vectors sequences threads tools.test math kernel strings namespaces
continuations calendar destructors ;
{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
@ -75,3 +75,15 @@ continuations calendar destructors ;
[ ] [ "d" get 5 seconds await-timeout ] unit-test
[ ] [ "m" get dispose ] unit-test
[ { "foo" "bar" } ] [
<mailbox>
"foo" over mailbox-put
"bar" over mailbox-put
mailbox-get-all
] unit-test
[
<mailbox> 1 seconds mailbox-get-timeout
] [ wait-timeout? ] must-fail-with

2
basis/concurrency/mailboxes/mailboxes.factor
View File

@ -49,7 +49,7 @@ M: mailbox dispose* threads>> notify-all ;
: mailbox-get-all-timeout ( mailbox timeout -- array )
block-if-empty
[ dup mailbox-empty? ]
[ dup mailbox-empty? not ]
[ dup data>> pop-back ]
produce nip ;

5
basis/db/errors/sqlite/sqlite.factor
View File

@ -4,7 +4,8 @@ USING: accessors combinators db kernel sequences peg.ebnf
strings db.errors ;
IN: db.errors.sqlite
ERROR: unparsed-sqlite-error error ;
TUPLE: unparsed-sqlite-error error ;
C: <unparsed-sqlite-error> unparsed-sqlite-error
SINGLETONS: table-exists table-missing ;
@ -22,4 +23,6 @@ SqliteError =
=> [[ table >string message sqlite-table-error ]]
| "no such table: " .+:table
=> [[ table >string <sql-table-missing> ]]
| .*:error
=> [[ error >string <unparsed-sqlite-error> ]]
;EBNF

7
basis/delegate/protocols/protocols.factor
View File

@ -1,7 +1,6 @@
! Copyright (C) 2007 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: delegate sequences.private sequences assocs
io definitions kernel continuations ;
USING: delegate sequences.private sequences assocs io ;
IN: delegate.protocols
PROTOCOL: sequence-protocol
@ -19,7 +18,3 @@ stream-read-until ;
PROTOCOL: output-stream-protocol
stream-flush stream-write1 stream-write stream-nl ;
PROTOCOL: definition-protocol
where set-where forget uses
synopsis* definer definition ;

2
basis/editors/editors-docs.factor
View File

@ -22,7 +22,7 @@ HELP: edit
"A word's documentation:"
{ $code "\\ foo >link edit" }
"A method definition:"
{ $code "{ editor draw-gadget* } edit" }
{ $code "M\\ fixnum + edit" }
"A help article:"
{ $code "\"handbook\" >link edit" }
} ;

1
basis/furnace/actions/actions.factor
View File

@ -9,6 +9,7 @@ http.server.responses
furnace.utilities
furnace.redirection
furnace.conversations
furnace.chloe-tags
html.forms
html.components
html.components

1
basis/furnace/furnace.factor
View File

@ -17,7 +17,6 @@ USE: vocabs.loader
"furnace.auth.providers.db" require
"furnace.auth.providers.null" require
"furnace.boilerplate" require
"furnace.chloe-tags" require
"furnace.conversations" require
"furnace.db" require
"furnace.json" require

4
basis/furnace/redirection/redirection.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors combinators namespaces fry urls http
http.server http.server.redirection http.server.responses
USING: kernel accessors combinators namespaces fry urls urls.secure
http http.server http.server.redirection http.server.responses
http.server.remapping http.server.filters furnace.utilities ;
IN: furnace.redirection

2
basis/help/cookbook/cookbook.factor
View File

@ -117,7 +117,7 @@ $nl
}
{ $references
{ "Since quotations are objects, they can be constructed and taken apart at will. You can write code that writes code. Arrays are just one of the various types of sequences, and the sequence operations such as " { $link each } " and " { $link map } " operate on all types of sequences. There are many more sequence iteration operations than the ones above, too." }
"dataflow"
"combinators"
"sequences"
} ;

89
basis/help/handbook/handbook.factor
View File

@ -5,7 +5,7 @@ math system strings sbufs vectors byte-arrays quotations
io.streams.byte-array classes.builtin parser lexer
classes.predicate classes.union classes.intersection
classes.singleton classes.tuple help.vocabs math.parser
accessors ;
accessors definitions ;
IN: help.handbook
ARTICLE: "conventions" "Conventions"
@ -49,7 +49,7 @@ $nl
{ "associative mapping" { "an object whose class implements the " { $link "assocs-protocol" } } }
{ "boolean" { { $link t } " or " { $link f } } }
{ "class" { "a set of objects identified by a " { $emphasis "class word" } " together with a discriminating predicate. See " { $link "classes" } } }
{ "definition specifier" { "a " { $link word } ", " { $link method-spec } ", " { $link link } ", vocabulary specifier, or any other object whose class implements the " { $link "definition-protocol" } } }
{ "definition specifier" { "an instance of " { $link definition } " which implements the " { $link "definition-protocol" } } }
{ "generalized boolean" { "an object interpreted as a boolean; a value of " { $link f } " denotes false and anything else denotes true" } }
{ "generic word" { "a word whose behavior depends can be specialized on the class of one of its inputs. See " { $link "generic" } } }
{ "method" { "a specialized behavior of a generic word on a class. See " { $link "generic" } } }
@ -70,7 +70,7 @@ ARTICLE: "tail-call-opt" "Tail-call optimization"
$nl
"Tail-call optimization allows iterative algorithms to be implemented in an efficient manner using recursion, without the need for any kind of primitive looping construct in the language. However, in practice, most iteration is performed via combinators such as " { $link while } ", " { $link each } ", " { $link map } ", " { $link assoc-each } ", and so on. The definitions of these combinators do bottom-out in recursive words, however." ;
ARTICLE: "evaluator" "Evaluation semantics"
ARTICLE: "evaluator" "Stack machine model"
{ $link "quotations" } " are evaluated sequentially from beginning to end. When the end is reached, the quotation returns to its caller. As each object in the quotation is evaluated in turn, an action is taken based on its type:"
{ $list
{ "a " { $link word } " - the word's definition quotation is called. See " { $link "words" } }
@ -84,12 +84,13 @@ ARTICLE: "objects" "Objects"
"An " { $emphasis "object" } " is any datum which may be identified. All values are objects in Factor. Each object carries type information, and types are checked at runtime; Factor is dynamically typed."
{ $subsection "equality" }
{ $subsection "math.order" }
{ $subsection "destructors" }
{ $subsection "classes" }
{ $subsection "tuples" }
{ $subsection "generic" }
{ $subsection "slots" }
{ $subsection "mirrors" } ;
"Advanced features:"
{ $subsection "delegate" }
{ $subsection "mirrors" }
{ $subsection "slots" } ;
ARTICLE: "numbers" "Numbers"
{ $subsection "arithmetic" }
@ -118,9 +119,9 @@ ARTICLE: "collections" "Collections"
"Fixed-length sequences:"
{ $subsection "arrays" }
{ $subsection "quotations" }
"Fixed-length specialized sequences:"
{ $subsection "strings" }
{ $subsection "byte-arrays" }
{ $subsection "specialized-arrays" }
"Resizable sequences:"
{ $subsection "vectors" }
{ $subsection "byte-vectors" }
@ -128,7 +129,8 @@ ARTICLE: "collections" "Collections"
{ $subsection "growable" }
{ $heading "Associative mappings" }
{ $subsection "assocs" }
{ $subsection "namespaces" }
{ $subsection "linked-assocs" }
{ $subsection "biassocs" }
{ $subsection "refs" }
"Implementations:"
{ $subsection "hashtables" }
@ -140,26 +142,29 @@ ARTICLE: "collections" "Collections"
{ $subsection "dlists" }
{ $subsection "search-deques" }
{ $heading "Other collections" }
{ $subsection "boxes" }
{ $subsection "lists" }
{ $subsection "disjoint-sets" }
{ $subsection "interval-maps" }
{ $subsection "heaps" }
{ $subsection "boxes" }
{ $subsection "graphs" }
{ $subsection "buffers" }
"There are also many other vocabularies tagged " { $link T{ vocab-tag { name "collections" } } } " in the library." ;
USING: io.encodings.utf8 io.encodings.utf16 io.encodings.binary io.encodings.ascii io.files ;
USING: io.encodings.utf8 io.encodings.binary io.files ;
ARTICLE: "encodings-introduction" "An introduction to encodings"
"In order to express text in terms of binary, some sort of encoding has to be used. In a modern context, this is understood as a two-way mapping between Unicode code points (characters) and some amount of binary. Since English isn't the only language in the world, ASCII is not sufficient as a mapping from binary to Unicode; it can't even express em-dashes or curly quotes. Unicode was designed as a universal character set that could potentially represent everything." $nl
"Not all encodings can represent all Unicode code points, but Unicode can represent basically everything that exists in modern encodings. Some encodings are language-specific, and some can represent everything in Unicode. Though the world is moving toward Unicode and UTF-8, the reality today is that there are several encodings which must be taken into account." $nl
"Factor uses a system of encoding descriptors to denote encodings. Encoding descriptors are objects which describe encodings. Examples are " { $link utf8 } ", " { $link ascii } " and " { $link binary } ". Encoding descriptors can be passed around independently. Each encoding descriptor has some method for constructing an encoded or decoded stream, and the resulting stream has an encoding descriptor stored which has methods for reading or writing characters." $nl
"Factor uses a system of encoding descriptors to denote encodings. Encoding descriptors are objects which describe encodings. Examples are " { $link utf8 } " and " { $link binary } ". Encoding descriptors can be passed around independently. Each encoding descriptor has some method for constructing an encoded or decoded stream, and the resulting stream has an encoding descriptor stored which has methods for reading or writing characters." $nl
"Constructors for streams which deal with bytes usually take an encoding as an explicit parameter. For example, to open a text file for reading whose contents are in UTF-8, use the following"
{ $code "\"file.txt\" utf8 <file-reader>" }
"If there is an error in the encoded stream, a replacement character (0xFFFD) will be inserted. To throw an exception upon error, use a strict encoding as follows"
{ $code "\"file.txt\" utf8 strict <file-reader>" }
"In a similar way, encodings can be specified when opening a file for writing."
{ $code "\"file.txt\" ascii <file-writer>" }
{ $code "USE: io.encodings.ascii" "\"file.txt\" ascii <file-writer>" }
"An encoding is also needed for some words that don't return streams, such as " { $link file-contents } ", for example"
{ $code "\"file.txt\" utf16 file-contents" }
{ $code "USE: io.encodings.utf16" "\"file.txt\" utf16 file-contents" }
"Encoding descriptors are also used by " { $link "io.streams.byte-array" } " and taken by combinators like " { $link with-file-writer } " and " { $link with-byte-reader } " which deal with streams. It is " { $emphasis "not" } " used with " { $link "io.streams.string" } " because these deal with abstract text."
$nl
"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text." ;
@ -239,40 +244,57 @@ ARTICLE: "class-index" "Class index"
{ $heading "Predicate classes" }
{ $index [ classes [ predicate-class? ] filter ] } ;
ARTICLE: "program-org" "Program organization"
{ $subsection "definitions" }
{ $subsection "vocabularies" }
{ $subsection "parser" }
{ $subsection "vocabs.loader" }
{ $subsection "source-files" } ;
USING: help.cookbook help.tutorial ;
ARTICLE: "handbook-language-reference" "Language reference"
"Fundamentals:"
{ $subsection "conventions" }
{ $subsection "syntax" }
{ $subsection "dataflow" }
{ $subsection "objects" }
{ $subsection "program-org" }
{ $subsection "effects" }
"Data types:"
{ $subsection "booleans" }
{ $subsection "numbers" }
{ $subsection "collections" }
{ $subsection "io" }
"Evaluation semantics:"
{ $subsection "evaluator" }
{ $subsection "words" }
{ $subsection "shuffle-words" }
{ $subsection "combinators" }
{ $subsection "errors" }
{ $subsection "continuations" }
"Named values:"
{ $subsection "locals" }
{ $subsection "namespaces" }
{ $subsection "namespaces-global" }
{ $subsection "values" }
"Abstractions:"
{ $subsection "objects" }
{ $subsection "destructors" }
{ $subsection "macros" }
{ $subsection "fry" }
"Program organization:"
{ $subsection "vocabs.loader" }
"Vocabularies tagged " { $link T{ vocab-tag { name "extensions" } } } " implement various additional language abstractions." ;
ARTICLE: "handbook-environment-reference" "Environment reference"
"Parse time and compile time:"
{ $subsection "parser" }
{ $subsection "definitions" }
{ $subsection "vocabularies" }
{ $subsection "source-files" }
{ $subsection "compiler" }
"Tools:"
{ $subsection "prettyprint" }
{ $subsection "tools" }
{ $subsection "cli" }
{ $subsection "rc-files" }
{ $subsection "help" }
{ $subsection "inference" }
{ $subsection "compiler" }
{ $subsection "system" }
{ $subsection "images" }
{ $subsection "alien" }
"VM:"
{ $subsection "cli" }
{ $subsection "rc-files" }
{ $subsection "init" }
{ $subsection "layouts" }
{ $see-also "program-org" } ;
{ $subsection "system" }
{ $subsection "layouts" } ;
ARTICLE: "handbook-library-reference" "Library reference"
"This index only includes articles from loaded vocabularies. To explore more vocabularies, see " { $link "vocab-index" } "."
@ -282,9 +304,14 @@ ARTICLE: "handbook" "Factor handbook"
"Learn the language:"
{ $subsection "cookbook" }
{ $subsection "first-program" }
"Reference material:"
{ $subsection "handbook-language-reference" }
{ $subsection "handbook-environment-reference" }
{ $subsection "io" }
{ $subsection "ui" }
{ $subsection "ui-tools" }
{ $subsection "unicode" }
{ $subsection "alien" }
{ $subsection "handbook-library-reference" }
"Explore loaded libraries:"
{ $subsection "article-index" }

1
basis/help/home/home-docs.factor
View File

@ -8,7 +8,6 @@ ARTICLE: "help.home" "Factor documentation"
{ $link "handbook" }
{ $link "vocab-index" }
{ $link "ui-tools" }
{ $link "handbook-library-reference" }
}
{ $heading "Recently visited" }
{ $table

2
basis/help/home/home.factor
View File

@ -21,7 +21,7 @@ M: apropos add-recent-where recent-searches ;
M: object add-recent-where f ;
: $recent ( element -- )
first get [ nl ] [ 1array $pretty-link ] interleave ;
first get reverse [ nl ] [ 1array $pretty-link ] interleave ;
: $recent-searches ( element -- )
drop recent-searches get [ <$link> ] map $list ;

1
basis/help/syntax/tags.txt Normal file
View File

@ -0,0 +1 @@
extensions

7
basis/hints/hints.factor
View File

@ -25,7 +25,7 @@ M: object specializer-declaration class ;
[ drop object eq? not ] assoc-filter
[ [ t ] ] [
[ swap specializer-predicate append ] { } assoc>map
unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
[ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce
] if-empty ;
: specializer-cases ( quot word -- default alist )
@ -65,7 +65,6 @@ M: object specializer-declaration class ;
SYNTAX: HINTS:
scan-object
dup method-spec? [ first2 method ] when
[ redefined ]
[ parse-definition "specializer" set-word-prop ] bi ;
@ -119,6 +118,6 @@ SYNTAX: HINTS:
\ >be { { bignum fixnum } { fixnum fixnum } } "specializer" set-word-prop
\ hashtable \ at* method { { fixnum object } { word object } } "specializer" set-word-prop
M\ hashtable at* { { fixnum object } { word object } } "specializer" set-word-prop
\ hashtable \ set-at method { { object fixnum object } { object word object } } "specializer" set-word-prop
M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop

9
basis/http/client/client.factor
View File

@ -6,7 +6,7 @@ math.order hashtables byte-arrays destructors
io io.sockets io.streams.string io.files io.timeouts
io.pathnames io.encodings io.encodings.string io.encodings.ascii
io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.crlf
io.streams.duplex fry ascii urls urls.encoding present
io.streams.duplex fry ascii urls urls.encoding present locals
http http.parsers http.client.post-data ;
IN: http.client
@ -77,12 +77,13 @@ SYMBOL: redirects
: redirect? ( response -- ? )
code>> 300 399 between? ;
: do-redirect ( quot: ( chunk -- ) response -- response )
:: do-redirect ( quot: ( chunk -- ) response -- response )
redirects inc
redirects get max-redirects < [
request get clone
swap "location" header redirect-url
"GET" >>method swap (with-http-request)
response "location" header redirect-url
response code>> 307 = [ "GET" >>method ] unless
quot (with-http-request)
] [ too-many-redirects ] if ; inline recursive
: read-chunk-size ( -- n )

43
basis/http/http-tests.factor
View File

@ -1,8 +1,8 @@
USING: http http.server http.client http.client.private tools.test multiline
io.streams.string io.encodings.utf8 io.encodings.8-bit
io.encodings.binary io.encodings.string kernel arrays splitting
sequences assocs io.sockets db db.sqlite continuations urls
hashtables accessors namespaces xml.data ;
USING: http http.server http.client http.client.private tools.test
multiline io.streams.string io.encodings.utf8 io.encodings.8-bit
io.encodings.binary io.encodings.string io.encodings.ascii kernel
arrays splitting sequences assocs io.sockets db db.sqlite
continuations urls hashtables accessors namespaces xml.data ;
IN: http.tests
[ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test
@ -359,4 +359,37 @@ SYMBOL: a
! Test basic auth
[ "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" ] [ <request> "Aladdin" "open sesame" set-basic-auth "Authorization" header ] unit-test
! Test a corner case with static responder
[ ] [
<dispatcher>
add-quit-action
"vocab:http/test/foo.html" <static> >>default
test-httpd
] unit-test
[ t ] [
"http://localhost/" add-port http-get nip
"vocab:http/test/foo.html" ascii file-contents =
] unit-test
[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
! Check behavior of 307 redirect (reported by Chris Double)
[ ] [
<dispatcher>
add-quit-action
<action>
[ "b" <temporary-redirect> ] >>submit
"a" add-responder
<action>
[
request get post-data>> data>> "data" =
[ "OK" "text/plain" <content> ] [ "OOPS" throw ] if
] >>submit
"b" add-responder
test-httpd
] unit-test
[ "OK" ] [ "data" "http://localhost/a" add-port http-post nip ] unit-test
[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test

4
basis/http/server/static/static.factor
View File

@ -47,8 +47,8 @@ TUPLE: file-responder root hook special allow-listings ;
if ;
: serving-path ( filename -- filename )
[ file-responder get root>> trim-tail-separators "/" ] dip
"" or trim-head-separators 3append ;
[ file-responder get root>> trim-tail-separators ] dip
[ "/" swap trim-head-separators 3append ] unless-empty ;
: serve-file ( filename -- response )
dup mime-type

1
basis/interpolate/tags.txt Normal file
View File

@ -0,0 +1 @@
extensions

6
basis/io/streams/limited/limited-tests.factor
View File

@ -76,3 +76,9 @@ IN: io.streams.limited.tests
[ decoder? ] both?
] with-destructors
] unit-test
[ "HELL" ] [
"HELLO"
[ f stream-throws limit-input 4 read ]
with-string-reader
] unit-test

8
basis/io/streams/limited/limited.factor
View File

@ -22,7 +22,7 @@ M: decoder limit ( stream limit mode -- stream' )
[ clone ] 2dip '[ _ _ limit ] change-stream ;
M: object limit ( stream limit mode -- stream' )
<limited-stream> ;
over [ <limited-stream> ] [ 2drop ] if ;
GENERIC: unlimited ( stream -- stream' )
@ -32,9 +32,11 @@ M: decoder unlimited ( stream -- stream' )
M: object unlimited ( stream -- stream' )
stream>> stream>> ;
: limit-input ( limit mode -- ) input-stream [ -rot limit ] change ;
: limit-input ( limit mode -- )
[ input-stream ] 2dip '[ _ _ limit ] change ;
: unlimited-input ( -- ) input-stream [ unlimited ] change ;
: unlimited-input ( -- )
input-stream [ unlimited ] change ;
: with-unlimited-stream ( stream quot -- )
[ clone unlimited ] dip call ; inline

11
basis/locals/locals-docs.factor
View File

@ -112,7 +112,15 @@ HELP: MEMO::
{ $description "Defines a memoized word with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope." } ;
{ POSTPONE: MEMO: POSTPONE: MEMO:: } related-words
HELP: M::
{ $syntax "M:: class generic ( bindings... -- outputs... ) body... ;" }
{ $description "Defines a method with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope." }
{ $notes "The output names do not affect the word's behavior, however the compiler attempts to check the stack effect as with other definitions." } ;
{ POSTPONE: M: POSTPONE: M:: } related-words
ARTICLE: "locals-literals" "Locals in literals"
"Certain data type literals are permitted to contain free variables. Any such literals are written into code which constructs an instance of the type with the free variable values spliced in. Conceptually, this is similar to the transformation applied to quotations containing free variables."
$nl
@ -237,13 +245,14 @@ $nl
}
"The reason is that locals are rewritten into stack code at parse time, whereas macro expansion is performed later during compile time. To circumvent this problem, the " { $vocab-link "macros.expander" } " vocabulary is used to rewrite simple macro usages prior to local transformation, however "{ $vocab-link "macros.expander" } " does not deal with more complicated cases where the literal inputs to the macro do not immediately precede the macro call in the source." ;
ARTICLE: "locals" "Local variables and lexical closures"
ARTICLE: "locals" "Lexical variables and closures"
"The " { $vocab-link "locals" } " vocabulary implements lexical scope with full closures, both downward and upward. Mutable bindings are supported, including assignment to bindings in outer scope."
$nl
"Compile-time transformation is used to compile local variables to efficient code; prettyprinter extensions are defined so that " { $link see } " can display original word definitions with local variables and not the closure-converted concatenative code which results."
$nl
"Applicative word definitions where the inputs are named local variables:"
{ $subsection POSTPONE: :: }
{ $subsection POSTPONE: M:: }
{ $subsection POSTPONE: MEMO:: }
{ $subsection POSTPONE: MACRO:: }
"Lexical binding forms:"

2
basis/locals/locals-tests.factor
View File

@ -455,7 +455,7 @@ GENERIC: lambda-method-forget-test ( a -- b )
M:: integer lambda-method-forget-test ( a -- b ) ;
[ ] [ [ { integer lambda-method-forget-test } forget ] with-compilation-unit ] unit-test
[ ] [ [ M\ integer lambda-method-forget-test forget ] with-compilation-unit ] unit-test
[ 10 ] [ 10 [| A | { [ A ] } ] call first call ] unit-test

1
basis/math/blas/config/config.factor
View File

@ -15,6 +15,7 @@ blas-fortran-abi [
{
{ [ os macosx? ] [ intel-unix-abi ] }
{ [ os windows? cpu x86.32? and ] [ f2c-abi ] }
{ [ os netbsd? cpu x86.64? and ] [ g95-abi ] }
{ [ os windows? cpu x86.64? and ] [ gfortran-abi ] }
{ [ os freebsd? ] [ gfortran-abi ] }
{ [ os linux? cpu x86.32? and ] [ gfortran-abi ] }

4
basis/math/ranges/ranges-docs.factor
View File

@ -2,7 +2,7 @@ USING: help.syntax help.markup arrays sequences ;
IN: math.ranges
ARTICLE: "ranges" "Ranges"
ARTICLE: "math.ranges" "Numeric ranges"
"A " { $emphasis "range" } " is a virtual sequence with real number elements "
"ranging from " { $emphasis "a" } " to " { $emphasis "b" } " by " { $emphasis "step" } ". Ascending as well as descending ranges are supported."
$nl
@ -24,4 +24,4 @@ $nl
{ $code "100 1 [a,b] product" }
"A range can be converted into a concrete sequence using a word such as " { $link >array } ". In most cases this is unnecessary since ranges implement the sequence protocol already. It is necessary if a mutable sequence is needed, for use with words such as " { $link set-nth } " or " { $link change-each } "." ;
ABOUT: "ranges"
ABOUT: "math.ranges"

21
basis/models/arrow/smart/smart-docs.factor Normal file
View File

@ -0,0 +1,21 @@
IN: models.arrow.smart
USING: help.syntax help.markup models.product ;
HELP: <smart-arrow>
{ $values { "quot" { $quotation "( ... -- output )" } } }
{ $description "A macro that expands into a form with the stack effect of the quotation. The form constructs a model which applies the quotation to values from an underlying " { $link product } " model having as many components as the quotation has inputs." }
{ $examples
"A model which adds the values of two existing models:"
{ $example
"USING: models models.arrows.smart accessors math prettyprint ;"
"1 <model> 2 <model> [ + ] <smart-arrow>"
"[ activate-model ] [ value>> ] bi ."
"3"
}
} ;
ARTICLE: "models.arrows.smart" "Smart arrow models"
"The " { $vocab-link "models.arrows.smart" } " vocabulary generalizes arrows to arbitrary input arity. They're called “smart” because they resemble " { $link "combinators.smart" } "."
{ $subsection <smart-arrow> } ;
ABOUT: "models.arrows.smart"

1
basis/models/models-docs.factor
View File

@ -133,7 +133,6 @@ $nl
{ $subsection "models-impl" }
{ $subsection "models.arrow" }
{ $subsection "models.product" }
{ $subsection "models-history" }
{ $subsection "models-range" }
{ $subsection "models-delay" } ;

50
basis/opengl/textures/textures-tests.factor
View File

@ -5,56 +5,6 @@ opengl.textures.private images kernel namespaces accessors
sequences ;
IN: opengl.textures.tests
[ ] [
T{ image
{ dim { 3 5 } }
{ component-order RGB }
{ bitmap
B{
1 2 3 4 5 6 7 8 9
10 11 12 13 14 15 16 17 18
19 20 21 22 23 24 25 26 27
28 29 30 31 32 33 34 35 36
37 38 39 40 41 42 43 44 45
}
}
} "image" set
] unit-test
[
T{ image
{ dim { 4 8 } }
{ component-order RGB }
{ bitmap
B{
1 2 3 4 5 6 7 8 9 7 8 9
10 11 12 13 14 15 16 17 18 16 17 18
19 20 21 22 23 24 25 26 27 25 26 27
28 29 30 31 32 33 34 35 36 34 35 36
37 38 39 40 41 42 43 44 45 43 44 45
37 38 39 40 41 42 43 44 45 43 44 45
37 38 39 40 41 42 43 44 45 43 44 45
37 38 39 40 41 42 43 44 45 43 44 45
}
}
}
] [
"image" get power-of-2-image
] unit-test
[
T{ image
{ dim { 0 0 } }
{ component-order R32G32B32 }
{ bitmap B{ } } }
] [
T{ image
{ dim { 0 0 } }
{ component-order R32G32B32 }
{ bitmap B{ } }
} power-of-2-image
] unit-test
[
{
{ { 0 0 } { 10 0 } }

13
basis/opengl/textures/textures.factor
View File

@ -3,9 +3,11 @@
USING: accessors assocs cache colors.constants destructors fry kernel
opengl opengl.gl combinators images images.tesselation grouping
specialized-arrays.float sequences math math.vectors
math.matrices generalizations fry arrays ;
math.matrices generalizations fry arrays namespaces ;
IN: opengl.textures
SYMBOL: non-power-of-2-textures?
: gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ;
: delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;
@ -29,9 +31,14 @@ GENERIC: draw-scaled-texture ( dim texture -- )
TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
: adjust-texture-dim ( dim -- dim' )
non-power-of-2-textures? get [
[ next-power-of-2 ] map
] unless ;
: (tex-image) ( image -- )
[ GL_TEXTURE_2D 0 GL_RGBA ] dip
[ dim>> first2 [ next-power-of-2 ] bi@ 0 ]
[ dim>> adjust-texture-dim first2 0 ]
[ component-order>> component-order>format f ] bi
glTexImage2D ;
@ -81,7 +88,7 @@ TUPLE: single-texture image dim loc texture-coords texture display-list disposed
] with-texturing ;
: texture-coords ( texture -- coords )
[ [ dim>> ] [ image>> dim>> [ next-power-of-2 ] map ] bi v/ ]
[ [ dim>> ] [ image>> dim>> adjust-texture-dim ] bi v/ ]
[
image>> upside-down?>>
{ { 0 1 } { 1 1 } { 1 0 } { 0 0 } }

1
basis/peg/ebnf/tags.txt
View File

@ -1,2 +1,3 @@
extensions
text
parsing

32
basis/prettyprint/backend/backend.factor
View File

@ -41,18 +41,18 @@ M: effect pprint* effect>string "(" ")" surround text ;
: pprint-prefix ( word quot -- )
<block swap pprint-word call block> ; inline
M: parsing-word pprint*
\ POSTPONE: [ pprint-word ] pprint-prefix ;
M: word pprint*
dup parsing-word? [
\ POSTPONE: [ pprint-word ] pprint-prefix
] [
{
[ "break-before" word-prop line-break ]
[ pprint-word ]
[ ?start-group ]
[ ?end-group ]
[ "break-after" word-prop line-break ]
} cleave
] if ;
[ pprint-word ] [ ?start-group ] [ ?end-group ] tri ;
M: method-body pprint*
<block
\ M\ pprint-word
[ "method-class" word-prop pprint-word ]
[ "method-generic" word-prop pprint-word ] bi
block> ;
M: real pprint* number>string text ;
@ -206,8 +206,8 @@ M: curry pprint* pprint-object ;
M: compose pprint* pprint-object ;
M: wrapper pprint*
dup wrapped>> word? [
<block \ \ pprint-word wrapped>> pprint-word block>
] [
pprint-object
] if ;
{
{ [ dup wrapped>> method-body? ] [ wrapped>> pprint* ] }
{ [ dup wrapped>> word? ] [ <block \ \ pprint-word wrapped>> pprint-word block> ] }
[ pprint-object ]
} cond ;

30
basis/prettyprint/prettyprint-tests.factor
View File

@ -180,28 +180,6 @@ DEFER: parse-error-file
"string-layout-test" string-layout check-see
] unit-test
! Define dummy words for the below...
: <NSRect> ( a b c d -- e ) ;
: <PixelFormat> ( -- fmt ) ;
: send ( obj -- ) ;
\ send soft "break-after" set-word-prop
: final-soft-break-test ( -- str )
{
"USING: kernel sequences ;"
"IN: prettyprint.tests"
": final-soft-break-layout ( class dim -- view )"
" [ \"alloc\" send 0 0 ] dip first2 <NSRect>"
" <PixelFormat> \"initWithFrame:pixelFormat:\" send"
" dup 1 \"setPostsBoundsChangedNotifications:\" send"
" dup 1 \"setPostsFrameChangedNotifications:\" send ;"
} ;
[ t ] [
"final-soft-break-layout" final-soft-break-test check-see
] unit-test
: narrow-test ( -- str )
{
"USING: arrays combinators continuations kernel sequences ;"
@ -300,11 +278,7 @@ GENERIC: generic-see-test-with-f ( obj -- obj )
M: f generic-see-test-with-f ;
[ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
[ { POSTPONE: f generic-see-test-with-f } see ] with-string-writer
] unit-test
[ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
[ \ f \ generic-see-test-with-f method see ] with-string-writer
[ M\ f generic-see-test-with-f see ] with-string-writer
] unit-test
PREDICATE: predicate-see-test < integer even? ;
@ -331,5 +305,5 @@ GENERIC: ended-up-ballin' ( a -- b )
M: started-out-hustlin' ended-up-ballin' ; inline
[ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [
[ { started-out-hustlin' ended-up-ballin' } see ] with-string-writer
[ M\ started-out-hustlin' ended-up-ballin' see ] with-string-writer
] unit-test

4
basis/regexp/ast/ast.factor
View File

@ -21,12 +21,12 @@ CONSTANT: epsilon T{ tagged-epsilon { tag t } }
TUPLE: concatenation first second ;
: <concatenation> ( seq -- concatenation )
[ epsilon ] [ unclip [ concatenation boa ] reduce ] if-empty ;
[ epsilon ] [ [ ] [ concatenation boa ] map-reduce ] if-empty ;
TUPLE: alternation first second ;
: <alternation> ( seq -- alternation )
unclip [ alternation boa ] reduce ;
[ ] [ alternation boa ] map-reduce ;
TUPLE: star term ;
C: <star> star

5
basis/regexp/dfa/dfa.factor
View File

@ -51,10 +51,13 @@ IN: regexp.dfa
[ condition-states ] 2dip
'[ _ _ add-todo-state ] each ;
: ensure-state ( key table -- )
2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ; inline
:: new-transitions ( nfa dfa new-states visited-states -- nfa dfa )
new-states [ nfa dfa ] [
pop :> state
state dfa transitions>> maybe-initialize-key
state dfa transitions>> ensure-state
state nfa find-transitions
[| trans |
state trans nfa find-closure :> new-state

6
basis/regexp/transition-tables/transition-tables.factor
View File

@ -11,12 +11,7 @@ TUPLE: transition-table transitions start-state final-states ;
H{ } clone >>transitions
H{ } clone >>final-states ;
: maybe-initialize-key ( key hashtable -- )
! Why do we have to do this?
2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ;
:: (set-transition) ( from to obj hash -- )
to condition? [ to hash maybe-initialize-key ] unless
from hash at
[ [ to obj ] dip set-at ]
[ to obj associate from hash set-at ] if* ;
@ -25,7 +20,6 @@ TUPLE: transition-table transitions start-state final-states ;
transitions>> (set-transition) ;
:: (add-transition) ( from to obj hash -- )
to hash maybe-initialize-key
from hash at
[ [ to obj ] dip push-at ]
[ to 1vector obj associate from hash set-at ] if* ;

7
basis/see/see-docs.factor
View File

@ -13,7 +13,12 @@ HELP: synopsis*
HELP: see
{ $values { "defspec" "a definition specifier" } }
{ $contract "Prettyprints a definition." } ;
{ $contract "Prettyprints a definition." }
{ $examples
"A word:" { $code "\\ append see" }
"A method:" { $code "USE: arrays" "M\\ array length see" }
"A help article:" { $code "USE: help.topics" "\"help\" >link see" }
} ;
HELP: see-methods
{ $values { "word" "a " { $link generic } " or a " { $link class } } }

11
basis/see/see-tests.factor Normal file
View File

@ -0,0 +1,11 @@
IN: see.tests
USING: see tools.test io.streams.string math ;
CONSTANT: test-const 10
[ "IN: see.tests\nCONSTANT: test-const 10 inline\n" ]
[ [ \ test-const see ] with-string-writer ] unit-test
ALIAS: test-alias +
[ "USING: math ;\nIN: see.tests\nALIAS: test-alias + inline\n" ]
[ [ \ test-alias see ] with-string-writer ] unit-test

18
basis/see/see.factor
View File

@ -7,7 +7,7 @@ definitions effects generic generic.standard io io.pathnames
io.streams.string io.styles kernel make namespaces prettyprint
prettyprint.backend prettyprint.config prettyprint.custom
prettyprint.sections sequences sets sorting strings summary
words words.symbol ;
words words.symbol words.constant words.alias ;
IN: see
GENERIC: synopsis* ( defspec -- )
@ -29,8 +29,16 @@ GENERIC: see* ( defspec -- )
: comment. ( text -- )
H{ { font-style italic } } styled-text ;
GENERIC: print-stack-effect? ( word -- ? )
M: parsing-word print-stack-effect? drop f ;
M: symbol print-stack-effect? drop f ;
M: constant print-stack-effect? drop f ;
M: alias print-stack-effect? drop f ;
M: word print-stack-effect? drop t ;
: stack-effect. ( word -- )
[ [ parsing-word? ] [ symbol? ] bi or not ] [ stack-effect ] bi and
[ print-stack-effect? ] [ stack-effect ] bi and
[ effect>string comment. ] when* ;
<PRIVATE
@ -68,9 +76,6 @@ M: hook-generic synopsis*
[ stack-effect. ]
} cleave ;
M: method-spec synopsis*
first2 method synopsis* ;
M: method-body synopsis*
[ definer. ]
[ "method-class" word-prop pprint-word ]
@ -114,9 +119,6 @@ M: object see*
block>
] with-use ;
M: method-spec see*
first2 method see* ;
GENERIC: see-class* ( word -- )
M: union-class see-class*

2
basis/tools/annotations/annotations-tests.factor
View File

@ -43,6 +43,6 @@ GENERIC: blah-generic ( a -- b )
M: string blah-generic ;
{ string blah-generic } watch
[ ] [ M\ string blah-generic watch ] unit-test
[ "hi" ] [ "hi" blah-generic ] unit-test

11
basis/tools/annotations/annotations.factor
View File

@ -20,9 +20,6 @@ M: word reset
f "unannotated-def" set-word-prop
] [ drop ] if ;
M: method-spec reset
first2 method reset ;
ERROR: cannot-annotate-twice word ;
<PRIVATE
@ -32,9 +29,6 @@ ERROR: cannot-annotate-twice word ;
cannot-annotate-twice
] when ;
: method-spec>word ( obj -- word )
dup method-spec? [ first2 method ] when ;
: save-unannotated-def ( word -- )
dup def>> "unannotated-def" set-word-prop ;
@ -44,7 +38,7 @@ ERROR: cannot-annotate-twice word ;
PRIVATE>
: annotate ( word quot -- )
[ method-spec>word check-annotate-twice ] dip
[ check-annotate-twice ] dip
[ over save-unannotated-def (annotate) ] with-compilation-unit ;
<PRIVATE
@ -103,9 +97,6 @@ M: generic annotate-methods
M: word annotate-methods
annotate ;
M: method-spec annotate-methods
annotate ;
: breakpoint ( word -- )
[ add-breakpoint ] annotate-methods ;

4
basis/tools/deploy/backend/backend.factor
View File

@ -8,7 +8,7 @@ debugger io.streams.c io.files io.files.temp io.pathnames
io.directories io.directories.hierarchy io.backend quotations
io.launcher words.private tools.deploy.config
tools.deploy.config.editor bootstrap.image io.encodings.utf8
destructors accessors ;
destructors accessors hashtables ;
IN: tools.deploy.backend
: copy-vm ( executable bundle-name -- vm )
@ -88,7 +88,7 @@ DEFER: ?make-staging-image
[ drop ] [ make-staging-image ] if ;
: make-deploy-config ( vocab -- file )
[ deploy-config unparse-use ]
[ deploy-config vocab-roots get vocab-roots associate assoc-union unparse-use ]
[ "deploy-config-" prepend temp-file ] bi
[ utf8 set-file-contents ] keep ;

2
basis/tools/deploy/shaker/shaker.factor
View File

@ -170,8 +170,6 @@ IN: tools.deploy.shaker
strip-prettyprint? [
{
"break-before"
"break-after"
"delimiter"
"flushable"
"foldable"

2
basis/tools/disassembler/disassembler-tests.factor
View File

@ -3,4 +3,4 @@ USING: math classes.tuple prettyprint.custom
tools.disassembler tools.test strings ;
[ ] [ \ + disassemble ] unit-test
[ ] [ { string pprint* } disassemble ] unit-test
[ ] [ M\ string pprint* disassemble ] unit-test

2
basis/tools/disassembler/disassembler.factor
View File

@ -16,8 +16,6 @@ M: pair disassemble first2 disassemble* [ tabs>spaces print ] each ;
M: word disassemble word-xt 2array disassemble ;
M: method-spec disassemble first2 method disassemble ;
cpu x86?
"tools.disassembler.udis"
"tools.disassembler.gdb" ?

8
basis/ui/backend/backend.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces opengl opengl.gl ;
USING: kernel namespaces opengl opengl.gl fry ;
IN: ui.backend
SYMBOL: ui-backend
@ -28,7 +28,7 @@ GENERIC: flush-gl-context ( handle -- )
HOOK: offscreen-pixels ui-backend ( world -- alien w h )
: with-gl-context ( handle quot -- )
swap [ select-gl-context call ] keep
flush-gl-context gl-error ; inline
'[ select-gl-context @ ]
[ flush-gl-context gl-error ] bi ; inline
HOOK: (with-ui) ui-backend ( quot -- )

2
basis/ui/gadgets/buttons/buttons-docs.factor
View File

@ -26,7 +26,7 @@ HELP: <repeat-button>
{ $description "Creates a new " { $link button } " derived from a " { $link <border-button> } " which calls the quotation every 100 milliseconds as long as the mouse button is held down." } ;
HELP: button-pen
{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " gneeric words by delegating to an object in one of four slots which depend on the state of the button being drawn:"
{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words by delegating to an object in one of four slots which depend on the state of the button being drawn:"
{ $list
{ { $snippet "plain" } " - the button is inactive" }
{ { $snippet "rollover" } " - the button is under the mouse" }

1
basis/ui/gadgets/editors/editors.factor
View File

@ -452,6 +452,7 @@ editor "caret-motion" f {
editor "selection" f {
{ T{ button-down f { S+ } 1 } extend-selection }
{ T{ button-up f { S+ } 1 } com-copy-selection }
{ T{ drag } drag-selection }
{ gain-focus focus-editor }
{ lose-focus unfocus-editor }

10
basis/ui/gadgets/scrollers/scrollers-docs.factor
View File

@ -11,11 +11,11 @@ HELP: find-scroller
{ $values { "gadget" gadget } { "scroller/f" { $maybe scroller } } }
{ $description "Finds the first parent of " { $snippet "gadget" } " which is a " { $link scroller } ". Outputs " { $link f } " if the gadget is not contained in a " { $link scroller } "." } ;
HELP: scroller-value
HELP: scroll-position
{ $values { "scroller" scroller } { "loc" "a pair of integers" } }
{ $description "Outputs the offset of the top-left corner of the scroller's " { $link viewport } "'s child." } ;
{ scroller-value scroll scroll>bottom scroll>top scroll>rect } related-words
{ scroll-position set-scroll-position scroll>bottom scroll>top scroll>rect } related-words
HELP: <scroller>
{ $values { "gadget" gadget } { "scroller" "a new " { $link scroller } } }
@ -23,7 +23,7 @@ HELP: <scroller>
{ <viewport> <scroller> } related-words
HELP: scroll
HELP: set-scroll-position
{ $values { "scroller" scroller } { "value" "a pair of integers" } }
{ $description "Sets the offset of the top-left corner of the scroller's " { $link viewport } "'s child." } ;
@ -48,8 +48,8 @@ ARTICLE: "ui.gadgets.scrollers" "Scroller gadgets"
{ $subsection scroller }
{ $subsection <scroller> }
"Getting and setting the scroll position:"
{ $subsection scroller-value }
{ $subsection scroll }
{ $subsection scroll-position }
{ $subsection set-scroll-position }
"Writing scrolling-aware gadgets:"
{ $subsection scroll>bottom }
{ $subsection scroll>top }

6
basis/ui/gadgets/scrollers/scrollers-tests.factor
View File

@ -45,13 +45,13 @@ IN: ui.gadgets.scrollers.tests
[ { 100 100 } ] [ "s" get viewport>> gadget-child pref-dim ] unit-test
[ ] [ { 0 0 } "s" get scroll ] unit-test
[ ] [ { 0 0 } "s" get set-scroll-position ] unit-test
[ { 0 0 } ] [ "s" get model>> range-min-value ] unit-test
[ { 100 100 } ] [ "s" get model>> range-max-value ] unit-test
[ ] [ { 10 20 } "s" get scroll ] unit-test
[ ] [ { 10 20 } "s" get set-scroll-position ] unit-test
[ { 10 20 } ] [ "s" get model>> range-value ] unit-test
@ -74,7 +74,7 @@ dup layout
drop
"g2" get scroll>gadget
"s" get layout
"s" get scroller-value
"s" get scroll-position
] map [ { 0 0 } = ] all?
] unit-test

25
basis/ui/gadgets/scrollers/scrollers.factor
View File

@ -29,6 +29,13 @@ M: gadget viewport-column-header drop f ;
: scroll-down-line ( scroller -- ) y>> 1 swap slide-by-line ;
: set-scroll-position ( value scroller -- )
[
viewport>> [ dim>> { 0 0 } ] [ gadget-child pref-dim ] bi
4array flip
] keep
2dup control-value = [ 2drop ] [ set-control-value ] if ;
<PRIVATE
: do-mouse-scroll ( scroller -- )
@ -46,21 +53,14 @@ scroller H{
M: viewport pref-dim* gadget-child pref-viewport-dim ;
: scroll ( value scroller -- )
[
viewport>> [ dim>> { 0 0 } ] [ gadget-child pref-dim ] bi
4array flip
] keep
2dup control-value = [ 2drop ] [ set-control-value ] if ;
: (scroll>rect) ( rect scroller -- )
{
[ scroller-value vneg offset-rect ]
[ scroll-position vneg offset-rect ]
[ viewport>> dim>> rect-min ]
[ viewport>> loc>> offset-rect ]
[ viewport>> [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] with-rect-extents v+ ]
[ scroller-value v+ ]
[ scroll ]
[ scroll-position v+ ]
[ set-scroll-position ]
} cleave ;
: relative-scroll-rect ( rect gadget scroller -- newrect )
@ -72,7 +72,7 @@ M: viewport pref-dim* gadget-child pref-viewport-dim ;
2&& ;
: (update-scroller) ( scroller -- )
[ scroller-value ] keep scroll ;
[ scroll-position ] keep set-scroll-position ;
: (scroll>gadget) ( gadget scroller -- )
2dup swap child? [
@ -82,7 +82,8 @@ M: viewport pref-dim* gadget-child pref-viewport-dim ;
] [ f >>follows (update-scroller) drop ] if ;
: (scroll>bottom) ( scroller -- )
[ viewport>> gadget-child pref-dim { 0 1 } v* ] keep scroll ;
[ viewport>> gadget-child pref-dim { 0 1 } v* ] keep
set-scroll-position ;
GENERIC: update-scroller ( scroller follows -- )

3
basis/ui/gadgets/search-tables/search-tables-tests.factor Normal file
View File

@ -0,0 +1,3 @@
IN: ui.gadgets.search-tables.tests
USING: ui.gadgets.search-tables sequences tools.test ;
[ [ second ] <search-table> ] must-infer

1
basis/ui/gadgets/search-tables/search-tables.factor
View File

@ -28,6 +28,7 @@ TUPLE: search-field < track field ;
: <search-field> ( model -- gadget )
horizontal search-field new-track
0 >>fill
{ 5 5 } >>gap
+baseline+ >>align
swap <model-field> 10 >>min-cols >>field

4
basis/ui/gadgets/viewports/viewports.factor
View File

@ -23,7 +23,7 @@ M: viewport layout*
M: viewport focusable-child*
gadget-child ;
: scroller-value ( scroller -- loc )
: scroll-position ( scroller -- loc )
model>> range-value [ >integer ] map ;
M: viewport model-changed
@ -31,7 +31,7 @@ M: viewport model-changed
[ relayout-1 ]
[
[ gadget-child ]
[ scroller-value vneg ]
[ scroll-position vneg ]
[ constraint>> ]
tri v* >>loc drop
] bi ;

12
basis/ui/gadgets/worlds/worlds.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs continuations kernel math models
namespaces opengl sequences io combinators combinators.short-circuit
fry math.vectors math.rectangles cache ui.gadgets ui.gestures
ui.render ui.backend ui.gadgets.tracks ui.commands ;
namespaces opengl opengl.capabilities opengl.textures sequences io
combinators combinators.short-circuit fry math.vectors math.rectangles
cache ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
ui.commands ;
IN: ui.gadgets.worlds
TUPLE: world < track
@ -76,8 +77,13 @@ SYMBOL: flush-layout-cache-hook
flush-layout-cache-hook [ [ ] ] initialize
: check-extensions ( -- )
"2.0" { "GL_ARB_texture_non_power_of_two" } has-gl-version-or-extensions?
non-power-of-2-textures? set ;
: (draw-world) ( world -- )
dup handle>> [
check-extensions
{
[ init-gl ]
[ draw-gadget ]

41
basis/ui/tools/browser/browser.factor
View File

@ -1,23 +1,33 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: debugger help help.topics help.crossref help.home kernel
models compiler.units assocs words vocabs accessors fry
combinators.short-circuit namespaces sequences models
models.history help.apropos combinators ui.commands ui.gadgets
ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
ui.gestures ui.gadgets.buttons ui.gadgets.packs
ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar
ui.gadgets.glass ui.gadgets.borders ui.tools.common
ui.tools.browser.popups ui ;
USING: debugger help help.topics help.crossref help.home kernel models
compiler.units assocs words vocabs accessors fry arrays
combinators.short-circuit namespaces sequences models help.apropos
combinators ui ui.commands ui.gadgets ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons
ui.gadgets.packs ui.gadgets.editors ui.gadgets.labels
ui.gadgets.status-bar ui.gadgets.glass ui.gadgets.borders ui.gadgets.viewports
ui.tools.common ui.tools.browser.popups ui.tools.browser.history ;
IN: ui.tools.browser
TUPLE: browser-gadget < tool pane scroller search-field popup ;
TUPLE: browser-gadget < tool history pane scroller search-field popup ;
{ 650 400 } browser-gadget set-tool-dim
M: browser-gadget history-value
[ control-value ] [ scroller>> scroll-position ]
bi 2array ;
M: browser-gadget set-history-value
[ first2 ] dip
[ set-control-value ] [ scroller>> set-scroll-position ]
bi-curry bi* ;
: show-help ( link browser-gadget -- )
[ >link ] [ model>> ] bi*
[ [ add-recent ] [ add-history ] bi* ] [ set-model ] 2bi ;
[ >link ] dip
[ [ add-recent ] [ history>> add-history ] bi* ]
[ model>> set-model ]
2bi ;
: <help-pane> ( browser-gadget -- gadget )
model>> [ '[ _ print-topic ] try ] <pane-control> ;
@ -41,7 +51,8 @@ TUPLE: browser-gadget < tool pane scroller search-field popup ;
: <browser-gadget> ( link -- gadget )
vertical browser-gadget new-track
1 >>fill
swap >link <history> >>model
swap >link <model> >>model
dup <history> >>history
dup <search-field> >>search-field
dup <browser-toolbar> { 3 3 } <border> { 1 0 } >>fill f track-add
dup <help-pane> >>pane
@ -93,9 +104,9 @@ M: browser-gadget focusable-child* search-field>> ;
\ show-browser H{ { +nullary+ t } } define-command
: com-back ( browser -- ) model>> go-back ;
: com-back ( browser -- ) history>> go-back ;
: com-forward ( browser -- ) model>> go-forward ;
: com-forward ( browser -- ) history>> go-forward ;
: com-home ( browser -- ) "help.home" swap show-help ;

1
basis/ui/tools/browser/history/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

42
basis/ui/tools/browser/history/history-tests.factor Normal file
View File

@ -0,0 +1,42 @@
USING: namespaces ui.tools.browser.history sequences tools.test
accessors kernel ;
IN: ui.tools.browser.history.tests
TUPLE: dummy obj ;
M: dummy history-value obj>> ;
M: dummy set-history-value (>>obj) ;
dummy new <history> "history" set
"history" get add-history
[ t ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
"history" get add-history
3 "history" get owner>> set-history-value
[ t ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
"history" get add-history
4 "history" get owner>> set-history-value
[ f ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test
"history" get go-back
[ 3 ] [ "history" get owner>> history-value ] unit-test
[ t ] [ "history" get back>> empty? ] unit-test
[ f ] [ "history" get forward>> empty? ] unit-test
"history" get go-forward
[ 4 ] [ "history" get owner>> history-value ] unit-test
[ f ] [ "history" get back>> empty? ] unit-test
[ t ] [ "history" get forward>> empty? ] unit-test

32
basis/ui/tools/browser/history/history.factor Normal file
View File

@ -0,0 +1,32 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences locals ;
IN: ui.tools.browser.history
TUPLE: history owner back forward ;
: <history> ( owner -- history )
V{ } clone V{ } clone history boa ;
GENERIC: history-value ( object -- value )
GENERIC: set-history-value ( value object -- )
: (add-history) ( history to -- )
swap owner>> history-value dup [ swap push ] [ 2drop ] if ;
:: go-back/forward ( history to from -- )
from empty? [
history to (add-history)
from pop history owner>> set-history-value
] unless ;
: go-back ( history -- )
dup [ forward>> ] [ back>> ] bi go-back/forward ;
: go-forward ( history -- )
dup [ back>> ] [ forward>> ] bi go-back/forward ;
: add-history ( history -- )
dup forward>> delete-all
dup back>> (add-history) ;

4
basis/ui/tools/tools-docs.factor
View File

@ -55,7 +55,7 @@ $nl
ARTICLE: "ui-tools" "UI developer tools"
"The " { $vocab-link "ui.tools" } " vocabulary hierarchy implements a collection of simple developer tools."
$nl
{ $subsection "starting-ui-tools" }
"To take full advantage of the UI tools, you should be using a supported text editor. See " { $link "editor" } "."
$nl
"Common functionality:"
@ -66,7 +66,7 @@ $nl
{ $subsection "ui-listener" }
{ $subsection "ui-browser" }
{ $subsection "ui-inspector" }
{ $subsection "ui-profiler" }
{ $subsection "ui.tools.profiler" }
{ $subsection "ui-walker" }
{ $subsection "ui.tools.deploy" }
"Platform-specific features:"

0
basis/ui/traverse/traverse-docs.factor Normal file
View File

2
basis/ui/traverse/traverse-tests.factor
View File

@ -62,4 +62,4 @@ M: object (flatten-tree) , ;
{ 0 1 } { 2 0 1 } { { "a" "b" "c" "d" } { "e" "f" "g" } { { "h" "i" } "j" } } gadgets-in-range
] unit-test
[ { array children>> } forget ] with-compilation-unit
[ M\ array children>> forget ] with-compilation-unit

31
basis/ui/ui.factor
View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs io kernel math models namespaces make dlists
deques sequences threads sequences words continuations init
combinators hashtables concurrency.flags sets accessors calendar fry
destructors ui.gadgets ui.gadgets.private ui.gadgets.worlds
ui.gadgets.tracks ui.gestures ui.backend ui.render ;
combinators combinators.short-circuit hashtables concurrency.flags
sets accessors calendar fry destructors ui.gadgets ui.gadgets.private
ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend ui.render ;
IN: ui
<PRIVATE
@ -117,12 +117,10 @@ M: world ungraft*
gesture-queue [ send-queued-gesture notify-queued ] slurp-deque ;
: update-ui ( -- )
[
notify-queued
layout-queued
redraw-worlds
send-queued-gestures
] [ ui-error ] recover ;
notify-queued
layout-queued
redraw-worlds
send-queued-gestures ;
SYMBOL: ui-thread
@ -133,8 +131,7 @@ SYMBOL: ui-thread
PRIVATE>
: find-window ( quot -- world )
windows get values
[ gadget-child swap call ] with find-last nip ; inline
[ windows get values ] dip '[ gadget-child @ ] find-last nip ; inline
: ui-running? ( -- ? )
\ ui-running get-global ;
@ -142,9 +139,15 @@ PRIVATE>
<PRIVATE
: update-ui-loop ( -- )
[ ui-running? ui-thread get-global self eq? and ]
[ ui-notify-flag get lower-flag update-ui ]
while ;
#! Note the logic: if update-ui fails, we open an error window
#! and run one iteration of update-ui. If that also fails, well,
#! the whole UI subsystem is broken so we exit out of the
#! update-ui-loop.
[ { [ ui-running? ] [ ui-thread get-global self eq? ] } 0&& ]
[
ui-notify-flag get lower-flag
[ update-ui ] [ ui-error update-ui ] recover
] while ;
: start-ui-thread ( -- )
[ self ui-thread set-global update-ui-loop ]

2
basis/unicode/unicode-docs.factor
View File

@ -1,7 +1,7 @@
USING: help.markup help.syntax strings ;
IN: unicode
ARTICLE: "unicode" "Unicode"
ARTICLE: "unicode" "Unicode support"
"The " { $vocab-link "unicode" } " vocabulary and its sub-vocabularies implement support for the Unicode 5.1 character set."
$nl
"The Unicode character set contains most of the world's writing systems. Unicode is intended as a replacement for, and is a superset of, such legacy character sets as ASCII, Latin1, MacRoman, and so on. Unicode characters are called " { $emphasis "code points" } "; Factor's " { $link "strings" } " are sequences of code points."

7
basis/urls/prettyprint/prettyprint.factor
View File

@ -1,6 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel present prettyprint.custom prettyprint.backend urls ;
USING: kernel present prettyprint.custom prettyprint.sections
prettyprint.backend urls ;
IN: urls.prettyprint
M: url pprint* dup present "URL\" " "\"" pprint-string ;
M: url pprint*
\ URL" record-vocab
dup present "URL\" " "\"" pprint-string ;

4
basis/urls/urls-tests.factor
View File

@ -1,5 +1,5 @@
IN: urls.tests
USING: urls urls.private tools.test
USING: urls urls.private tools.test prettyprint
arrays kernel assocs present accessors ;
CONSTANT: urls
@ -227,3 +227,5 @@ urls [
[ "http://localhost/?foo=bar" >url ] unit-test
[ "/" ] [ "http://www.jedit.org" >url path>> ] unit-test
[ "USING: urls ;\nURL\" foo\"" ] [ URL" foo" unparse-use ] unit-test

2
basis/values/values-docs.factor
View File

@ -2,7 +2,7 @@ USING: help.markup help.syntax ;
IN: values
ARTICLE: "values" "Global values"
"Usually, dynamically scoped variables are sufficient for holding data which is not literal. But occasionally, for global information that's calculated just once, it's useful to use the word mechanism instead, and set the word to the appropriate value just once. The " { $vocab-link "values" } " vocabulary implements " { $emphasis "values" } ", which abstract over this concept. To create a new word as a value, use the following syntax:"
"Usually, dynamically-scoped variables subsume global variables and are sufficient for holding global data. But occasionally, for global information that's calculated just once and must be accessed more rapidly than a dynamic variable lookup can provide, it's useful to use the word mechanism instead, and set a word to the appropriate value just once. The " { $vocab-link "values" } " vocabulary implements " { $emphasis "values" } ", which abstract over this concept. To create a new word as a value, use the following syntax:"
{ $subsection POSTPONE: VALUE: }
"To get the value, just call the word. The following words manipulate values:"
{ $subsection get-value }

1
basis/xml/syntax/tags.txt
View File

@ -1 +1,2 @@
extensions
syntax

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

@ -87,4 +87,4 @@ f initialize-test set-global
[ 7575 ] [ initialize-test [ 7575 ] initialize-alien ] unit-test
[ { BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } prune ] unit-test
[ V{ BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } prune ] unit-test

1
core/bootstrap/syntax.factor
View File

@ -62,6 +62,7 @@ IN: bootstrap.syntax
"W{"
"["
"\\"
"M\\"
"]"
"delimiter"
"f"

2
core/classes/builtin/builtin.factor
View File

@ -55,7 +55,7 @@ M: anonymous-intersection (flatten-class)
[
builtins get sift [ (flatten-class) ] each
] [
unclip [ assoc-intersect ] reduce [ swap set ] assoc-each
[ ] [ assoc-intersect ] map-reduce [ swap set ] assoc-each
] if-empty ;
M: anonymous-complement (flatten-class)

3
core/classes/classes.factor
View File

@ -174,8 +174,7 @@ GENERIC: update-methods ( class seq -- )
[ forget ] [ drop ] if
] [ 2drop ] if ;
: forget-methods ( class -- )
[ implementors ] [ [ swap 2array ] curry ] bi map forget-all ;
GENERIC: forget-methods ( class -- )
GENERIC: class-forgotten ( use class -- )

4
core/classes/tuple/tuple-tests.factor
View File

@ -133,7 +133,7 @@ M: integer forget-robustness-generic ;
[
[ ] [ \ forget-robustness-generic forget ] unit-test
[ ] [ \ forget-robustness forget ] unit-test
[ ] [ { forget-robustness forget-robustness-generic } forget ] unit-test
[ ] [ M\ forget-robustness forget-robustness-generic forget ] unit-test
] with-compilation-unit
! rapido found this one
@ -559,7 +559,7 @@ DEFER: subclass-reset-test-3
GENERIC: break-me ( obj -- )
[ ] [ [ { integer break-me } forget ] with-compilation-unit ] unit-test
[ ] [ [ M\ integer break-me forget ] with-compilation-unit ] unit-test
[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test ;" <string-reader> "subclass-reset-test" parse-stream drop ] unit-test
[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-1 < subclass-reset-test ;" eval ] unit-test

315
core/combinators/combinators-docs.factor
View File

@ -4,46 +4,313 @@ math assocs sequences sequences.private combinators.private
effects words ;
IN: combinators
ARTICLE: "cleave-shuffle-equivalence" "Expressing shuffle words with cleave combinators"
"Cleave combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to cleave combinators are discussed in the documentation for " { $link bi } ", " { $link 2bi } ", " { $link 3bi } ", " { $link tri } ", " { $link 2tri } " and " { $link 3tri } "."
$nl
"Certain shuffle words can also be expressed in terms of the cleave combinators. Internalizing such identities can help with understanding and writing code using cleave combinators:"
{ $code
": keep [ ] bi ;"
": 2keep [ ] 2bi ;"
": 3keep [ ] 3bi ;"
""
": dup [ ] [ ] bi ;"
": 2dup [ ] [ ] 2bi ;"
": 3dup [ ] [ ] 3bi ;"
""
": tuck [ nip ] [ ] 2bi ;"
": swap [ nip ] [ drop ] 2bi ;"
""
": over [ ] [ drop ] 2bi ;"
": pick [ ] [ 2drop ] 3bi ;"
": 2over [ ] [ drop ] 3bi ;"
} ;
ARTICLE: "cleave-combinators" "Cleave combinators"
"The cleave combinators apply multiple quotations to a single value."
$nl
"Two quotations:"
{ $subsection bi }
{ $subsection 2bi }
{ $subsection 3bi }
"Three quotations:"
{ $subsection tri }
{ $subsection 2tri }
{ $subsection 3tri }
"An array of quotations:"
{ $subsection cleave }
{ $subsection 2cleave }
{ $subsection 3cleave }
"Technically, the cleave combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on the top of the stack can be written in one of two ways:"
{ $code
"! First alternative; uses keep"
"[ 1 + ] keep"
"[ 1 - ] keep"
"2 *"
"! Second alternative: uses tri"
"[ 1 + ]"
"[ 1 - ]"
"[ 2 * ] tri"
}
"The latter is more aesthetically pleasing than the former."
{ $subsection "cleave-shuffle-equivalence" } ;
ARTICLE: "spread-shuffle-equivalence" "Expressing shuffle words with spread combinators"
"Spread combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to spread combinators are discussed in the documentation for " { $link bi* } ", " { $link 2bi* } ", " { $link tri* } ", and " { $link 2tri* } "."
$nl
"Certain shuffle words can also be expressed in terms of the spread combinators. Internalizing such identities can help with understanding and writing code using spread combinators:"
{ $code
": dip [ ] bi* ;"
": 2dip [ ] [ ] tri* ;"
""
": slip [ call ] [ ] bi* ;"
": 2slip [ call ] [ ] [ ] tri* ;"
""
": nip [ drop ] [ ] bi* ;"
": 2nip [ drop ] [ drop ] [ ] tri* ;"
""
": rot"
" [ [ drop ] [ ] [ drop ] tri* ]"
" [ [ drop ] [ drop ] [ ] tri* ]"
" [ [ ] [ drop ] [ drop ] tri* ]"
" 3tri ;"
""
": -rot"
" [ [ drop ] [ drop ] [ ] tri* ]"
" [ [ ] [ drop ] [ drop ] tri* ]"
" [ [ drop ] [ ] [ drop ] tri* ]"
" 3tri ;"
""
": spin"
" [ [ drop ] [ drop ] [ ] tri* ]"
" [ [ drop ] [ ] [ drop ] tri* ]"
" [ [ ] [ drop ] [ drop ] tri* ]"
" 3tri ;"
} ;
ARTICLE: "spread-combinators" "Spread combinators"
"The spread combinators apply multiple quotations to multiple values. The " { $snippet "*" } " suffix signifies spreading."
$nl
"Two quotations:"
{ $subsection bi* }
{ $subsection 2bi* }
"Three quotations:"
{ $subsection tri* }
{ $subsection 2tri* }
"An array of quotations:"
{ $subsection spread }
"Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:"
{ $code
"! First alternative; uses dip"
"[ [ 1 + ] dip 1 - ] dip 2 *"
"! Second alternative: uses tri*"
"[ 1 + ] [ 1 - ] [ 2 * ] tri*"
}
"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "."
{ $subsection "spread-shuffle-equivalence" } ;
ARTICLE: "apply-combinators" "Apply combinators"
"The apply combinators apply a single quotation to multiple values. The " { $snippet "@" } " suffix signifies application."
$nl
"Two quotations:"
{ $subsection bi@ }
{ $subsection 2bi@ }
"Three quotations:"
{ $subsection tri@ }
{ $subsection 2tri@ }
"A pair of utility words built from " { $link bi@ } ":"
{ $subsection both? }
{ $subsection either? } ;
ARTICLE: "slip-keep-combinators" "Retain stack combinators"
"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using a set of combinators."
$nl
"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
{ $subsection dip }
{ $subsection 2dip }
{ $subsection 3dip }
{ $subsection 4dip }
"The slip combinators invoke a quotation further down on the stack. They are most useful for implementing other combinators:"
{ $subsection slip }
{ $subsection 2slip }
{ $subsection 3slip }
"The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:"
{ $subsection keep }
{ $subsection 2keep }
{ $subsection 3keep } ;
ARTICLE: "curried-dataflow" "Curried dataflow combinators"
"Curried cleave combinators:"
{ $subsection bi-curry }
{ $subsection tri-curry }
"Curried spread combinators:"
{ $subsection bi-curry* }
{ $subsection tri-curry* }
"Curried apply combinators:"
{ $subsection bi-curry@ }
{ $subsection tri-curry@ }
{ $see-also "dataflow-combinators" } ;
ARTICLE: "compositional-examples" "Examples of compositional combinator usage"
"Consider printing the same message ten times:"
{ $code ": print-10 ( -- ) 10 [ \"Hello, world.\" print ] times ;" }
"if we wanted to abstract out the message into a parameter, we could keep it on the stack between iterations:"
{ $code ": print-10 ( message -- ) 10 [ dup print ] times drop ;" }
"However, keeping loop-invariant values on the stack doesn't always work out nicely. For example, a word to subtract a value from each element of a sequence:"
{ $code ": subtract-n ( seq n -- seq' ) swap [ over - ] map nip ;" }
"Three shuffle words are required to pass the value around. Instead, the loop-invariant value can be partially applied to a quotation using " { $link curry } ", yielding a new quotation that is passed to " { $link map } ":"
{ $example
"USING: kernel math prettyprint sequences ;"
": subtract-n ( seq n -- seq' ) [ - ] curry map ;"
"{ 10 20 30 } 5 subtract-n ."
"{ 5 15 25 }"
}
"Now consider the word that is dual to the one above; instead of subtracting " { $snippet "n" } " from each stack element, it subtracts each element from " { $snippet "n" } "."
$nl
"One way to write this is with a pair of " { $link swap } "s:"
{ $code ": n-subtract ( n seq -- seq' ) swap [ swap - ] curry map ;" }
"Since this pattern comes up often, " { $link with } " encapsulates it:"
{ $example
"USING: kernel math prettyprint sequences ;"
": n-subtract ( n seq -- seq' ) [ - ] with map ;"
"30 { 10 20 30 } n-subtract ."
"{ 20 10 0 }"
}
{ $see-also "fry.examples" } ;
ARTICLE: "compositional-combinators" "Compositional combinators"
"Certain combinators transform quotations to produce a new quotation."
{ $subsection "compositional-examples" }
"Fundamental operations:"
{ $subsection curry }
{ $subsection compose }
"Derived operations:"
{ $subsection 2curry }
{ $subsection 3curry }
{ $subsection with }
{ $subsection prepose }
"These operations run in constant time, and in many cases are optimized out altogether by the " { $link "compiler" } ". " { $link "fry" } " are an abstraction built on top of these operations, and code that uses this abstraction is often clearer than direct calls to the below words."
$nl
"Curried dataflow combinators can be used to build more complex dataflow by combining cleave, spread and apply patterns in various ways."
{ $subsection "curried-dataflow" }
"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } ". However, such runtime quotation manipulation will not be optimized by the optimizing compiler." ;
ARTICLE: "booleans" "Booleans"
"In Factor, any object that is not " { $link f } " has a true value, and " { $link f } " has a false value. The " { $link t } " object is the canonical true value."
{ $subsection f }
{ $subsection t }
"There are some logical operations on booleans:"
{ $subsection >boolean }
{ $subsection not }
{ $subsection and }
{ $subsection or }
{ $subsection xor }
"Boolean values are most frequently used for " { $link "conditionals" } "."
{ $heading "The f object and f class" }
"The " { $link f } " object is the unique instance of the " { $link f } " class; the two are distinct objects. The latter is also a parsing word which adds the " { $link f } " object to the parse tree at parse time. To refer to the class itself you must use " { $link POSTPONE: POSTPONE: } " or " { $link POSTPONE: \ } " to prevent the parsing word from executing."
$nl
"Here is the " { $link f } " object:"
{ $example "f ." "f" }
"Here is the " { $link f } " class:"
{ $example "\\ f ." "POSTPONE: f" }
"They are not equal:"
{ $example "f \\ f = ." "f" }
"Here is an array containing the " { $link f } " object:"
{ $example "{ f } ." "{ f }" }
"Here is an array containing the " { $link f } " class:"
{ $example "{ POSTPONE: f } ." "{ POSTPONE: f }" }
"The " { $link f } " object is an instance of the " { $link f } " class:"
{ $example "USE: classes" "f class ." "POSTPONE: f" }
"The " { $link f } " class is an instance of " { $link word } ":"
{ $example "USE: classes" "\\ f class ." "word" }
"On the other hand, " { $link t } " is just a word, and there is no class which it is a unique instance of."
{ $example "t \\ t eq? ." "t" }
"Many words which search collections confuse the case of no element being present with an element being found equal to " { $link f } ". If this distinction is imporant, there is usually an alternative word which can be used; for example, compare " { $link at } " with " { $link at* } "." ;
ARTICLE: "conditionals-boolean-equivalence" "Expressing conditionals with boolean logic"
"Certain simple conditional forms can be expressed in a simpler manner using boolean logic."
$nl
"The following two lines are equivalent:"
{ $code "[ drop f ] unless" "swap and" }
"The following two lines are equivalent:"
{ $code "[ ] [ ] ?if" "swap or" }
"The following two lines are equivalent, where " { $snippet "L" } " is a literal:"
{ $code "[ L ] unless*" "L or" } ;
ARTICLE: "conditionals" "Conditional combinators"
"The basic conditionals:"
{ $subsection if }
{ $subsection when }
{ $subsection unless }
"Forms abstracting a common stack shuffle pattern:"
{ $subsection if* }
{ $subsection when* }
{ $subsection unless* }
"Another form abstracting a common stack shuffle pattern:"
{ $subsection ?if }
"Sometimes instead of branching, you just need to pick one of two values:"
{ $subsection ? }
"Two combinators which abstract out nested chains of " { $link if } ":"
{ $subsection cond }
{ $subsection case }
{ $subsection "conditionals-boolean-equivalence" }
{ $see-also "booleans" "bitwise-arithmetic" both? either? } ;
ARTICLE: "dataflow-combinators" "Data flow combinators"
"Data flow combinators pass values between quotations:"
{ $subsection "slip-keep-combinators" }
{ $subsection "cleave-combinators" }
{ $subsection "spread-combinators" }
{ $subsection "apply-combinators" }
{ $see-also "curried-dataflow" } ;
ARTICLE: "combinators-quot" "Quotation construction utilities"
"Some words for creating quotations which can be useful for implementing method combinations and compiler transforms:"
{ $subsection cond>quot }
{ $subsection case>quot }
{ $subsection alist>quot } ;
ARTICLE: "call" "Calling code with known stack effects"
"Arbitrary quotations and words can be called from code accepted by the optimizing compiler. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate."
ARTICLE: "call" "Fundamental combinators"
"The most basic combinators are those that take either a quotation or word, and invoke it immediately. There are two sets of combinators; they differe in whether or not the stack effect of the expected code is declared."
$nl
"Quotations:"
{ $subsection POSTPONE: call( }
"The simplest combinators do not take an effect declaration:"
{ $subsection call }
{ $subsection execute }
"These combinators only get optimized by the compiler if the quotation or word parameter is a literal; otherwise a compiler warning will result. Definitions of combinators which require literal parameters must be followed by the " { $link POSTPONE: inline } " declaration. For example:"
{ $code
": keep ( x quot -- x )"
" over [ call ] dip ; inline"
}
"See " { $link "declarations" } " and " { $link "compiler-errors" } " for details."
$nl
"The other set of combinators allow arbitrary quotations and words to be called from optimized code. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate."
{ $subsection call-effect }
"Words:"
{ $subsection POSTPONE: execute( }
{ $subsection execute-effect }
"Unsafe calls:"
"A simple layer of syntax sugar is defined on top:"
{ $subsection POSTPONE: call( }
{ $subsection POSTPONE: execute( }
"Unsafe calls declare an effect statically without any runtime checking:"
{ $subsection call-effect-unsafe }
{ $subsection execute-effect-unsafe } ;
{ $subsection execute-effect-unsafe }
{ $see-also "effects" "inference" } ;
ARTICLE: "combinators" "Additional combinators"
"The " { $vocab-link "combinators" } " vocabulary provides a few useful combinators."
ARTICLE: "combinators" "Combinators"
"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
{ $subsection "call" }
{ $subsection "dataflow-combinators" }
{ $subsection "conditionals" }
{ $subsection "looping-combinators" }
{ $subsection "compositional-combinators" }
{ $subsection "combinators.short-circuit" }
{ $subsection "combinators.smart" }
"More combinators are defined for working on data structures, such as " { $link "sequences-combinators" } " and " { $link "assocs-combinators" } "."
$nl
"Generalization of " { $link bi } " and " { $link tri } ":"
{ $subsection cleave }
"Generalization of " { $link 2bi } " and " { $link 2tri } ":"
{ $subsection 2cleave }
"Generalization of " { $link 3bi } " and " { $link 3tri } ":"
{ $subsection 3cleave }
"Generalization of " { $link bi* } " and " { $link tri* } ":"
{ $subsection spread }
"Two combinators which abstract out nested chains of " { $link if } ":"
{ $subsection cond }
{ $subsection case }
"The " { $vocab-link "combinators" } " also provides some less frequently-used features."
"The " { $vocab-link "combinators" } " provides some less frequently-used features."
$nl
"A combinator which can help with implementing methods on " { $link hashcode* } ":"
{ $subsection recursive-hashcode }
{ $subsection "call" }
{ $subsection "combinators-quot" }
{ $see-also "quotations" "dataflow" } ;
"Advanced topics:"
{ $see-also "quotations" } ;
ABOUT: "combinators"

15
core/definitions/definitions-docs.factor
View File

@ -56,11 +56,24 @@ $nl
{ $subsection redefine-error } ;
ARTICLE: "definitions" "Definitions"
"A " { $emphasis "definition" } " is an artifact read from a source file. This includes words, methods, help articles, and path names (which represent the source file at that location). Words for working with definitions are found in the " { $vocab-link "definitions" } " vocabulary."
"A " { $emphasis "definition" } " is an artifact read from a source file. Words for working with definitions are found in the " { $vocab-link "definitions" } " vocabulary."
$nl
"Definitions are defined using parsing words. Examples of definitions together with their defining parsing words are words (" { $link POSTPONE: : } "), methods (" { $link POSTPONE: M: } "), and vocabularies (" { $link POSTPONE: IN: } ")."
$nl
"All definitions share some common traits:"
{ $list
"There is a word to list all definitions of a given type"
"There is a parsing word for creating new definitions"
"There is an ordinary word which is the runtime equivalent of the parsing word, for introspection"
"Instances of the definition may be introspected and modified with the definition protocol"
}
"For every source file loaded into the system, a list of definitions is maintained. Pathname objects implement the definition protocol, acting over the definitions their source files contain. See " { $link "source-files" } " for details."
{ $subsection "definition-protocol" }
{ $subsection "definition-crossref" }
{ $subsection "definition-checking" }
{ $subsection "compilation-units" }
"A parsing word to remove definitions:"
{ $subsection POSTPONE: FORGET: }
{ $see-also "see" "parser" "source-files" "words" "generic" "help-impl" } ;
ABOUT: "definitions"

11
core/definitions/definitions-tests.factor
View File

@ -20,14 +20,11 @@ TUPLE: some-class ;
M: some-class some-generic ;
TUPLE: another-class some-generic ;
[ ] [
[
{
some-generic
some-class
{ another-class some-generic }
} forget-all
\ some-generic
\ some-class
2array
forget-all
] with-compilation-unit
] unit-test

4
core/definitions/definitions.factor
View File

@ -42,7 +42,7 @@ GENERIC: set-where ( loc defspec -- )
GENERIC: forget* ( defspec -- )
M: object forget* drop ;
M: f forget* drop ;
SYMBOL: forgotten-definitions
@ -53,8 +53,6 @@ SYMBOL: forgotten-definitions
: forget-all ( definitions -- ) [ forget ] each ;
GENERIC: synopsis* ( defspec -- )
GENERIC: definer ( defspec -- start end )
GENERIC: definition ( defspec -- seq )

15
core/effects/effects-docs.factor
View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax math strings words kernel ;
USING: help.markup help.syntax math strings words kernel combinators ;
IN: effects
ARTICLE: "effect-declaration" "Stack effect declaration"
@ -29,14 +29,11 @@ $nl
"The stack effect inferencer verifies stack effect comments to ensure the correct number of inputs and outputs is listed. Value names are ignored; only their number matters. An error is thrown if a word's declared stack effect does not match its inferred stack effect. See " { $link "inference" } "." ;
ARTICLE: "effects" "Stack effects"
"A " { $emphasis "stack effect declaration" } ", for example " { $snippet "( x y -- z )" } " denotes that an operation takes two inputs, with " { $snippet "y" } " at the top of the stack, and returns one output."
"A " { $emphasis "stack effect declaration" } ", for example " { $snippet "( x y -- z )" } " denotes that an operation takes two inputs, with " { $snippet "y" } " at the top of the stack, and returns one output. Stack effects are first-class, and words for working with them are found in the " { $vocab-link "effects" } " vocabulary."
$nl
"Stack effects of words can be declared."
"Stack effects of words must be declared, and the " { $link "compiler" } " checks that these declarations are correct. Invalid declarations are reported as " { $link "compiler-errors" } ". The " { $link "inference" } " tool can be used to check stack effects interactively."
{ $subsection "effect-declaration" }
"Stack effects are first-class, and words for working with them are found in the " { $vocab-link "effects" } " vocabulary."
{ $subsection effect }
{ $subsection effect? }
"There is a literal syntax for stack objects. It is most often used with " { $link define-declared } "."
"There is a literal syntax for stack objects. It is most often used with " { $link define-declared } ", " { $link call-effect } " and " { $link execute-effect } "."
{ $subsection POSTPONE: (( }
"Getting a word's declared stack effect:"
{ $subsection stack-effect }
@ -45,7 +42,9 @@ $nl
"Comparing effects:"
{ $subsection effect-height }
{ $subsection effect<= }
{ $see-also "inference" } ;
"The class of stack effects:"
{ $subsection effect }
{ $subsection effect? } ;
ABOUT: "effects"

13
core/generic/generic-docs.factor
View File

@ -45,8 +45,8 @@ $nl
{ $subsection make-generic }
"Low-level method constructor:"
{ $subsection <method> }
"A " { $emphasis "method specifier" } " refers to a method and implements the " { $link "definition-protocol" } ":"
{ $subsection method-spec }
"Methods may be pushed on the stack with a literal syntax:"
{ $subsection POSTPONE: M\ }
{ $see-also "see" } ;
ARTICLE: "method-combination" "Custom method combination"
@ -98,8 +98,8 @@ $nl
"Generic words must declare their stack effect in order to compile. See " { $link "effect-declaration" } "."
{ $subsection "method-order" }
{ $subsection "call-next-method" }
{ $subsection "generic-introspection" }
{ $subsection "method-combination" }
{ $subsection "generic-introspection" }
"Generic words specialize behavior based on the class of an object; sometimes behavior needs to be specialized on the object's " { $emphasis "structure" } "; this is known as " { $emphasis "pattern matching" } " and is implemented in the " { $vocab-link "match" } " vocabulary." ;
ABOUT: "generic"
@ -119,9 +119,10 @@ HELP: define-generic
{ $description "Defines a generic word. A method combination is an object which responds to the " { $link perform-combination } " generic word." }
{ $contract "The method combination quotation is called each time the generic word has to be updated (for example, when a method is added), and thus must be side-effect free." } ;
HELP: method-spec
{ $class-description "The class of method specifiers, which are two-element arrays consisting of a class word followed by a generic word." }
{ $examples { $code "{ fixnum + }" "{ editor draw-gadget* }" } } ;
HELP: M\
{ $syntax "M\\ class generic" }
{ $class-description "Pushes a method on the stack." }
{ $examples { $code "M\\ fixnum + see" } { $code "USING: ui.gadgets ui.gadgets.editors ;" "M\\ editor draw-gadget* edit" } } ;
HELP: method-body
{ $class-description "The class of method bodies, which are words with special word properties set." } ;

7
core/generic/generic-tests.factor
View File

@ -105,9 +105,6 @@ M: shit big-generic-test "shit" ;
[ float ] [ \ real \ float math-class-max ] unit-test
[ fixnum ] [ \ fixnum \ null math-class-max ] unit-test
[ t ] [ { hashtable equal? } method-spec? ] unit-test
[ f ] [ { word = } method-spec? ] unit-test
! Regression
TUPLE: first-one ;
TUPLE: second-one ;
@ -164,7 +161,7 @@ M: sequence generic-forget-test-2 = ;
] unit-test
[ ] [
[ { sequence generic-forget-test-2 } forget ] with-compilation-unit
[ M\ sequence generic-forget-test-2 forget ] with-compilation-unit
] unit-test
[ f ] [
@ -234,7 +231,7 @@ M: number c-n-m-cache ;
[ 3 ] [ 2 c-n-m-cache ] unit-test
[ ] [ [ { integer c-n-m-cache } forget ] with-compilation-unit ] unit-test
[ ] [ [ M\ integer c-n-m-cache forget ] with-compilation-unit ] unit-test
[ 2 ] [ 2 c-n-m-cache ] unit-test

29
core/generic/generic.factor
View File

@ -24,11 +24,6 @@ M: generic definition drop f ;
: method ( class generic -- method/f )
"methods" word-prop at ;
PREDICATE: method-spec < pair
first2 generic? swap class? and ;
INSTANCE: method-spec definition
: order ( generic -- seq )
"methods" word-prop keys sort-classes ;
@ -90,9 +85,6 @@ TUPLE: check-method class generic ;
PREDICATE: method-body < word
"method-generic" word-prop >boolean ;
M: method-spec stack-effect
first2 method stack-effect ;
M: method-body stack-effect
"method-generic" word-prop stack-effect ;
@ -139,24 +131,6 @@ M: default-method irrelevant? drop t ;
dupd <default-method> "default-method" set-word-prop ;
! Definition protocol
M: method-spec where
dup first2 method [ ] [ second ] ?if where ;
M: method-spec set-where
first2 method set-where ;
M: method-spec definer
first2 method definer ;
M: method-spec definition
first2 method definition ;
M: method-spec forget*
first2 method [ forgotten-definition ] [ forget* ] bi ;
M: method-spec smart-usage
second smart-usage ;
M: method-body definer
drop \ M: \ ; ;
@ -214,5 +188,8 @@ M: generic subwords
M: generic forget*
[ subwords forget-all ] [ call-next-method ] bi ;
M: class forget-methods
[ implementors ] [ [ swap method ] curry ] bi map forget-all ;
: xref-generics ( -- )
all-words [ subwords [ xref ] each ] each ;

2
core/generic/math/math-docs.factor
View File

@ -15,7 +15,7 @@ HELP: no-math-method
HELP: math-method
{ $values { "word" generic } { "class1" class } { "class2" class } { "quot" quotation } }
{ $description "Generates a definition for " { $snippet "word" } " when the two inputs are instances of " { $snippet "class1" } " and " { $snippet "class2" } ", respectively." }
{ $examples { $example "USING: generic.math math prettyprint ;" "\\ + fixnum float math-method ." "[ { fixnum float } declare [ >float ] dip float=>+ ]" } } ;
{ $examples { $example "USING: generic.math math prettyprint ;" "\\ + fixnum float math-method ." "[ { fixnum float } declare [ >float ] dip M\\ float + ]" } } ;
HELP: math-class
{ $class-description "The class of subtypes of " { $link number } " which are not " { $link null } "." } ;

4
core/io/encodings/encodings-docs.factor
View File

@ -80,12 +80,12 @@ ARTICLE: "encodings-descriptors" "Encoding descriptors"
"An encoding descriptor is something which can be used with binary input or output streams to encode or decode bytes stored in a certain representation. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
{ $subsection "io.encodings.binary" }
{ $subsection "io.encodings.utf8" }
{ $subsection "io.encodings.utf16" }
{ $vocab-subsection "UTF-16 encoding" "io.encodings.utf16" }
{ $vocab-subsection "UTF-32 encoding" "io.encodings.utf32" }
{ $vocab-subsection "Strict encodings" "io.encodings.strict" }
"Legacy encodings:"
{ $vocab-subsection "8-bit encodings" "io.encodings.8-bit" }
{ $vocab-subsection "ASCII" "io.encodings.ascii" }
{ $vocab-subsection "ASCII encoding" "io.encodings.ascii" }
{ $see-also "encodings-introduction" } ;
ARTICLE: "encodings-protocol" "Encoding protocol"

285
core/kernel/kernel-docs.factor
View File

@ -841,260 +841,6 @@ $nl
{ $subsection roll }
{ $subsection -roll } ;
ARTICLE: "cleave-shuffle-equivalence" "Expressing shuffle words with cleave combinators"
"Cleave combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to cleave combinators are discussed in the documentation for " { $link bi } ", " { $link 2bi } ", " { $link 3bi } ", " { $link tri } ", " { $link 2tri } " and " { $link 3tri } "."
$nl
"Certain shuffle words can also be expressed in terms of the cleave combinators. Internalizing such identities can help with understanding and writing code using cleave combinators:"
{ $code
": keep [ ] bi ;"
": 2keep [ ] 2bi ;"
": 3keep [ ] 3bi ;"
""
": dup [ ] [ ] bi ;"
": 2dup [ ] [ ] 2bi ;"
": 3dup [ ] [ ] 3bi ;"
""
": tuck [ nip ] [ ] 2bi ;"
": swap [ nip ] [ drop ] 2bi ;"
""
": over [ ] [ drop ] 2bi ;"
": pick [ ] [ 2drop ] 3bi ;"
": 2over [ ] [ drop ] 3bi ;"
} ;
ARTICLE: "cleave-combinators" "Cleave combinators"
"The cleave combinators apply multiple quotations to a single value."
$nl
"Two quotations:"
{ $subsection bi }
{ $subsection 2bi }
{ $subsection 3bi }
"Three quotations:"
{ $subsection tri }
{ $subsection 2tri }
{ $subsection 3tri }
"Technically, the cleave combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on the top of the stack can be written in one of two ways:"
{ $code
"! First alternative; uses keep"
"[ 1 + ] keep"
"[ 1 - ] keep"
"2 *"
"! Second alternative: uses tri"
"[ 1 + ]"
"[ 1 - ]"
"[ 2 * ] tri"
}
"The latter is more aesthetically pleasing than the former."
$nl
"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "."
{ $subsection "cleave-shuffle-equivalence" } ;
ARTICLE: "spread-shuffle-equivalence" "Expressing shuffle words with spread combinators"
"Spread combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to spread combinators are discussed in the documentation for " { $link bi* } ", " { $link 2bi* } ", " { $link tri* } ", and " { $link 2tri* } "."
$nl
"Certain shuffle words can also be expressed in terms of the spread combinators. Internalizing such identities can help with understanding and writing code using spread combinators:"
{ $code
": dip [ ] bi* ;"
": 2dip [ ] [ ] tri* ;"
""
": slip [ call ] [ ] bi* ;"
": 2slip [ call ] [ ] [ ] tri* ;"
""
": nip [ drop ] [ ] bi* ;"
": 2nip [ drop ] [ drop ] [ ] tri* ;"
""
": rot"
" [ [ drop ] [ ] [ drop ] tri* ]"
" [ [ drop ] [ drop ] [ ] tri* ]"
" [ [ ] [ drop ] [ drop ] tri* ]"
" 3tri ;"
""
": -rot"
" [ [ drop ] [ drop ] [ ] tri* ]"
" [ [ ] [ drop ] [ drop ] tri* ]"
" [ [ drop ] [ ] [ drop ] tri* ]"
" 3tri ;"
""
": spin"
" [ [ drop ] [ drop ] [ ] tri* ]"
" [ [ drop ] [ ] [ drop ] tri* ]"
" [ [ ] [ drop ] [ drop ] tri* ]"
" 3tri ;"
} ;
ARTICLE: "spread-combinators" "Spread combinators"
"The spread combinators apply multiple quotations to multiple values. The " { $snippet "*" } " suffix signifies spreading."
$nl
"Two quotations:"
{ $subsection bi* }
{ $subsection 2bi* }
"Three quotations:"
{ $subsection tri* }
{ $subsection 2tri* }
"Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:"
{ $code
"! First alternative; uses dip"
"[ [ 1 + ] dip 1 - ] dip 2 *"
"! Second alternative: uses tri*"
"[ 1 + ] [ 1 - ] [ 2 * ] tri*"
}
"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "."
{ $subsection "spread-shuffle-equivalence" } ;
ARTICLE: "apply-combinators" "Apply combinators"
"The apply combinators apply a single quotation to multiple values. The " { $snippet "@" } " suffix signifies application."
$nl
"Two quotations:"
{ $subsection bi@ }
{ $subsection 2bi@ }
"Three quotations:"
{ $subsection tri@ }
{ $subsection 2tri@ }
"A pair of utility words built from " { $link bi@ } ":"
{ $subsection both? }
{ $subsection either? } ;
ARTICLE: "slip-keep-combinators" "Retain stack combinators"
"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using a set of combinators."
$nl
"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
{ $subsection dip }
{ $subsection 2dip }
{ $subsection 3dip }
{ $subsection 4dip }
"The slip combinators invoke a quotation further down on the stack. They are most useful for implementing other combinators:"
{ $subsection slip }
{ $subsection 2slip }
{ $subsection 3slip }
"The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:"
{ $subsection keep }
{ $subsection 2keep }
{ $subsection 3keep } ;
ARTICLE: "curried-dataflow" "Curried dataflow combinators"
"Curried cleave combinators:"
{ $subsection bi-curry }
{ $subsection tri-curry }
"Curried spread combinators:"
{ $subsection bi-curry* }
{ $subsection tri-curry* }
"Curried apply combinators:"
{ $subsection bi-curry@ }
{ $subsection tri-curry@ }
{ $see-also "dataflow-combinators" } ;
ARTICLE: "compositional-examples" "Examples of compositional combinator usage"
"Consider printing the same message ten times:"
{ $code ": print-10 ( -- ) 10 [ \"Hello, world.\" print ] times ;" }
"if we wanted to abstract out the message into a parameter, we could keep it on the stack between iterations:"
{ $code ": print-10 ( message -- ) 10 [ dup print ] times drop ;" }
"However, keeping loop-invariant values on the stack doesn't always work out nicely. For example, a word to subtract a value from each element of a sequence:"
{ $code ": subtract-n ( seq n -- seq' ) swap [ over - ] map nip ;" }
"Three shuffle words are required to pass the value around. Instead, the loop-invariant value can be partially applied to a quotation using " { $link curry } ", yielding a new quotation that is passed to " { $link map } ":"
{ $example
"USING: kernel math prettyprint sequences ;"
": subtract-n ( seq n -- seq' ) [ - ] curry map ;"
"{ 10 20 30 } 5 subtract-n ."
"{ 5 15 25 }"
}
"Now consider the word that is dual to the one above; instead of subtracting " { $snippet "n" } " from each stack element, it subtracts each element from " { $snippet "n" } "."
$nl
"One way to write this is with a pair of " { $link swap } "s:"
{ $code ": n-subtract ( n seq -- seq' ) swap [ swap - ] curry map ;" }
"Since this pattern comes up often, " { $link with } " encapsulates it:"
{ $example
"USING: kernel math prettyprint sequences ;"
": n-subtract ( n seq -- seq' ) [ - ] with map ;"
"30 { 10 20 30 } n-subtract ."
"{ 20 10 0 }"
}
{ $see-also "fry.examples" } ;
ARTICLE: "compositional-combinators" "Compositional combinators"
"Certain combinators transform quotations to produce a new quotation."
{ $subsection "compositional-examples" }
"Fundamental operations:"
{ $subsection curry }
{ $subsection compose }
"Derived operations:"
{ $subsection 2curry }
{ $subsection 3curry }
{ $subsection with }
{ $subsection prepose }
"These operations run in constant time, and in many cases are optimized out altogether by the " { $link "compiler" } ". " { $link "fry" } " are an abstraction built on top of these operations, and code that uses this abstraction is often clearer than direct calls to the below words."
$nl
"Curried dataflow combinators can be used to build more complex dataflow by combining cleave, spread and apply patterns in various ways."
{ $subsection "curried-dataflow" }
"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } ". However, such runtime quotation manipulation will not be optimized by the optimizing compiler." ;
ARTICLE: "implementing-combinators" "Implementing combinators"
"The following pair of words invoke words and quotations reflectively:"
{ $subsection call }
{ $subsection execute }
"These words are used to implement combinators. Note that combinator definitions must be followed by the " { $link POSTPONE: inline } " declaration in order to compile in the optimizing compiler; for example:"
{ $code
": keep ( x quot -- x )"
" over [ call ] dip ; inline"
}
"Word inlining is documented in " { $link "declarations" } "." ;
ARTICLE: "booleans" "Booleans"
"In Factor, any object that is not " { $link f } " has a true value, and " { $link f } " has a false value. The " { $link t } " object is the canonical true value."
{ $subsection f }
{ $subsection t }
"The " { $link f } " object is the unique instance of the " { $link f } " class; the two are distinct objects. The latter is also a parsing word which adds the " { $link f } " object to the parse tree at parse time. To refer to the class itself you must use " { $link POSTPONE: POSTPONE: } " or " { $link POSTPONE: \ } " to prevent the parsing word from executing."
$nl
"Here is the " { $link f } " object:"
{ $example "f ." "f" }
"Here is the " { $link f } " class:"
{ $example "\\ f ." "POSTPONE: f" }
"They are not equal:"
{ $example "f \\ f = ." "f" }
"Here is an array containing the " { $link f } " object:"
{ $example "{ f } ." "{ f }" }
"Here is an array containing the " { $link f } " class:"
{ $example "{ POSTPONE: f } ." "{ POSTPONE: f }" }
"The " { $link f } " object is an instance of the " { $link f } " class:"
{ $example "USE: classes" "f class ." "POSTPONE: f" }
"The " { $link f } " class is an instance of " { $link word } ":"
{ $example "USE: classes" "\\ f class ." "word" }
"On the other hand, " { $link t } " is just a word, and there is no class which it is a unique instance of."
{ $example "t \\ t eq? ." "t" }
"Many words which search collections confuse the case of no element being present with an element being found equal to " { $link f } ". If this distinction is imporant, there is usually an alternative word which can be used; for example, compare " { $link at } " with " { $link at* } "." ;
ARTICLE: "conditionals-boolean-equivalence" "Expressing conditionals with boolean logic"
"Certain simple conditional forms can be expressed in a simpler manner using boolean logic."
$nl
"The following two lines are equivalent:"
{ $code "[ drop f ] unless" "swap and" }
"The following two lines are equivalent:"
{ $code "[ ] [ ] ?if" "swap or" }
"The following two lines are equivalent, where " { $snippet "L" } " is a literal:"
{ $code "[ L ] unless*" "L or" } ;
ARTICLE: "conditionals" "Conditionals and logic"
"The basic conditionals:"
{ $subsection if }
{ $subsection when }
{ $subsection unless }
"Forms abstracting a common stack shuffle pattern:"
{ $subsection if* }
{ $subsection when* }
{ $subsection unless* }
"Another form abstracting a common stack shuffle pattern:"
{ $subsection ?if }
"Sometimes instead of branching, you just need to pick one of two values:"
{ $subsection ? }
"There are some logical operations on booleans:"
{ $subsection >boolean }
{ $subsection not }
{ $subsection and }
{ $subsection or }
{ $subsection xor }
{ $subsection "conditionals-boolean-equivalence" }
"See " { $link "combinators" } " for forms which abstract away common patterns involving multiple nested branches."
{ $see-also "booleans" "bitwise-arithmetic" both? either? } ;
ARTICLE: "equality" "Equality"
"There are two distinct notions of “sameness” when it comes to objects."
$nl
@ -1116,34 +862,3 @@ ARTICLE: "assertions" "Assertions"
{ $subsection assert }
{ $subsection assert= } ;
ARTICLE: "dataflow-combinators" "Data flow combinators"
"Data flow combinators pass values between quotations:"
{ $subsection "slip-keep-combinators" }
{ $subsection "cleave-combinators" }
{ $subsection "spread-combinators" }
{ $subsection "apply-combinators" }
{ $see-also "curried-dataflow" } ;
ARTICLE: "dataflow" "Data and control flow"
{ $subsection "evaluator" }
{ $subsection "words" }
{ $subsection "effects" }
{ $subsection "booleans" }
{ $subsection "shuffle-words" }
"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
{ $subsection "dataflow-combinators" }
{ $subsection "conditionals" }
{ $subsection "looping-combinators" }
{ $subsection "compositional-combinators" }
{ $subsection "combinators" }
"More combinators are defined for working on data structures, such as " { $link "sequences-combinators" } " and " { $link "assocs-combinators" } "."
$nl
"Advanced topics:"
{ $subsection "assertions" }
{ $subsection "implementing-combinators" }
{ $subsection "macros" }
{ $subsection "errors" }
{ $subsection "continuations" } ;
ABOUT: "dataflow"

5
core/math/math-docs.factor
View File

@ -355,8 +355,9 @@ ARTICLE: "bitwise-arithmetic" "Bitwise arithmetic"
{ $subsection 2/ }
{ $subsection 2^ }
{ $subsection bit? }
"The " { $vocab-link "math.bitwise" } " vocabulary implements additional bitwise integer operations."
{ $see-also "conditionals" } ;
{ $subsection "math.bitwise" }
{ $subsection "math.bits" }
{ $see-also "booleans" } ;
ARTICLE: "arithmetic" "Arithmetic"
"Factor attempts to preserve natural mathematical semantics for numbers. Multiplying two large integers never results in overflow, and dividing two integers yields an exact ratio. Floating point numbers are also supported, along with complex numbers."

11
core/math/order/order-docs.factor
View File

@ -87,7 +87,14 @@ ARTICLE: "order-specifiers" "Ordering specifiers"
{ $subsection +lt+ }
{ $subsection +eq+ }
{ $subsection +gt+ } ;
ARTICLE: "math.order.example" "Linear order example"
"A tuple class which defines an ordering among instances by comparing the values of the " { $snippet "id" } " slot:"
{ $code
"TUPLE: sprite id name bitmap ;"
"M: sprite <=> [ id>> ] compare ;"
} ;
ARTICLE: "math.order" "Linear order protocol"
"Some classes have an intrinsic order amongst instances:"
{ $subsection <=> }
@ -101,6 +108,8 @@ ARTICLE: "math.order" "Linear order protocol"
{ $subsection before? }
{ $subsection after=? }
{ $subsection before=? }
"Out of the above generic words, it suffices to implement " { $link <=> } " alone. The others may be provided as an optimization."
{ $subsection "math.order.example" }
{ $see-also "sequences-sorting" } ;
ABOUT: "math.order"

3
core/namespaces/namespaces-docs.factor
View File

@ -32,7 +32,7 @@ ARTICLE: "namespaces.private" "Namespace implementation details"
{ $subsection >n }
{ $subsection ndrop } ;
ARTICLE: "namespaces" "Variables and namespaces"
ARTICLE: "namespaces" "Dynamic variables and namespaces"
"The " { $vocab-link "namespaces" } " vocabulary implements simple dynamically-scoped variables."
$nl
"A variable is an entry in an assoc of bindings, where the assoc is implicit rather than passed on the stack. These assocs are termed " { $emphasis "namespaces" } ". Nesting of scopes is implemented with a search order on namespaces, defined by a " { $emphasis "namestack" } ". Since namespaces are just assoc, any object can be used as a variable, however by convention, variables are keyed by symbols (see " { $link "words.symbol" } ")."
@ -43,7 +43,6 @@ $nl
"Various utility words abstract away common variable access patterns:"
{ $subsection "namespaces-change" }
{ $subsection "namespaces-combinators" }
{ $subsection "namespaces-global" }
"Implementation details your code probably does not care about:"
{ $subsection "namespaces.private" }
"An alternative to dynamic scope is lexical scope. Lexically-scoped values and closures are implemented in the " { $vocab-link "locals" } " vocabulary." ;

Some files were not shown because too many files have changed in this diff Show More