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

Conflicts:
	basis/db/types/types.factor
db4
Doug Coleman 2008-12-17 21:07:42 -06:00
commit 4dd615fa9e
284 changed files with 820 additions and 765 deletions

View File

@ -1,26 +0,0 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel words help.markup help.syntax ;
IN: alias
HELP: ALIAS:
{ $syntax "ALIAS: new-word existing-word" }
{ $values { "new-word" word } { "existing-word" word } }
{ $description "Creates a " { $snippet "new" } " inlined word that calls the " { $snippet "existing" } " word." }
{ $examples
{ $example "USING: alias prettyprint sequences ;"
"IN: alias.test"
"ALIAS: sequence-nth nth"
"0 { 10 20 30 } sequence-nth ."
"10"
}
} ;
ARTICLE: "alias" "Word aliasing"
"The " { $vocab-link "alias" } " vocabulary implements a way to make many different names for the same word. Although creating new names for words is generally frowned upon, aliases are useful for the Win32 API and other cases where words need to be renamed for symmetry." $nl
"Make a new word that aliases another word:"
{ $subsection define-alias }
"Make an alias at parse-time:"
{ $subsection POSTPONE: ALIAS: } ;
ABOUT: "alias"

View File

@ -4,7 +4,7 @@ USING: accessors arrays alien alien.c-types alien.structs
alien.arrays alien.strings kernel math namespaces parser
sequences words quotations math.parser splitting grouping
effects assocs combinators lexer strings.parser alien.parser
fry ;
fry vocabs.parser ;
IN: alien.syntax
: DLL" lexer get skip-blank parse-string dlopen parsed ; parsing

View File

@ -1,11 +1,11 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors init namespaces words io kernel.private math
memory continuations kernel io.files io.pathnames io.backend
system parser vocabs sequences vocabs.loader combinators
splitting source-files strings definitions assocs
compiler.errors compiler.units math.parser generic sets
command-line ;
USING: accessors init namespaces words words.symbol io
kernel.private math memory continuations kernel io.files
io.pathnames io.backend system parser vocabs sequences
vocabs.loader combinators splitting source-files strings
definitions assocs compiler.errors compiler.units math.parser
generic sets command-line ;
IN: bootstrap.stage2
SYMBOL: core-bootstrap-time

View File

@ -17,20 +17,21 @@ M: cairo-surface-t dispose ( alien -- ) alien>> cairo_surface_destroy ;
[ cairo_status_to_string "Cairo error: " prepend throw ] if ;
SYMBOL: cairo
: cr ( -- cairo ) cairo get ;
: cr ( -- cairo ) cairo get ; inline
: (with-cairo) ( cairo-t quot -- )
>r alien>> cairo r> [ cr cairo_status check-cairo ]
compose with-variable ; inline
[ alien>> cairo ] dip
'[ @ cr cairo_status check-cairo ]
with-variable ; inline
: with-cairo ( cairo quot -- )
>r <cairo-t> r> [ (with-cairo) ] curry with-disposal ; inline
[ <cairo-t> ] dip '[ _ (with-cairo) ] with-disposal ; inline
: (with-surface) ( cairo-surface-t quot -- )
>r alien>> r> [ cairo_surface_status check-cairo ] bi ; inline
[ alien>> ] dip [ cairo_surface_status check-cairo ] bi ; inline
: with-surface ( cairo_surface quot -- )
>r <cairo-surface-t> r> [ (with-surface) ] curry with-disposal ; inline
[ <cairo-surface-t> ] dip '[ _ (with-surface) ] with-disposal ; inline
: with-cairo-from-surface ( cairo_surface quot -- )
'[ cairo_create _ with-cairo ] with-surface ; inline

View File

