Merge branch 'master' of git://factorcode.org/git/factor
Conflicts: basis/db/types/types.factordb4
commit
4dd615fa9e
|
@ -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"
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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*
|
|
@ -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 -- )
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -14,7 +14,7 @@ kernel.private math ;
|
|||
[ ]
|
||||
[ dup ]
|
||||
[ swap ]
|
||||
[ >r r> ]
|
||||
[ [ ] dip ]
|
||||
[ fixnum+ ]
|
||||
[ fixnum+fast ]
|
||||
[ 3 fixnum+fast ]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ]
|
||||
[
|
||||
|
|
|
@ -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 } ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
|
@ -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 -- )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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 } } ] [
|
||||
|
|
|
@ -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? ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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>
|
||||
|
|
|
@ -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>
|
||||
|
|
|
@ -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" }
|
||||
}
|
||||
} ;
|
||||
|
||||
|
|
|
@ -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@ ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
<< {
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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* , ;
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
|
@ -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 - ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 -- ? )
|
||||
|
|
|
@ -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
Loading…
Reference in New Issue