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

db4
Doug Coleman 2008-11-11 13:07:26 -06:00
commit aff4c9bda3
20 changed files with 205 additions and 90 deletions

View File

@ -5,7 +5,7 @@ strings sbufs sequences.private slots.private combinators
definitions system layouts vectors math.partial-dispatch definitions system layouts vectors math.partial-dispatch
math.order math.functions accessors hashtables classes assocs math.order math.functions accessors hashtables classes assocs
io.encodings.utf8 io.encodings.ascii io.encodings fry slots io.encodings.utf8 io.encodings.ascii io.encodings fry slots
sorting.private combinators.short-circuit sorting.private combinators.short-circuit grouping prettyprint
compiler.tree compiler.tree
compiler.tree.combinators compiler.tree.combinators
compiler.tree.cleanup compiler.tree.cleanup
@ -505,3 +505,8 @@ cell-bits 32 = [
[ { null } declare [ 1 ] [ 2 ] if ] [ { null } declare [ 1 ] [ 2 ] if ]
build-tree normalize propagate cleanup check-nodes build-tree normalize propagate cleanup check-nodes
] unit-test ] unit-test
[ t ] [
[ { array } declare 2 <groups> [ . . ] assoc-each ]
\ nth-unsafe inlined?
] unit-test

View File

@ -77,3 +77,10 @@ IN: dlists.tests
[ f ] [ <dlist> 3 over push-front 4 over push-back -1 swap deque-member? ] unit-test [ f ] [ <dlist> 3 over push-front 4 over push-back -1 swap deque-member? ] unit-test
[ f ] [ <dlist> 0 swap deque-member? ] unit-test [ f ] [ <dlist> 0 swap deque-member? ] unit-test
! Make sure clone does the right thing
[ V{ 2 1 } V{ 2 1 3 } ] [
<dlist> 1 over push-front 2 over push-front
dup clone 3 over push-back
[ dlist>seq ] bi@
] unit-test

View File

@ -154,6 +154,14 @@ M: dlist clear-deque ( dlist -- )
: dlist-each ( dlist quot -- ) : dlist-each ( dlist quot -- )
[ obj>> ] prepose dlist-each-node ; inline [ obj>> ] prepose dlist-each-node ; inline
: dlist>seq ( dlist -- seq )
[ ] pusher [ dlist-each ] dip ;
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ; : 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
M: dlist clone
<dlist> [
[ push-back ] curry dlist-each
] keep ;
INSTANCE: dlist deque INSTANCE: dlist deque

View File