@ -37,7 +37,7 @@ TYPEDEF: void* cairo_pattern_t
TYPEDEF: void* cairo_destroy_func_t
: cairo-destroy-func ( quot -- callback )
>r "void" { "void*" } "cdecl" r> alien-callback ; inline
[ "void" { "void*" } "cdecl" ] dip alien-callback ; inline
! See cairo.h for details
C-STRUCT: cairo_user_data_key_t
@ -78,13 +78,11 @@ TYPEDEF: int cairo_content_t
TYPEDEF: void* cairo_write_func_t
: cairo-write-func ( quot -- callback )
>r "cairo_status_t" { "void*" "uchar*" "int" }
"cdecl" r> alien-callback ; inline
[ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
TYPEDEF: void* cairo_read_func_t
: cairo-read-func ( quot -- callback )
>r "cairo_status_t" { "void*" "uchar*" "int" }
"cdecl" r> alien-callback ; inline
[ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
! Functions for manipulating state objects
FUNCTION: cairo_t*

View File

@ -26,7 +26,7 @@ M: cairo-gadget draw-gadget*
[ dim>> ] [ render-cairo ] bi
origin get first2 glRasterPos2i
1.0 -1.0 glPixelZoom
>r first2 GL_BGRA GL_UNSIGNED_BYTE r>
[ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip
glDrawPixels ;
: copy-surface ( surface -- )

View File

@ -3,7 +3,7 @@
USING: kernel io io.binary io.files io.streams.byte-array math
math.functions math.parser namespaces splitting grouping strings
sequences byte-arrays locals sequences.private
io.encodings.binary symbols math.bitwise checksums
io.encodings.binary math.bitwise checksums
checksums.common checksums.stream ;
IN: checksums.md5

View File

@ -3,7 +3,7 @@
USING: arrays combinators kernel io io.encodings.binary io.files
io.streams.byte-array math.vectors strings sequences namespaces
make math parser sequences assocs grouping vectors io.binary
hashtables symbols math.bitwise checksums checksums.common
hashtables math.bitwise checksums checksums.common
checksums.stream ;
IN: checksums.sha1

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel splitting grouping math sequences namespaces make
io.binary symbols math.bitwise checksums checksums.common
io.binary math.bitwise checksums checksums.common
sbufs strings ;
IN: checksums.sha2

View File

@ -14,7 +14,7 @@ kernel.private math ;
[ ]
[ dup ]
[ swap ]
[ >r r> ]
[ [ ] dip ]
[ fixnum+ ]
[ fixnum+fast ]
[ 3 fixnum+fast ]

View File

@ -1,7 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: qualified words sequences kernel combinators
cpu.architecture
USING: words sequences kernel combinators cpu.architecture
compiler.cfg.hats
compiler.cfg.instructions
compiler.cfg.intrinsics.alien

View File

@ -249,7 +249,7 @@ SYMBOL: max-uses
] with-scope ;
: random-test ( num-intervals max-uses max-registers max-insns -- )
over >r random-live-intervals r> int-regs associate check-linear-scan ;
over [ random-live-intervals ] dip int-regs associate check-linear-scan ;
[ ] [ 30 2 1 60 random-test ] unit-test
[ ] [ 60 2 2 60 random-test ] unit-test

View File

@ -75,7 +75,7 @@ unit-test
-12 -13 [ [ 0 swap fixnum-fast ] bi@ ] compile-call
] unit-test
[ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-call ] unit-test
[ -1 2 ] [ 1 2 [ [ 0 swap fixnum- ] dip ] compile-call ] unit-test
[ 12 13 ] [
-12 -13 [ [ 0 swap fixnum- ] bi@ ] compile-call
@ -88,13 +88,13 @@ unit-test
! Test slow shuffles
[ 3 1 2 3 4 5 6 7 8 9 ] [
1 2 3 4 5 6 7 8 9
[ >r >r >r >r >r >r >r >r >r 3 r> r> r> r> r> r> r> r> r> ]
[ [ [ [ [ [ [ [ [ [ 3 ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ]
compile-call
] unit-test
[ 2 2 2 2 2 2 2 2 2 2 1 ] [
1 2
[ swap >r dup dup dup dup dup dup dup dup dup r> ] compile-call
[ swap [ dup dup dup dup dup dup dup dup dup ] dip ] compile-call
] unit-test
[ ] [ [ 9 [ ] times ] compile-call ] unit-test
@ -110,7 +110,7 @@ unit-test
float+ swap { [ "hey" ] [ "bye" ] } dispatch ;
: try-breaking-dispatch-2 ( -- ? )
1 1.0 2.5 try-breaking-dispatch "bye" = >r 3.5 = r> and ;
1 1.0 2.5 try-breaking-dispatch "bye" = [ 3.5 = ] dip and ;
[ t ] [
10000000 [ drop try-breaking-dispatch-2 ] all?
@ -131,10 +131,10 @@ unit-test
2dup 1 slot eq? [ 2drop ] [
2dup array-nth tombstone? [
[
[ array-nth ] 2keep >r 1 fixnum+fast r> array-nth
[ array-nth ] 2keep [ 1 fixnum+fast ] dip array-nth
pick 2dup hellish-bug-1 3drop
] 2keep
] unless >r 2 fixnum+fast r> hellish-bug-2
] unless [ 2 fixnum+fast ] dip hellish-bug-2
] if ; inline recursive
: hellish-bug-3 ( hash array -- )
@ -159,9 +159,9 @@ TUPLE: my-tuple ;
[ 5 ] [ "hi" foox ] unit-test
! Making sure we don't needlessly unbox/rebox
[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ >r eq? r> ] compile-call ] unit-test
[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ [ eq? ] dip ] compile-call ] unit-test
[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call >r eq? r> ] unit-test
[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call [ eq? ] dip ] unit-test
[ t ] [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-call nip eq? ] unit-test
@ -188,7 +188,7 @@ TUPLE: my-tuple ;
[ 2 1 ] [
2 1
[ 2dup fixnum< [ >r die r> ] when ] compile-call
[ 2dup fixnum< [ [ die ] dip ] when ] compile-call
] unit-test
! Regression

View File

@ -8,7 +8,7 @@ IN: compiler.tests
[ 3 ] [ 5 [ 2 [ - ] 2curry call ] compile-call ] unit-test
[ 3 ] [ 5 2 [ [ - ] 2curry call ] compile-call ] unit-test
[ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-call ] unit-test
[ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-call ] unit-test
[ 3 ] [ 5 2 [ [ - ] 2curry [ 9 ] dip call /i ] compile-call ] unit-test
[ -10 -20 ] [ 10 20 -1 [ [ * ] curry bi@ ] compile-call ] unit-test
@ -21,14 +21,14 @@ IN: compiler.tests
[ [ 6 2 + ] ]
[
2 5
[ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry ]
[ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry ]
compile-call >quotation
] unit-test
[ 8 ]
[
2 5
[ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry call ]
[ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry call ]
compile-call
] unit-test

View File

@ -248,12 +248,12 @@ USE: binary-search.private
: lift-loop-tail-test-1 ( a quot -- )
over even? [
[ >r 3 - r> call ] keep lift-loop-tail-test-1
[ [ 3 - ] dip call ] keep lift-loop-tail-test-1
] [
over 0 < [
2drop
] [
[ >r 2 - r> call ] keep lift-loop-tail-test-1
[ [ 2 - ] dip call ] keep lift-loop-tail-test-1
] if
] if ; inline
@ -290,7 +290,7 @@ HINTS: recursive-inline-hang-3 array ;
! Wow
: counter-example ( a b c d -- a' b' c' d' )
dup 0 > [ 1 - >r rot 2 * r> counter-example ] when ; inline
dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline
: counter-example' ( -- a' b' c' d' )
1 2 3.0 3 counter-example ;
@ -330,7 +330,7 @@ PREDICATE: list < improper-list
[ 0 5 ] [ 0 interval-inference-bug ] unit-test
: aggressive-flush-regression ( a -- b )
f over >r <array> drop r> 1 + ;
f over [ <array> drop ] dip 1 + ;
[ 1.0 aggressive-flush-regression drop ] must-fail

View File

@ -79,7 +79,7 @@ IN: compiler.tree.dead-code.tests
[ [ read drop 1 2 ] ] [ [ read [ 1 2 ] dip drop ] optimize-quot ] unit-test
[ [ over >r + r> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test
[ [ over [ + ] dip ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test
[ [ [ ] [ ] if ] ] [ [ [ 1 ] [ 2 ] if drop ] optimize-quot ] unit-test

View File

@ -4,7 +4,7 @@ USING: kernel assocs match fry accessors namespaces make effects
sequences sequences.private quotations generic macros arrays
prettyprint prettyprint.backend prettyprint.custom
prettyprint.sections math words combinators
combinators.short-circuit io sorting hints qualified
combinators.short-circuit io sorting hints
compiler.tree
compiler.tree.recursive
compiler.tree.normalization
@ -80,10 +80,12 @@ M: shuffle-node pprint* effect>> effect>string text ;
[ out-d>> length 1 = ]
} 1&& ;
SYMBOLS: >R R> ;
M: #shuffle node>quot
{
{ [ dup #>r? ] [ drop \ >r , ] }
{ [ dup #r>? ] [ drop \ r> , ] }
{ [ dup #>r? ] [ drop \ >R , ] }
{ [ dup #r>? ] [ drop \ R> , ] }
{
[ dup [ in-r>> empty? ] [ out-r>> empty? ] bi and ]
[

View File

@ -8,13 +8,13 @@ compiler.tree.debugger ;
: test-modular-arithmetic ( quot -- quot' )
build-tree optimize-tree nodes>quot ;
[ [ >r >fixnum r> >fixnum fixnum+fast ] ]
[ [ [ >fixnum ] dip >fixnum fixnum+fast ] ]
[ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
[ [ +-integer-integer dup >fixnum ] ]
[ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test
[ [ >r >fixnum r> >fixnum fixnum+fast 4 fixnum*fast ] ]
[ [ [ >fixnum ] dip >fixnum fixnum+fast 4 fixnum*fast ] ]
[ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test
TUPLE: declared-fixnum { x fixnum } ;

View File

@ -6,7 +6,7 @@ math.parser math.order layouts words sequences sequences.private
arrays assocs classes classes.algebra combinators generic.math
splitting fry locals classes.tuple alien.accessors
classes.tuple.private slots.private definitions strings.private
vectors hashtables
vectors hashtables generic
stack-checker.state
compiler.tree.comparisons
compiler.tree.propagation.info
@ -337,3 +337,12 @@ generic-comparison-ops [
bi
] [ 2drop object-info ] if
] "outputs" set-word-prop
\ equal? [
! If first input has a known type and second input is an
! object, we convert this to [ swap equal? ].
in-d>> first2 value-info class>> object class= [
value-info class>> \ equal? specific-method
[ swap equal? ] f ?
] [ drop f ] if
] "custom-inlining" set-word-prop

View File

@ -18,7 +18,7 @@ IN: compiler.tree.propagation.tests
[ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test
[ V{ fixnum } ] [ [ 1 >r r> ] final-classes ] unit-test
[ V{ fixnum } ] [ [ 1 [ ] dip ] final-classes ] unit-test
[ V{ fixnum object } ] [ [ 1 swap ] final-classes ] unit-test
@ -198,7 +198,7 @@ IN: compiler.tree.propagation.tests
[
{ fixnum byte-array } declare
[ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe
>r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift
[ [ 298 * ] dip 100 * - ] dip 208 * - 128 + -8 shift
255 min 0 max
] final-classes
] unit-test
@ -640,6 +640,10 @@ MIXIN: empty-mixin
[ { fixnum } declare log2 0 >= ] final-classes
] unit-test
[ V{ POSTPONE: f } ] [
[ { word object } declare equal? ] final-classes
] unit-test
! [ V{ string } ] [
! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
! ] unit-test

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: serialize sequences concurrency.messaging threads io
io.servers.connection io.encodings.binary
qualified arrays namespaces kernel accessors ;
arrays namespaces kernel accessors ;
FROM: io.sockets => host-name <inet> with-client ;
IN: concurrency.distributed

View File

@ -1,8 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel words ;
IN: constants
: CONSTANT:
CREATE scan-object [ ] curry (( -- value ))
define-inline ; parsing

View File

@ -302,9 +302,7 @@ big-endian on
4 ds-reg 0 STW
] f f f \ -rot define-sub-primitive
[ jit->r ] f f f \ >r define-sub-primitive
[ jit-r> ] f f f \ r> define-sub-primitive
[ jit->r ] f f f \ load-local define-sub-primitive
! Comparisons
: jit-compare ( insn -- )

View File

@ -50,8 +50,8 @@ M: x86.64 %prologue ( n -- )
M: stack-params %load-param-reg
drop
>r R11 swap param@ MOV
r> param@ R11 MOV ;
[ R11 swap param@ MOV ] dip
param@ R11 MOV ;
M: stack-params %save-param-reg
drop

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel words sequences lexer parser fry ;
USING: kernel words words.symbol sequences lexer parser fry ;
IN: cpu.x86.assembler.syntax
: define-register ( name num size -- )

View File

@ -319,9 +319,7 @@ big-endian off
ds-reg [] temp1 MOV
] f f f \ -rot define-sub-primitive
[ jit->r ] f f f \ >r define-sub-primitive
[ jit-r> ] f f f \ r> define-sub-primitive
[ jit->r ] f f f \ load-local define-sub-primitive
! Comparisons
: jit-compare ( insn -- )

View File

@ -43,7 +43,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
sqlite3_bind_parameter_index ;
: parameter-index ( handle name text -- handle name text )
>r dupd sqlite-bind-parameter-index r> ;
[ dupd sqlite-bind-parameter-index ] dip ;
: sqlite-bind-text ( handle index text -- )
utf8 encode dup length SQLITE_TRANSIENT

View File

@ -9,7 +9,7 @@ combinators generic.math classes.builtin classes compiler.units
generic.standard vocabs init kernel.private io.encodings
accessors math.order destructors source-files parser
classes.tuple.parser effects.parser lexer compiler.errors
generic.parser strings.parser ;
generic.parser strings.parser vocabs.parser ;
IN: debugger
GENERIC: error. ( error -- )

View File

@ -20,7 +20,7 @@ PROTOCOL: baz foo { bar 0 } { whoa 1 } ;
CONSULT: baz goodbye these>> ;
M: hello foo this>> ;
M: hello bar hello-test ;
M: hello whoa >r this>> r> + ;
M: hello whoa [ this>> ] dip + ;
GENERIC: bing ( c -- d )
PROTOCOL: bee bing ;

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors parser generic kernel classes classes.tuple
words slots assocs sequences arrays vectors definitions
math hashtables sets generalizations namespaces make ;
math hashtables sets generalizations namespaces make
words.symbol ;
IN: delegate
: protocol-words ( protocol -- words )

View File

@ -20,7 +20,7 @@ HELP: '[
{ $examples "See " { $link "fry.examples" } "." } ;
HELP: >r/r>-in-fry-error
{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to " { $link >r } " or " { $link r> } ". Explicit retain stack manipulation of this form does not work with fry; use " { $link dip } " instead." } ;
{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to retain stack manipulation primitives." } ;
ARTICLE: "fry.examples" "Examples of fried quotations"
"The easiest way to understand fried quotations is to look at some examples."

View File

@ -56,7 +56,7 @@ sequences eval accessors ;
3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
] unit-test
[ "USING: fry kernel ; f '[ >r _ r> ]" eval ]
[ "USING: fry kernel ; f '[ load-local _ ]" eval ]
[ error>> >r/r>-in-fry-error? ] must-fail-with
[ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [

View File

@ -25,7 +25,7 @@ M: >r/r>-in-fry-error summary
"Explicit retain stack manipulation is not permitted in fried quotations" ;
: check-fry ( quot -- quot )
dup { >r r> load-locals get-local drop-locals } intersect
dup { load-local load-locals get-local drop-locals } intersect
empty? [ >r/r>-in-fry-error ] unless ;
PREDICATE: fry-specifier < word { _ @ } memq? ;

View File

@ -3,7 +3,8 @@
USING: kernel quotations classes.tuple make combinators generic
words interpolate namespaces sequences io.streams.string fry
classes.mixin effects lexer parser classes.tuple.parser
effects.parser locals.types locals.parser locals.rewrite.closures ;
effects.parser locals.types locals.parser
locals.rewrite.closures vocabs.parser ;
IN: functors
: scan-param ( -- obj )

View File

@ -1,5 +1,5 @@
USING: assocs classes help.markup help.syntax kernel
quotations strings words furnace.auth.providers.db
quotations strings words words.symbol furnace.auth.providers.db
checksums.sha2 furnace.auth.providers math byte-arrays
http multiline ;
IN: furnace.auth

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel combinators assocs
namespaces sequences splitting words
fry urls multiline present qualified
fry urls multiline present
xml
xml.data
xml.entities
@ -32,7 +32,7 @@ IN: furnace.chloe-tags
[ [ "/" ?tail drop "/" ] dip present 3append ] when* ;
: a-url ( href rest query value-name -- url )
dup [ >r 3drop r> value ] [
dup [ [ 3drop ] dip value ] [
drop
<url>
swap parse-query-attr >>query

View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax urls http words kernel
furnace.sessions furnace.db ;
furnace.sessions furnace.db words.symbol ;
IN: furnace.conversations
HELP: <conversations>

View File

@ -1,4 +1,6 @@
USING: help.markup help.syntax io.streams.string quotations strings calendar serialize kernel furnace.db words kernel ;
USING: help.markup help.syntax io.streams.string quotations
strings calendar serialize kernel furnace.db words words.symbol
kernel ;
IN: furnace.sessions
HELP: <sessions>

View File

@ -20,7 +20,7 @@ ARTICLE: "grouping" "Groups and clumps"
{ $unchecked-example "dup n groups concat sequence= ." "t" }
}
{ "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:"
{ $unchecked-example "dup n clumps unclip-last >r [ first ] map r> append sequence= ." "t" }
{ $unchecked-example "dup n clumps unclip-last [ [ first ] map ] dip append sequence= ." "t" }
}
} ;

View File

@ -61,7 +61,7 @@ IN: heaps.tests
random-alist
<min-heap> [ heap-push-all ] keep
dup data>> clone swap
] keep 3 /i [ 2dup >r delete-random r> heap-delete ] times
] keep 3 /i [ 2dup [ delete-random ] dip heap-delete ] times
data>>
[ [ key>> ] map ] bi@
[ natural-sort ] bi@ ;

View File

@ -1,10 +1,11 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays io io.styles kernel namespaces make
parser prettyprint sequences words assocs definitions generic
quotations effects slots continuations classes.tuple debugger
combinators vocabs help.stylesheet help.topics help.crossref
help.markup sorting classes vocabs.loader ;
parser prettyprint sequences words words.symbol assocs
definitions generic quotations effects slots continuations
classes.tuple debugger combinators vocabs help.stylesheet
help.topics help.crossref help.markup sorting classes
vocabs.loader ;
IN: help
GENERIC: word-help* ( word -- content )

View File

@ -5,7 +5,8 @@ help.topics words strings classes tools.vocabs namespaces make
io io.streams.string prettyprint definitions arrays vectors
combinators combinators.short-circuit splitting debugger
hashtables sorting effects vocabs vocabs.loader assocs editors
continuations classes.predicate macros math sets eval ;
continuations classes.predicate macros math sets eval
vocabs.parser words.symbol ;
IN: help.lint
: check-example ( element -- )

View File

@ -3,8 +3,7 @@
USING: accessors arrays definitions generic io kernel assocs
hashtables namespaces make parser prettyprint sequences strings
io.styles vectors words math sorting splitting classes slots
vocabs help.stylesheet help.topics vocabs.loader alias
quotations ;
vocabs help.stylesheet help.topics vocabs.loader quotations ;
IN: help.markup
! Simple markup language.

View File

@ -1,7 +1,8 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel parser sequences words help
help.topics namespaces vocabs definitions compiler.units ;
help.topics namespaces vocabs definitions compiler.units
vocabs.parser ;
IN: help.syntax
: HELP:

View File

@ -3,7 +3,8 @@
USING: parser words definitions kernel sequences assocs arrays
kernel.private fry combinators accessors vectors strings sbufs
byte-arrays byte-vectors io.binary io.streams.string splitting
math generic generic.standard generic.standard.engines classes ;
math generic generic.standard generic.standard.engines classes
hashtables ;
IN: hints
GENERIC: specializer-predicate ( spec -- quot )
@ -50,14 +51,10 @@ M: object specializer-declaration class ;
] [ drop f ] if ;
: specialized-def ( word -- quot )
dup def>> swap {
{
[ dup "specializer" word-prop ]
[ "specializer" word-prop specialize-quot ]
}
{ [ dup standard-method? ] [ specialize-method ] }
[ drop ]
} cond ;
[ def>> ] keep
[ dup standard-method? [ specialize-method ] [ drop ] if ]
[ "specializer" word-prop [ specialize-quot ] when* ]
bi ;
: specialized-length ( specializer -- n )
dup [ array? ] all? [ first ] when length ;
@ -120,3 +117,7 @@ M: object specializer-declaration class ;
\ >le { { fixnum fixnum } { bignum fixnum } } "specializer" set-word-prop
\ >be { { bignum fixnum } { fixnum fixnum } } "specializer" set-word-prop
\ hashtable \ at* method { { fixnum hashtable } { word hashtable } } "specializer" set-word-prop
\ hashtable \ set-at method { { object fixnum object } { object word object } } "specializer" set-word-prop

View File

@ -3,7 +3,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: continuations sequences kernel namespaces debugger
combinators math quotations generic strings splitting
accessors assocs fry
accessors assocs fry vocabs.parser
parser lexer io io.files io.streams.string io.encodings.utf8
html.elements
html.templates ;

View File

@ -8,7 +8,7 @@ calendar.format present urls
io io.encodings io.encodings.iana io.encodings.binary
io.encodings.8-bit
unicode.case unicode.categories qualified
unicode.case unicode.categories
http.parsers ;

View File

@ -3,7 +3,7 @@
USING: alien alien.c-types alien.syntax generic assocs kernel
kernel.private math io.ports sequences strings sbufs threads
unix vectors io.buffers io.backend io.encodings math.parser
continuations system libc qualified namespaces make io.timeouts
continuations system libc namespaces make io.timeouts
io.encodings.utf8 destructors accessors summary combinators
locals unix.time fry io.backend.unix.multiplexers ;
QUALIFIED: io

View File

@ -3,7 +3,7 @@ continuations destructors io io.backend io.ports io.timeouts
io.backend.windows io.files.windows io.files.windows.nt io.files
io.pathnames io.buffers io.streams.c libc kernel math namespaces
sequences threads windows windows.errors windows.kernel32
strings splitting qualified ascii system accessors locals ;
strings splitting ascii system accessors locals ;
QUALIFIED: windows.winsock
IN: io.backend.windows.nt

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: math.parser arrays io.encodings sequences kernel assocs
hashtables io.encodings.ascii generic parser classes.tuple words
io io.files splitting namespaces math compiler.units accessors ;
words.symbol io io.files splitting namespaces math
compiler.units accessors ;
IN: io.encodings.8-bit
<PRIVATE

View File

@ -4,7 +4,7 @@ USING: alien.c-types io.binary io.backend io.files
io.files.types io.buffers io.encodings.utf16n io.ports
io.backend.windows kernel math splitting fry alien.strings
windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces make words symbols system
math.functions sequences namespaces make words system
destructors accessors math.bitwise continuations windows.errors
arrays byte-arrays generalizations ;
IN: io.files.windows

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: system kernel unix math sequences qualified
USING: system kernel unix math sequences
io.backend.unix io.ports specialized-arrays.int accessors ;
IN: io.pipes.unix
QUALIFIED: io.pipes

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel symbols namespaces continuations
USING: accessors kernel namespaces continuations
destructors io debugger io.sockets sequences summary calendar
delegate system vocabs.loader combinators present ;
IN: io.sockets.secure

View File

@ -6,7 +6,7 @@ sequences arrays io.encodings io.ports io.streams.duplex
io.encodings.ascii alien.strings io.binary accessors destructors
classes byte-arrays system combinators parser
alien.c-types math.parser splitting grouping math assocs summary
system vocabs.loader combinators present fry ;
system vocabs.loader combinators present fry vocabs.parser ;
IN: io.sockets
<< {

View File

@ -5,7 +5,7 @@ namespaces threads sequences byte-arrays io.ports
io.binary io.backend.unix io.streams.duplex
io.backend io.ports io.pathnames io.files.private
io.encodings.utf8 math.parser continuations libc combinators
system accessors qualified destructors unix locals init ;
system accessors destructors unix locals init ;
EXCLUDE: io => read write close ;
EXCLUDE: io.sockets => accept ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: lcs html.elements kernel qualified ;
USING: lcs html.elements kernel ;
FROM: accessors => item>> ;
FROM: io => write ;
FROM: sequences => each if-empty ;

View File

@ -5,7 +5,7 @@ IN: lcs
<PRIVATE
: levenshtein-step ( insert delete change same? -- next )
0 1 ? + >r [ 1+ ] bi@ r> min min ;
0 1 ? + [ [ 1+ ] bi@ ] dip min min ;
: lcs-step ( insert delete change same? -- next )
1 -1./0. ? + max max ; ! -1./0. is -inf (float)

View File

@ -4,7 +4,7 @@ USING: arrays hashtables io kernel math math.parser memory
namespaces parser lexer sequences strings io.styles
vectors words generic system combinators continuations debugger
definitions compiler.units accessors colors prettyprint fry
sets ;
sets vocabs.parser ;
IN: listener
GENERIC: stream-read-quot ( stream -- quot/f )

View File

@ -3,7 +3,7 @@
USING: accessors arrays combinators effects.parser
generic.parser kernel lexer locals.errors
locals.rewrite.closures locals.types make namespaces parser
quotations sequences splitting words ;
quotations sequences splitting words vocabs.parser ;
IN: locals.parser
: make-local ( name -- word )

View File

@ -30,7 +30,10 @@ M: local-writer localize
read-local-quot [ set-local-value ] append ;
M: def localize
local>> [ prefix ] [ local-reader? [ 1array >r ] [ >r ] ? ] bi ;
local>>
[ prefix ]
[ local-reader? [ 1array load-local ] [ load-local ] ? ]
bi ;
M: object localize 1quotation ;

View File

@ -101,7 +101,7 @@ M: hashtable rewrite-sugar* rewrite-element ;
M: wrapper rewrite-sugar* rewrite-element ;
M: word rewrite-sugar*
dup { >r r> load-locals get-local drop-locals } memq?
dup { load-locals get-local drop-locals } memq?
[ >r/r>-in-lambda-error ] [ call-next-method ] if ;
M: object rewrite-sugar* , ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: logging.analysis logging.server logging smtp kernel
io.files io.streams.string namespaces make alarms assocs
io.encodings.utf8 accessors calendar sequences qualified ;
io.encodings.utf8 accessors calendar sequences ;
QUALIFIED: io.sockets
IN: logging.insomniac

View File

@ -4,7 +4,7 @@ USING: logging.server sequences namespaces concurrency.messaging
words kernel arrays shuffle tools.annotations
prettyprint.config prettyprint debugger io.streams.string
splitting continuations effects generalizations parser strings
quotations fry symbols accessors ;
quotations fry accessors ;
IN: logging
SYMBOLS: DEBUG NOTICE WARNING ERROR CRITICAL ;

View File

@ -47,7 +47,7 @@ MACRO: match-cond ( assoc -- )
[ "Fall-through in match-cond" throw ]
[
first2
>r [ dupd match ] curry r>
[ [ dupd match ] curry ] dip
[ bind ] curry rot
[ ?if ] 2curry append
] reduce ;

View File

@ -97,7 +97,7 @@ IN: math.functions.tests
: verify-gcd ( a b -- ? )
2dup gcd
>r rot * swap rem r> = ;
[ rot * swap rem ] dip = ;
[ t ] [ 123 124 verify-gcd ] unit-test
[ t ] [ 50 120 verify-gcd ] unit-test

View File

@ -255,8 +255,7 @@ IN: math.intervals.tests
0 pick interval-contains? over first \ recip eq? and [
2drop t
] [
[ >r random-element ! dup .
r> first execute ] 2keep
[ [ random-element ] dip first execute ] 2keep
second execute interval-contains?
] if ;
@ -287,8 +286,7 @@ IN: math.intervals.tests
0 pick interval-contains? over first { / /i mod rem } member? and [
3drop t
] [
[ >r [ random-element ] bi@ ! 2dup . .
r> first execute ] 3keep
[ [ [ random-element ] bi@ ] dip first execute ] 3keep
second execute interval-contains?
] if ;
@ -304,7 +302,7 @@ IN: math.intervals.tests
: comparison-test ( -- ? )
random-interval random-interval random-comparison
[ >r [ random-element ] bi@ r> first execute ] 3keep
[ [ [ random-element ] bi@ ] dip first execute ] 3keep
second execute dup incomparable eq? [ 2drop t ] [ = ] if ;
[ t ] [ 40000 [ drop comparison-test ] all? ] unit-test

View File

@ -1,8 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators combinators.lib io locals kernel math
math.functions math.ranges namespaces random sequences
hashtables sets ;
USING: combinators io locals kernel math math.functions
math.ranges namespaces random sequences hashtables sets ;
IN: math.miller-rabin
: >even ( n -- int ) dup even? [ 1- ] unless ; foldable
@ -63,5 +62,7 @@ ERROR: too-few-primes ;
: unique-primes ( numbits n -- seq )
#! generate two primes
over 5 < [ too-few-primes ] when
[ [ drop random-prime ] with map ] [ all-unique? ] generate ;
swap
dup 5 < [ too-few-primes ] when
2dup [ random-prime ] curry replicate
dup all-unique? [ 2nip ] [ drop unique-primes ] if ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman, Michael Judge.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators kernel math math.analysis math.functions sequences
sequences.lib sorting ;
USING: arrays combinators kernel math math.analysis
math.functions math.order sequences sorting ;
IN: math.statistics
: mean ( seq -- n )
@ -20,6 +20,10 @@ IN: math.statistics
[ midpoint@ ] keep nth
] if ;
: minmax ( seq -- min max )
#! find the min and max of a seq in one pass
[ 1/0. -1/0. ] dip [ tuck [ min ] [ max ] 2bi* ] each ;
: range ( seq -- n )
minmax swap - ;

View File

@ -1,6 +1,6 @@
USING: alien alien.syntax alien.parser combinators
kernel parser sequences system words namespaces hashtables init
math arrays assocs continuations lexer fry locals ;
math arrays assocs continuations lexer fry locals vocabs.parser ;
IN: opengl.gl.extensions
ERROR: unknown-gl-platform ;

View File

@ -4,7 +4,7 @@
! This file is based on the gl.h that comes with xorg-x11 6.8.2
USING: alien alien.syntax combinators kernel parser sequences
system words opengl.gl.extensions alias constants ;
system words opengl.gl.extensions ;
IN: opengl.gl

View File

@ -115,7 +115,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
PREDICATE: gl-program < integer (gl-program?) ;
: <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
>r <vertex-shader> check-gl-shader
r> <fragment-shader> check-gl-shader
[ <vertex-shader> check-gl-shader ]
[ <fragment-shader> check-gl-shader ] bi*
2array <gl-program> check-gl-program ;

View File

@ -2,8 +2,7 @@
! Portions copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax combinators kernel system namespaces
assocs parser lexer sequences words quotations math.bitwise
alias constants ;
assocs parser lexer sequences words quotations math.bitwise ;
IN: openssl.libssl

View File

@ -1,6 +1,6 @@
! Copyback (C) 2008 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math qualified ;
USING: kernel accessors math ;
QUALIFIED: sequences
IN: persistent.deques
@ -14,7 +14,7 @@ C: <cons> cons
: each ( list quot: ( elt -- ) -- )
over
[ [ >r car>> r> call ] [ >r cdr>> r> ] 2bi each ]
[ [ [ car>> ] dip call ] [ [ cdr>> ] dip ] 2bi each ]
[ 2drop ] if ; inline recursive
: reduce ( list start quot -- end )
@ -27,7 +27,7 @@ C: <cons> cons
0 [ drop 1+ ] reduce ;
: cut ( list index -- back front-reversed )
f swap [ >r [ cdr>> ] [ car>> ] bi r> <cons> ] times ;
f swap [ [ [ cdr>> ] [ car>> ] bi ] dip <cons> ] times ;
: split-reverse ( list -- back-reversed front )
dup length 2/ cut [ reverse ] bi@ ;
@ -41,7 +41,7 @@ TUPLE: deque { front read-only } { back read-only } ;
[ back>> ] [ front>> ] bi deque boa ;
: flipped ( deque quot -- newdeque )
>r flip r> call flip ;
[ flip ] dip call flip ;
PRIVATE>
: deque-empty? ( deque -- ? )

View File

@ -32,7 +32,7 @@ PRIVATE>
[ >branch< swap remove-left -rot [ <branch> ] 2dip rot ] if ;
: both-with? ( obj a b quot -- ? )
swap >r with r> swap both? ; inline
swap [ with ] dip swap both? ; inline
GENERIC: sift-down ( value prio left right -- heap )

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