@ -1,29 +1,24 @@
USING: help.markup help.syntax ui.commands ui.operations USING: help.markup help.syntax ui.commands ui.operations
ui.tools.search ui.tools.workspace editors vocabs.loader ui.tools.search ui.tools.workspace editors vocabs.loader
kernel sequences prettyprint tools.test tools.vocabs strings kernel sequences prettyprint tools.test tools.vocabs strings
unicode.categories unicode.case ; unicode.categories unicode.case ui.tools.browser ;
IN: help.tutorial IN: help.tutorial
ARTICLE: "first-program-start" "Creating a vocabulary for your first program" ARTICLE: "first-program-start" "Creating a vocabulary for your first program"
"Factor source code is organized into " { $link "vocabularies" } ". Before we can write our first program, we must create a vocabulary for it." "Factor source code is organized into " { $link "vocabularies" } ". Before we can write our first program, we must create a vocabulary for it."
$nl $nl
"Start by asking Factor for the path to your ``work'' directory, where you will place your own code:" "Start by loading the scaffold tool:"
{ $code "USE: tools.scaffold" }
"Then, ask the scaffold tool to create a new vocabulary named " { $snippet "palindrome" } ":"
{ $code "\"resource:work\" \"palindrome\" scaffold-vocab" }
"If you look at the output, you will see that a few files were created in your ``work'' directory. The following phrase will print the full path of your work directory:"
{ $code "\"work\" resource-path ." } { $code "\"work\" resource-path ." }
"Open the work directory in your file manager, and create a subdirectory named " { $snippet "palindrome" } ". Inside this directory, create a file named " { $snippet "palindrome.factor" } " using your favorite text editor. Leave the file empty for now." "Open the work directory in your file manager, and open the subdirectory named " { $snippet "palindrome" } ". Inside this subdirectory you will see a file named " { $snippet "palindrome.factor" } ". We will be editing this file."
$nl $nl
"Inside the Factor listener, type" "Notice that the file ends with an " { $link POSTPONE: IN: } " form telling Factor that all definitions in this source file should go into the " { $snippet "palindrome" } " vocabulary using the " { $link POSTPONE: IN: } " word:"
{ $code "USE: palindrome" }
"The source file should now load. Since it is empty, it does nothing. If you get an error message, make sure you created the directory and the file in the right place and gave them the right names."
$nl
"Now, we will start filling out this source file. Go back to your editor, and type:"
{ $code
"! Copyright (C) 2008 <your name here>"
"! See http://factorcode.org/license.txt for BSD license."
}
"This is the standard header for Factor source files; it consists of two " { $link "syntax-comments" } "."
$nl
"Now, we tell Factor that all definitions in this source file should go into the " { $snippet "palindrome" } " vocabulary using the " { $link POSTPONE: IN: } " word:"
{ $code "IN: palindrome" } { $code "IN: palindrome" }
"We will add new definitions after the " { $link POSTPONE: IN: } " form."
$nl
"You are now ready to go on to the next section: " { $link "first-program-logic" } "." ; "You are now ready to go on to the next section: " { $link "first-program-logic" } "." ;
ARTICLE: "first-program-logic" "Writing some logic in your first program" ARTICLE: "first-program-logic" "Writing some logic in your first program"
@ -43,20 +38,16 @@ $nl
$nl $nl
"When you do this, you will get an error about the " { $link dup } " word not being found. This is because this word is part of the " { $vocab-link "kernel" } " vocabulary, but this vocabulary is not part of the source file's " { $link "vocabulary-search" } ". You must explicitly list dependencies in source files. This allows Factor to automatically load required vocabularies and makes larger programs easier to maintain." "When you do this, you will get an error about the " { $link dup } " word not being found. This is because this word is part of the " { $vocab-link "kernel" } " vocabulary, but this vocabulary is not part of the source file's " { $link "vocabulary-search" } ". You must explicitly list dependencies in source files. This allows Factor to automatically load required vocabularies and makes larger programs easier to maintain."
$nl $nl
"To add the word to the search path, first convince yourself that this word is in the " { $vocab-link "kernel" } " vocabulary by entering the following in the listener:" "To add the word to the search path, first convince yourself that this word is in the " { $vocab-link "kernel" } " vocabulary. Enter " { $snippet "dup" } " in the listener's input area, and press " { $operation com-follow } ". This will open the documentation browser tool, viewing the help for the " { $link dup } " word. One of the subheadings in the help article will mention the word's vocabulary."
{ $code "\\ dup see" }
"This shows the definition of " { $link dup } ", along with an " { $link POSTPONE: IN: } " form."
$nl $nl
"Now, add the following at the start of the source file:" "So now, add the following at the start of the source file:"
{ $code "USING: kernel ;" } { $code "USING: kernel ;" }
"Next, find out what vocabulary " { $link reverse } " lives in:" "Next, find out what vocabulary " { $link reverse } " lives in; type the word name " { $snippet "reverse" } " in the workspace listener's input area, and press " { $operation com-follow } "."
{ $code "\\ reverse see" } $nl
"It lives in the " { $vocab-link "sequences" } " vocabulary, so we add that to the search path:" "It lives in the " { $vocab-link "sequences" } " vocabulary, so we add that to the search path:"
{ $code "USING: kernel sequences ;" } { $code "USING: kernel sequences ;" }
"Finally, check what vocabulary " { $link = } " lives in:" "Finally, check what vocabulary " { $link = } " lives in, and confirm that it's in the " { $vocab-link "kernel" } " vocabulary, which we've already added to the search path."
{ $code "\\ = see" } $nl
"It's in the " { $vocab-link "kernel" } " vocabulary, which we've already added to the search path."
"Now press " { $command workspace "workflow" refresh-all } " again, and the source file should reload without any errors. You can now go on and learn about " { $link "first-program-test" } "." ; "Now press " { $command workspace "workflow" refresh-all } " again, and the source file should reload without any errors. You can now go on and learn about " { $link "first-program-test" } "." ;
ARTICLE: "first-program-test" "Testing your first program" ARTICLE: "first-program-test" "Testing your first program"
@ -81,9 +72,9 @@ $nl
{ $code "." } { $code "." }
"What we just did is called " { $emphasis "interactive testing" } ". A more advanced technique which comes into play with larger programs is " { $link "tools.test" } "." "What we just did is called " { $emphasis "interactive testing" } ". A more advanced technique which comes into play with larger programs is " { $link "tools.test" } "."
$nl $nl
"Create a file named " { $snippet "palindrome-tests.factor" } " in the same directory as " { $snippet "palindrome.factor" } ". Now, we can run unit tests from the listener:" "Open the file named " { $snippet "palindrome-tests.factor" } "; it is located in the same directory as " { $snippet "palindrome.factor" } ", and it was created by the scaffold tool."
{ $code "\"palindrome\" test" } $nl
"We will add some unit tests corresponding to the interactive tests we did above. Unit tests are defined with the " { $link unit-test } " word, which takes a sequence of expected outputs, and a piece of code. It runs the code, and asserts that it outputs the expected values." "We will add some unit tests, which are similar to the interactive tests we did above. Unit tests are defined with the " { $link unit-test } " word, which takes a sequence of expected outputs, and a piece of code. It runs the code, and asserts that it outputs the expected values."
$nl $nl
"Add the following three lines to " { $snippet "palindrome-tests.factor" } ":" "Add the following three lines to " { $snippet "palindrome-tests.factor" } ":"
{ $code { $code
@ -145,7 +136,7 @@ $nl
ARTICLE: "first-program" "Your first program" ARTICLE: "first-program" "Your first program"
"In this tutorial, we will write a simple Factor program which prompts the user to enter a word, and tests if it is a palindrome (that is, the word is spelled the same backwards and forwards)." "In this tutorial, we will write a simple Factor program which prompts the user to enter a word, and tests if it is a palindrome (that is, the word is spelled the same backwards and forwards)."
$nl $nl
"In this tutorial, you will learn about basic Factor development tools, as well as application deployment." "In this tutorial, you will learn about basic Factor development tools. You may want to open a second workspace window by pressing " { $command workspace "workflow" workspace-window } "; this will allow you to read this tutorial and browse other documentation at the same time."
{ $subsection "first-program-start" } { $subsection "first-program-start" }
{ $subsection "first-program-logic" } { $subsection "first-program-logic" }
{ $subsection "first-program-test" } { $subsection "first-program-test" }

View File

@ -4,7 +4,8 @@ USING: help.markup help.syntax byte-arrays strings ;
IN: io.encodings.string IN: io.encodings.string
ARTICLE: "io.encodings.string" "Encoding and decoding strings" ARTICLE: "io.encodings.string" "Encoding and decoding strings"
"Strings can be encoded or decoded to and from byte arrays through an encoding with the following words:" "Strings can be encoded or decoded to and from byte arrays through an encoding by passing "
{ $link "encodings-descriptors" } " to the following words:"
{ $subsection encode } { $subsection encode }
{ $subsection decode } ; { $subsection decode } ;

View File

@ -45,15 +45,20 @@ ARTICLE: "server-config-handler" "Client handler quotation"
$nl $nl
"The two methods are equivalent, representing a functional versus an object-oriented approach to the problem." ; "The two methods are equivalent, representing a functional versus an object-oriented approach to the problem." ;
ARTICLE: "server-examples" "Threaded server examples"
"The " { $vocab-link "time-server" } " vocabulary implements a simple threaded server which sends the current time to the client. The " { $vocab-link "concurrency.distributed" } ", " { $vocab-link "ftp.server" } ", and " { $vocab-link "http.server" } " vocabularies demonstrate more complex usage of the threaded server library." ;
ARTICLE: "io.servers.connection" "Threaded servers" ARTICLE: "io.servers.connection" "Threaded servers"
"The " { $vocab-link "io.servers.connection" } " vocabulary implements a generic server abstraction for " { $link "network-connection" } ". A set of threads listen for connections, and additional threads are spawned for each client connection. In addition to this basic functionality, it provides some advanced features such as logging, connection limits and secure socket support." "The " { $vocab-link "io.servers.connection" } " vocabulary implements a generic server abstraction for " { $link "network-connection" } ". A set of threads listen for connections, and additional threads are spawned for each client connection. In addition to this basic functionality, it provides some advanced features such as logging, connection limits and secure socket support."
{ $subsection threaded-server } { $subsection "server-examples" }
{ $subsection "server-config" }
"Creating threaded servers with client handler quotations:" "Creating threaded servers with client handler quotations:"
{ $subsection <threaded-server> } { $subsection <threaded-server> }
"Client handlers can also be implemented by subclassing a threaded server; see " { $link "server-config-handler" } " for details:" "Client handlers can also be implemented by subclassing a threaded server; see " { $link "server-config-handler" } " for details:"
{ $subsection threaded-server }
{ $subsection new-threaded-server } { $subsection new-threaded-server }
{ $subsection handle-client* } { $subsection handle-client* }
"The server must be configured before it can be started."
{ $subsection "server-config" }
"Starting the server:" "Starting the server:"
{ $subsection start-server } { $subsection start-server }
{ $subsection start-server* } { $subsection start-server* }

View File

@ -1,5 +1,5 @@
USING: help.syntax help.markup kernel macros prettyprint USING: help.syntax help.markup kernel macros prettyprint
memoize ; memoize combinators arrays ;
IN: locals IN: locals
HELP: [| HELP: [|
@ -84,6 +84,39 @@ HELP: MEMO::
{ POSTPONE: MEMO: POSTPONE: MEMO:: } related-words { POSTPONE: MEMO: POSTPONE: MEMO:: } related-words
ARTICLE: "locals-literals" "Locals in array and hashtable 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
"The data types which receive this special handling are the following:"
{ $list
{ $link "arrays" }
{ $link "hashtables" }
{ $link "vectors" }
{ $link "tuples" }
}
"This feature changes the semantics of literal object identity. An ordinary word containing a literal pushes the same literal on the stack every time it is invoked:"
{ $example
"IN: scratchpad"
"TUPLE: person first-name last-name ;"
": ordinary-word-test ( -- tuple )"
" T{ person { first-name \"Alan\" } { last-name \"Kay\" } } ;"
"ordinary-word-test ordinary-word-test eq? ."
"t"
}
"In a word with locals, literals expand into code which constructs the literal, and so every invocation pushes a new object:"
{ $example
"IN: scratchpad"
"TUPLE: person first-name last-name ;"
":: ordinary-word-test ( -- tuple )"
" T{ person { first-name \"Alan\" } { last-name \"Kay\" } } ;"
"ordinary-word-test ordinary-word-test eq? ."
"f"
}
"One exception to the above rule is that array instances containing no free variables do retain identity. This allows macros such as " { $link cond } " to recognize that the array is constant and expand at compile-time."
$nl
"For example, here is an implementation of the " { $link 3array } " word which uses this feature:"
{ $code ":: 3array ( x y z -- array ) { x y z } ;" } ;
ARTICLE: "locals-mutable" "Mutable locals" ARTICLE: "locals-mutable" "Mutable locals"
"In the list of bindings supplied to " { $link POSTPONE: :: } ", " { $link POSTPONE: [let } ", " { $link POSTPONE: [let* } " or " { $link POSTPONE: [| } ", a mutable binding may be introduced by suffixing its named with " { $snippet "!" } ". Mutable bindings are read by giving their name as usual; the suffix is not part of the binding's name. To write to a mutable binding, use the binding's name with the " { $snippet "!" } " suffix." "In the list of bindings supplied to " { $link POSTPONE: :: } ", " { $link POSTPONE: [let } ", " { $link POSTPONE: [let* } " or " { $link POSTPONE: [| } ", a mutable binding may be introduced by suffixing its named with " { $snippet "!" } ". Mutable bindings are read by giving their name as usual; the suffix is not part of the binding's name. To write to a mutable binding, use the binding's name with the " { $snippet "!" } " suffix."
$nl $nl
@ -139,6 +172,7 @@ $nl
"Lambda abstractions:" "Lambda abstractions:"
{ $subsection POSTPONE: [| } { $subsection POSTPONE: [| }
"Additional topics:" "Additional topics:"
{ $subsection "locals-literals" }
{ $subsection "locals-mutable" } { $subsection "locals-mutable" }
{ $subsection "locals-limitations" } { $subsection "locals-limitations" }
"Locals complement dynamically scoped variables implemented in the " { $vocab-link "namespaces" } " vocabulary." ; "Locals complement dynamically scoped variables implemented in the " { $vocab-link "namespaces" } " vocabulary." ;

View File

@ -134,3 +134,6 @@ IN: math.functions.tests
[ -4.0 ] [ -4.4 round ] unit-test [ -4.0 ] [ -4.4 round ] unit-test
[ 5.0 ] [ 4.5 round ] unit-test [ 5.0 ] [ 4.5 round ] unit-test
[ 4.0 ] [ 4.4 round ] unit-test [ 4.0 ] [ 4.4 round ] unit-test
[ 6 59967 ] [ 3837888 factor-2s ] unit-test
[ 6 -59967 ] [ -3837888 factor-2s ] unit-test

View File

@ -1,9 +1,12 @@
! Copyright (C) 2004, 2007 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: math kernel math.constants math.private USING: math kernel math.constants math.private
math.libm combinators math.order ; math.libm combinators math.order sequences ;
IN: math.functions IN: math.functions
: >fraction ( a/b -- a b )
[ numerator ] [ denominator ] bi ; inline
<PRIVATE <PRIVATE
: (rect>) ( x y -- z ) : (rect>) ( x y -- z )
@ -30,14 +33,35 @@ M: real sqrt
2dup >r >r >r odd? r> call r> 2/ r> each-bit 2dup >r >r >r odd? r> call r> 2/ r> each-bit
] if ; inline recursive ] if ; inline recursive
: ^n ( z w -- z^w ) : map-bits ( n quot: ( ? -- obj ) -- seq )
1 swap [ accumulator [ each-bit ] dip ; inline
[ dupd * ] when >r sq r>
] each-bit nip ; inline : factor-2s ( n -- r s )
#! factor an integer into 2^r * s
dup 0 = [ 1 ] [
0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while
] if ; inline
<PRIVATE
GENERIC# ^n 1 ( z w -- z^w )
: (^n) 1 swap [ [ dupd * ] when [ sq ] dip ] each-bit nip ; inline
M: integer ^n
[ factor-2s ] dip [ (^n) ] keep rot * shift ;
M: ratio ^n
[ >fraction ] dip tuck [ ^n ] 2bi@ / ;
M: float ^n
(^n) ;
: integer^ ( x y -- z ) : integer^ ( x y -- z )
dup 0 > [ ^n ] [ neg ^n recip ] if ; inline dup 0 > [ ^n ] [ neg ^n recip ] if ; inline
PRIVATE>
: >rect ( z -- x y ) : >rect ( z -- x y )
[ real-part ] [ imaginary-part ] bi ; inline [ real-part ] [ imaginary-part ] bi ; inline
@ -52,6 +76,8 @@ M: real sqrt
: polar> ( abs arg -- z ) cis * ; inline : polar> ( abs arg -- z ) cis * ; inline
<PRIVATE
: ^mag ( w abs arg -- magnitude ) : ^mag ( w abs arg -- magnitude )
>r >r >float-rect swap r> swap fpow r> rot * fexp /f ; >r >r >float-rect swap r> swap fpow r> rot * fexp /f ;
inline inline
@ -68,6 +94,8 @@ M: real sqrt
: 0^ ( x -- z ) : 0^ ( x -- z )
dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline
PRIVATE>
: ^ ( x y -- z ) : ^ ( x y -- z )
{ {
{ [ over zero? ] [ nip 0^ ] } { [ over zero? ] [ nip 0^ ] }

View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax math math.private USING: help.markup help.syntax math math.private
math.ratios.private ; math.ratios.private math.functions ;
IN: math.ratios IN: math.ratios
ARTICLE: "rationals" "Rational numbers" ARTICLE: "rationals" "Rational numbers"

View File

@ -3,9 +3,6 @@
USING: accessors kernel kernel.private math math.functions math.private ; USING: accessors kernel kernel.private math math.functions math.private ;
IN: math.ratios IN: math.ratios
: >fraction ( a/b -- a b )
dup numerator swap denominator ; inline
: 2>fraction ( a/b c/d -- a c b d ) : 2>fraction ( a/b c/d -- a c b d )
[ >fraction ] bi@ swapd ; inline [ >fraction ] bi@ swapd ; inline

View File

@ -1,6 +1,6 @@
USING: prettyprint.backend prettyprint.config USING: prettyprint.backend prettyprint.config
prettyprint.sections prettyprint.private help.markup help.syntax prettyprint.sections prettyprint.private help.markup help.syntax
io kernel words definitions quotations strings ; io kernel words definitions quotations strings generic classes ;
IN: prettyprint IN: prettyprint
ARTICLE: "prettyprint-numbers" "Prettyprinting numbers" ARTICLE: "prettyprint-numbers" "Prettyprinting numbers"
@ -150,6 +150,8 @@ $nl
{ $subsection pprint-cell } { $subsection pprint-cell }
"Printing a definition (see " { $link "definitions" } "):" "Printing a definition (see " { $link "definitions" } "):"
{ $subsection see } { $subsection see }
"Printing the methods defined on a generic word or class (see " { $link "objects" } "):"
{ $subsection see-methods }
"More prettyprinter usage:" "More prettyprinter usage:"
{ $subsection "prettyprint-numbers" } { $subsection "prettyprint-numbers" }
{ $subsection "prettyprint-stacks" } { $subsection "prettyprint-stacks" }
@ -167,17 +169,26 @@ HELP: with-pprint
HELP: pprint HELP: pprint
{ $values { "obj" object } } { $values { "obj" object } }
{ $description "Prettyprints an object to " { $link output-stream } ". Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ; { $description "Prettyprints an object to " { $link output-stream } ". Output is influenced by many variables; see " { $link "prettyprint-variables" } "." }
{ $warning
"Unparsing a large object can take a long time and consume a lot of memory. If you need to print large objects, use " { $link pprint-short } " or set some " { $link "prettyprint-variables" } " to limit output size."
} ;
{ pprint pprint* with-pprint } related-words { pprint pprint* with-pprint } related-words
HELP: . HELP: .
{ $values { "obj" object } } { $values { "obj" object } }
{ $description "Prettyprints an object to " { $link output-stream } " with a trailing line break. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ; { $description "Prettyprints an object to " { $link output-stream } " with a trailing line break. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." }
{ $warning
"Printing a large object can take a long time and consume a lot of memory. If you need to print large objects, use " { $link short. } " or set some " { $link "prettyprint-variables" } " to limit output size."
} ;
HELP: unparse HELP: unparse
{ $values { "obj" object } { "str" "Factor source string" } } { $values { "obj" object } { "str" "Factor source string" } }
{ $description "Outputs a prettyprinted string representation of an object. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ; { $description "Outputs a prettyprinted string representation of an object. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." }
{ $warning
"Unparsing a large object can take a long time and consume a lot of memory. If you need to unparse large objects, use " { $link unparse-short } " or set some " { $link "prettyprint-variables" } " to limit output size."
} ;
HELP: pprint-short HELP: pprint-short
{ $values { "obj" object } } { $values { "obj" object } }
@ -240,6 +251,10 @@ HELP: see
{ $values { "defspec" "a definition specifier" } } { $values { "defspec" "a definition specifier" } }
{ $contract "Prettyprints a definition." } ; { $contract "Prettyprints a definition." } ;
HELP: see-methods
{ $values { "word" "a " { $link generic } " or a " { $link class } } }
{ $contract "Prettyprints the methods defined on a generic word or class." } ;
HELP: definer HELP: definer
{ $values { "defspec" "a definition specifier" } { "start" word } { "end" "a word or " { $link f } } } { $values { "defspec" "a definition specifier" } { "start" word } { "end" "a word or " { $link f } } }
{ $contract "Outputs the parsing words which delimit the definition." } { $contract "Outputs the parsing words which delimit the definition." }

View File

@ -1,10 +1,10 @@
USING: help.markup help.syntax words definitions ; USING: help.markup help.syntax words definitions prettyprint ;
IN: tools.crossref IN: tools.crossref
ARTICLE: "tools.crossref" "Cross-referencing tools" ARTICLE: "tools.crossref" "Cross-referencing tools"
{ $subsection usage. } { $subsection usage. }
{ $subsection apropos } { $subsection apropos }
{ $see-also "definitions" "words" } ; { $see-also "definitions" "words" see see-methods } ;
ABOUT: "tools.crossref" ABOUT: "tools.crossref"

View File

@ -50,7 +50,8 @@ M: listener-gadget tool-scroller
listener>> input>> interactor-busy? ; listener>> input>> interactor-busy? ;
: listener-input ( string -- ) : listener-input ( string -- )
get-workspace listener>> input>> set-editor-string ; get-workspace listener>> input>>
[ set-editor-string ] [ request-focus ] bi ;
: (call-listener) ( quot listener -- ) : (call-listener) ( quot listener -- )
input>> interactor-call ; input>> interactor-call ;

View File

@ -1,6 +1,6 @@
USING: help.markup help.syntax words classes classes.algebra USING: help.markup help.syntax words classes classes.algebra
definitions kernel alien sequences math quotations definitions kernel alien sequences math quotations
generic.standard generic.math combinators ; generic.standard generic.math combinators prettyprint ;
IN: generic IN: generic
ARTICLE: "method-order" "Method precedence" ARTICLE: "method-order" "Method precedence"
@ -46,7 +46,8 @@ $nl
"Low-level method constructor:" "Low-level method constructor:"
{ $subsection <method> } { $subsection <method> }
"A " { $emphasis "method specifier" } " refers to a method and implements the " { $link "definition-protocol" } ":" "A " { $emphasis "method specifier" } " refers to a method and implements the " { $link "definition-protocol" } ":"
{ $subsection method-spec } ; { $subsection method-spec }
{ $see-also see see-methods } ;
ARTICLE: "method-combination" "Custom method combination" ARTICLE: "method-combination" "Custom method combination"
"Abstractly, a generic word can be thought of as a big chain of type conditional tests applied to the top of the stack, with methods as the bodies of each test. The " { $emphasis "method combination" } " is this control flow glue between the set of methods, and several aspects of it can be customized:" "Abstractly, a generic word can be thought of as a big chain of type conditional tests applied to the top of the stack, with methods as the bodies of each test. The " { $emphasis "method combination" } " is this control flow glue between the set of methods, and several aspects of it can be customized:"

View File

@ -1,10 +1,12 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.order strings arrays vectors sequences USING: kernel math math.order strings arrays vectors sequences
accessors ; sequences.private accessors ;
IN: grouping IN: grouping
TUPLE: abstract-groups { seq read-only } { n read-only } ; <PRIVATE
TUPLE: chunking-seq { seq read-only } { n read-only } ;
: check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline : check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline
@ -13,55 +15,73 @@ TUPLE: abstract-groups { seq read-only } { n read-only } ;
GENERIC: group@ ( n groups -- from to seq ) GENERIC: group@ ( n groups -- from to seq )
M: abstract-groups nth group@ subseq ; M: chunking-seq set-nth group@ <slice> 0 swap copy ;
M: abstract-groups set-nth group@ <slice> 0 swap copy ; M: chunking-seq like drop { } like ;
M: abstract-groups like drop { } like ; INSTANCE: chunking-seq sequence
INSTANCE: abstract-groups sequence MIXIN: subseq-chunking
M: subseq-chunking nth group@ subseq ;
MIXIN: slice-chunking
M: slice-chunking nth group@ <slice> ;
M: slice-chunking nth-unsafe group@ slice boa ;
TUPLE: abstract-groups < chunking-seq ;
M: abstract-groups length
[ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
M: abstract-groups set-length
[ n>> * ] [ seq>> ] bi set-length ;
M: abstract-groups group@
[ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
TUPLE: abstract-clumps < chunking-seq ;
M: abstract-clumps length
[ seq>> length ] [ n>> ] bi - 1+ ;
M: abstract-clumps set-length
[ n>> + 1- ] [ seq>> ] bi set-length ;
M: abstract-clumps group@
[ n>> over + ] [ seq>> ] bi ;
PRIVATE>
TUPLE: groups < abstract-groups ; TUPLE: groups < abstract-groups ;
: <groups> ( seq n -- groups ) : <groups> ( seq n -- groups )
groups new-groups ; inline groups new-groups ; inline
M: groups length INSTANCE: groups subseq-chunking
[ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
M: groups set-length TUPLE: sliced-groups < abstract-groups ;
[ n>> * ] [ seq>> ] bi set-length ;
M: groups group@
[ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
TUPLE: sliced-groups < groups ;
: <sliced-groups> ( seq n -- groups ) : <sliced-groups> ( seq n -- groups )
sliced-groups new-groups ; inline sliced-groups new-groups ; inline
M: sliced-groups nth group@ <slice> ; INSTANCE: sliced-groups slice-chunking
TUPLE: clumps < abstract-groups ; TUPLE: clumps < abstract-clumps ;
: <clumps> ( seq n -- clumps ) : <clumps> ( seq n -- clumps )
clumps new-groups ; inline clumps new-groups ; inline
M: clumps length INSTANCE: clumps subseq-chunking
[ seq>> length ] [ n>> ] bi - 1+ ;
M: clumps set-length TUPLE: sliced-clumps < abstract-clumps ;
[ n>> + 1- ] [ seq>> ] bi set-length ;
M: clumps group@
[ n>> over + ] [ seq>> ] bi ;
TUPLE: sliced-clumps < clumps ;
: <sliced-clumps> ( seq n -- clumps ) : <sliced-clumps> ( seq n -- clumps )
sliced-clumps new-groups ; inline sliced-clumps new-groups ; inline
M: sliced-clumps nth group@ <slice> ; INSTANCE: sliced-clumps slice-chunking
: group ( seq n -- array ) <groups> { } like ; : group ( seq n -- array ) <groups> { } like ;

View File

@ -5,8 +5,10 @@ ABOUT: "io.encodings"
ARTICLE: "io.encodings" "I/O encodings" ARTICLE: "io.encodings" "I/O encodings"
"Bytes can't be understood in isolation as text. They must be interpreted under a certain encoding. Factor provides utilities for dealing with encoded text by declaring that a stream has a particular encoding, and utilities to encode and decode strings." "Bytes can't be understood in isolation as text. They must be interpreted under a certain encoding. Factor provides utilities for dealing with encoded text by declaring that a stream has a particular encoding, and utilities to encode and decode strings."
{ $subsection "encodings-constructors" }
{ $subsection "encodings-descriptors" } { $subsection "encodings-descriptors" }
{ $subsection "encodings-constructors" }
{ $subsection "io.encodings.string" }
"New types of encodings can be defined:"
{ $subsection "encodings-protocol" } ; { $subsection "encodings-protocol" } ;
ARTICLE: "encodings-constructors" "Manually constructing an encoded stream" ARTICLE: "encodings-constructors" "Manually constructing an encoded stream"

View File

@ -99,7 +99,10 @@ HELP: counter
HELP: with-scope HELP: with-scope
{ $values { "quot" quotation } } { $values { "quot" quotation } }
{ $description "Calls the quotation in a new namespace. Any variables set by the quotation are discarded when it returns." } ; { $description "Calls the quotation in a new namespace. Any variables set by the quotation are discarded when it returns." }
{ $examples
{ $example "USING: math namespaces prettyprint ;" "IN: scratchpad" "SYMBOL: x" "0 x set" "[ x [ 5 + ] change x get . ] with-scope x get ." "5\n0" }
} ;
HELP: with-variable HELP: with-variable
{ $values { "value" object } { "key" "a variable, by convention a symbol" } { "quot" quotation } } { $values { "value" object } { "key" "a variable, by convention a symbol" } { "quot" quotation } }

View File

@ -841,7 +841,8 @@ HELP: unclip
HELP: unclip-slice HELP: unclip-slice
{ $values { "seq" sequence } { "rest-slice" slice } { "first" object } } { $values { "seq" sequence } { "rest-slice" slice } { "first" object } }
{ $description "Outputs a tail sequence and the first element of " { $snippet "seq" } "; the tail sequence consists of all elements of " { $snippet "seq" } " but the first. Unlike " { $link unclip } ", this word does not make a copy of the input sequence, and runs in constant time." } ; { $description "Outputs a tail sequence and the first element of " { $snippet "seq" } "; the tail sequence consists of all elements of " { $snippet "seq" } " but the first. Unlike " { $link unclip } ", this word does not make a copy of the input sequence, and runs in constant time." }
{ $examples { $example "USING: math.order prettyprint sequences ;" "{ 3 -1 -10 5 7 } unclip-slice [ min ] reduce ." "-10" } } ;
HELP: unclip-last HELP: unclip-last
{ $values { "seq" sequence } { "butlast" sequence } { "last" object } } { $values { "seq" sequence } { "butlast" sequence } { "last" object } }

View File

@ -11,13 +11,6 @@ IN: math.miller-rabin
TUPLE: positive-even-expected n ; TUPLE: positive-even-expected n ;
: (factor-2s) ( r s -- r s )
dup even? [ -1 shift [ 1+ ] dip (factor-2s) ] when ;
: factor-2s ( n -- r s )
#! factor an integer into s * 2^r
0 swap (factor-2s) ;
:: (miller-rabin) ( n trials -- ? ) :: (miller-rabin) ( n trials -- ? )
[let | r [ n 1- factor-2s drop ] [let | r [ n 1- factor-2s drop ]
s [ n 1- factor-2s nip ] s [ n 1- factor-2s nip ]