diff --git a/basis/alias/alias-docs.factor b/basis/alias/alias-docs.factor deleted file mode 100644 index 3f2eee6460..0000000000 --- a/basis/alias/alias-docs.factor +++ /dev/null @@ -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" diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index 15d82884f9..a02d2f3cb4 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -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 diff --git a/extra/assoc-heaps/assoc-heaps-docs.factor b/basis/assoc-heaps/assoc-heaps-docs.factor similarity index 100% rename from extra/assoc-heaps/assoc-heaps-docs.factor rename to basis/assoc-heaps/assoc-heaps-docs.factor diff --git a/extra/assoc-heaps/assoc-heaps-tests.factor b/basis/assoc-heaps/assoc-heaps-tests.factor similarity index 100% rename from extra/assoc-heaps/assoc-heaps-tests.factor rename to basis/assoc-heaps/assoc-heaps-tests.factor diff --git a/extra/assoc-heaps/assoc-heaps.factor b/basis/assoc-heaps/assoc-heaps.factor similarity index 100% rename from extra/assoc-heaps/assoc-heaps.factor rename to basis/assoc-heaps/assoc-heaps.factor diff --git a/extra/assoc-heaps/authors.txt b/basis/assoc-heaps/authors.txt similarity index 100% rename from extra/assoc-heaps/authors.txt rename to basis/assoc-heaps/authors.txt diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor index d2b522581d..f0622726f5 100644 --- a/basis/bootstrap/stage2.factor +++ b/basis/bootstrap/stage2.factor @@ -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 diff --git a/extra/cairo/authors.txt b/basis/cairo/authors.txt similarity index 100% rename from extra/cairo/authors.txt rename to basis/cairo/authors.txt diff --git a/extra/cairo/cairo.factor b/basis/cairo/cairo.factor similarity index 71% rename from extra/cairo/cairo.factor rename to basis/cairo/cairo.factor index aa7d1159a6..da7f5a2f32 100755 --- a/extra/cairo/cairo.factor +++ b/basis/cairo/cairo.factor @@ -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 r> [ (with-cairo) ] curry with-disposal ; inline + [ ] 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 r> [ (with-surface) ] curry with-disposal ; inline + [ ] dip '[ _ (with-surface) ] with-disposal ; inline : with-cairo-from-surface ( cairo_surface quot -- ) '[ cairo_create _ with-cairo ] with-surface ; inline diff --git a/extra/cairo/ffi/ffi.factor b/basis/cairo/ffi/ffi.factor similarity index 99% rename from extra/cairo/ffi/ffi.factor rename to basis/cairo/ffi/ffi.factor index db18320fee..d29a3fb097 100644 --- a/extra/cairo/ffi/ffi.factor +++ b/basis/cairo/ffi/ffi.factor @@ -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* diff --git a/extra/cairo/gadgets/gadgets.factor b/basis/cairo/gadgets/gadgets.factor similarity index 95% rename from extra/cairo/gadgets/gadgets.factor rename to basis/cairo/gadgets/gadgets.factor index 8ed7a3c31b..131f7425c9 100644 --- a/extra/cairo/gadgets/gadgets.factor +++ b/basis/cairo/gadgets/gadgets.factor @@ -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 -- ) diff --git a/extra/cairo/summary.txt b/basis/cairo/summary.txt similarity index 100% rename from extra/cairo/summary.txt rename to basis/cairo/summary.txt diff --git a/extra/cairo/tags.txt b/basis/cairo/tags.txt similarity index 100% rename from extra/cairo/tags.txt rename to basis/cairo/tags.txt diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index d919b0e313..7931828217 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -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 diff --git a/basis/checksums/sha1/sha1.factor b/basis/checksums/sha1/sha1.factor index 6cdc9270aa..ede8a8f653 100644 --- a/basis/checksums/sha1/sha1.factor +++ b/basis/checksums/sha1/sha1.factor @@ -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 diff --git a/basis/checksums/sha2/sha2.factor b/basis/checksums/sha2/sha2.factor index beb657bd3e..898a695b34 100644 --- a/basis/checksums/sha2/sha2.factor +++ b/basis/checksums/sha2/sha2.factor @@ -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 diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index c3cce1425e..0b303a8a43 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -14,7 +14,7 @@ kernel.private math ; [ ] [ dup ] [ swap ] - [ >r r> ] + [ [ ] dip ] [ fixnum+ ] [ fixnum+fast ] [ 3 fixnum+fast ] diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 5f75330865..3d0a7bec9c 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -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 diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 948302c74b..7420b4fd17 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -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 diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index e743c8484b..3d17009e31 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -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 diff --git a/basis/compiler/tests/curry.factor b/basis/compiler/tests/curry.factor index ecc2d87b73..1857baf503 100644 --- a/basis/compiler/tests/curry.factor +++ b/basis/compiler/tests/curry.factor @@ -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 diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index fa6a3c7b21..bb1cb2eab5 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -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 drop r> 1 + ; + f over [ drop ] dip 1 + ; [ 1.0 aggressive-flush-regression drop ] must-fail diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor index b64e30d8f9..1e9e93fa7c 100644 --- a/basis/compiler/tree/dead-code/dead-code-tests.factor +++ b/basis/compiler/tree/dead-code/dead-code-tests.factor @@ -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 diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index e75e7f6046..9f2cc0536e 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -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 ] [ diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor index b535dfe39c..31c50587cf 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor +++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor @@ -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 } ; diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index 4d8d935477..d5aa5318a4 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -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 diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index d95245fe83..b9a88de34a 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -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 diff --git a/basis/concurrency/distributed/distributed.factor b/basis/concurrency/distributed/distributed.factor index 99ad239011..ca1c5762f6 100644 --- a/basis/concurrency/distributed/distributed.factor +++ b/basis/concurrency/distributed/distributed.factor @@ -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 with-client ; IN: concurrency.distributed diff --git a/basis/constants/constants.factor b/basis/constants/constants.factor deleted file mode 100644 index bd2b3f188f..0000000000 --- a/basis/constants/constants.factor +++ /dev/null @@ -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 diff --git a/basis/alias/authors.txt b/basis/cords/authors.txt similarity index 100% rename from basis/alias/authors.txt rename to basis/cords/authors.txt diff --git a/extra/cords/cords-tests.factor b/basis/cords/cords-tests.factor similarity index 100% rename from extra/cords/cords-tests.factor rename to basis/cords/cords-tests.factor diff --git a/extra/cords/cords.factor b/basis/cords/cords.factor similarity index 100% rename from extra/cords/cords.factor rename to basis/cords/cords.factor diff --git a/extra/cords/summary.txt b/basis/cords/summary.txt similarity index 100% rename from extra/cords/summary.txt rename to basis/cords/summary.txt diff --git a/extra/cords/tags.txt b/basis/cords/tags.txt similarity index 100% rename from extra/cords/tags.txt rename to basis/cords/tags.txt diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 445c7082bc..b27f3aee72 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -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 -- ) diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 841a4e4c55..e46c8f6914 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -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 diff --git a/basis/cpu/x86/assembler/syntax/syntax.factor b/basis/cpu/x86/assembler/syntax/syntax.factor index 6ddec4af07..343850f9e6 100644 --- a/basis/cpu/x86/assembler/syntax/syntax.factor +++ b/basis/cpu/x86/assembler/syntax/syntax.factor @@ -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 -- ) diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 26488b8d95..5e3405e93a 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -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 -- ) diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index d19af808a0..b1bc9aa1a2 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -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 diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 885e2e303c..1440e7ca5d 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -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 -- ) diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor index d1e7d31656..7d297af1ed 100644 --- a/basis/delegate/delegate-tests.factor +++ b/basis/delegate/delegate-tests.factor @@ -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 ; diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor index 57f9b35c96..4da2244114 100644 --- a/basis/delegate/delegate.factor +++ b/basis/delegate/delegate.factor @@ -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 ) diff --git a/extra/formatting/authors.txt b/basis/formatting/authors.txt similarity index 100% rename from extra/formatting/authors.txt rename to basis/formatting/authors.txt diff --git a/extra/formatting/formatting-docs.factor b/basis/formatting/formatting-docs.factor similarity index 100% rename from extra/formatting/formatting-docs.factor rename to basis/formatting/formatting-docs.factor diff --git a/extra/formatting/formatting-tests.factor b/basis/formatting/formatting-tests.factor similarity index 100% rename from extra/formatting/formatting-tests.factor rename to basis/formatting/formatting-tests.factor diff --git a/extra/formatting/formatting.factor b/basis/formatting/formatting.factor similarity index 100% rename from extra/formatting/formatting.factor rename to basis/formatting/formatting.factor diff --git a/extra/formatting/summary.txt b/basis/formatting/summary.txt similarity index 100% rename from extra/formatting/summary.txt rename to basis/formatting/summary.txt diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor index 1dff0942bd..d91f44aecb 100644 --- a/basis/fry/fry-docs.factor +++ b/basis/fry/fry-docs.factor @@ -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." diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor index 0137e8be22..ca0268ee70 100644 --- a/basis/fry/fry-tests.factor +++ b/basis/fry/fry-tests.factor @@ -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 } } ] [ diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor index f84ad233cd..e62a42749f 100644 --- a/basis/fry/fry.factor +++ b/basis/fry/fry.factor @@ -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? ; diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 2029c0cf25..28bedc8360 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -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 ) diff --git a/basis/furnace/auth/auth-docs.factor b/basis/furnace/auth/auth-docs.factor index e7e722344a..4a03d59581 100644 --- a/basis/furnace/auth/auth-docs.factor +++ b/basis/furnace/auth/auth-docs.factor @@ -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 diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor index 8ab70ded7b..1c320182bf 100644 --- a/basis/furnace/chloe-tags/chloe-tags.factor +++ b/basis/furnace/chloe-tags/chloe-tags.factor @@ -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 swap parse-query-attr >>query diff --git a/basis/furnace/conversations/conversations-docs.factor b/basis/furnace/conversations/conversations-docs.factor index 4ad2c8a249..2b644ef422 100644 --- a/basis/furnace/conversations/conversations-docs.factor +++ b/basis/furnace/conversations/conversations-docs.factor @@ -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: diff --git a/basis/furnace/sessions/sessions-docs.factor b/basis/furnace/sessions/sessions-docs.factor index 959d6b69b8..7a4de18eaf 100644 --- a/basis/furnace/sessions/sessions-docs.factor +++ b/basis/furnace/sessions/sessions-docs.factor @@ -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: diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index 3b3a98eabd..e68c0ede1a 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -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" } } } ; diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor index e28eb3007a..8fa6a274e7 100644 --- a/basis/heaps/heaps-tests.factor +++ b/basis/heaps/heaps-tests.factor @@ -61,7 +61,7 @@ IN: heaps.tests random-alist [ 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@ ; diff --git a/basis/help/help.factor b/basis/help/help.factor index 5d12438e0d..cd80a73dad 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -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 ) diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor index d5729f218b..9d4de09a87 100644 --- a/basis/help/lint/lint.factor +++ b/basis/help/lint/lint.factor @@ -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 -- ) diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index a7501dc242..bf933cd9f1 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -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. diff --git a/basis/help/syntax/syntax.factor b/basis/help/syntax/syntax.factor index 9a372174ba..9f98ba6d8d 100644 --- a/basis/help/syntax/syntax.factor +++ b/basis/help/syntax/syntax.factor @@ -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: diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 240acf74b1..b6af773ce5 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -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 diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor index 7742ff9bc6..992b660070 100644 --- a/basis/html/templates/fhtml/fhtml.factor +++ b/basis/html/templates/fhtml/fhtml.factor @@ -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 ; diff --git a/basis/http/http.factor b/basis/http/http.factor index bbb0335ae4..0aeb771c11 100644 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -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 ; diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index e8ace90d73..e25550590f 100644 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -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 diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor index b8887debed..493a735f7f 100755 --- a/basis/io/backend/windows/nt/nt.factor +++ b/basis/io/backend/windows/nt/nt.factor @@ -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 diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor index 2cafb6be47..6ac0ed399e 100644 --- a/basis/io/encodings/8-bit/8-bit.factor +++ b/basis/io/encodings/8-bit/8-bit.factor @@ -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 read write close ; EXCLUDE: io.sockets => accept ; diff --git a/basis/lcs/diff2html/diff2html.factor b/basis/lcs/diff2html/diff2html.factor index b92eeb1250..ebbb0f3786 100644 --- a/basis/lcs/diff2html/diff2html.factor +++ b/basis/lcs/diff2html/diff2html.factor @@ -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 ; diff --git a/basis/lcs/lcs.factor b/basis/lcs/lcs.factor index 759e923a34..8c67590697 100644 --- a/basis/lcs/lcs.factor +++ b/basis/lcs/lcs.factor @@ -5,7 +5,7 @@ IN: lcs 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) diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor index f60403055e..88a90b72e2 100644 --- a/basis/listener/listener.factor +++ b/basis/listener/listener.factor @@ -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 ) diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index e6ab6c003c..c5b34556bc 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -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 ) diff --git a/basis/locals/rewrite/point-free/point-free.factor b/basis/locals/rewrite/point-free/point-free.factor index bd322bfff3..33e0f4d3b3 100644 --- a/basis/locals/rewrite/point-free/point-free.factor +++ b/basis/locals/rewrite/point-free/point-free.factor @@ -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 ; diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor index 05b1e2345e..835fa6e421 100644 --- a/basis/locals/rewrite/sugar/sugar.factor +++ b/basis/locals/rewrite/sugar/sugar.factor @@ -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* , ; diff --git a/basis/logging/insomniac/insomniac.factor b/basis/logging/insomniac/insomniac.factor index 7c1db5b7c0..91baae631f 100644 --- a/basis/logging/insomniac/insomniac.factor +++ b/basis/logging/insomniac/insomniac.factor @@ -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 diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 47de880559..fb6b328990 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -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 ; diff --git a/basis/match/match.factor b/basis/match/match.factor index 7d393dadc9..fee06686b8 100644 --- a/basis/match/match.factor +++ b/basis/match/match.factor @@ -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 ; diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index a06a67e4a1..cf0ce5f0bb 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -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 diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor index 8c29171a57..378ca2fb4b 100644 --- a/basis/math/intervals/intervals-tests.factor +++ b/basis/math/intervals/intervals-tests.factor @@ -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 diff --git a/extra/math/miller-rabin/authors.txt b/basis/math/miller-rabin/authors.txt similarity index 100% rename from extra/math/miller-rabin/authors.txt rename to basis/math/miller-rabin/authors.txt diff --git a/extra/math/miller-rabin/miller-rabin-tests.factor b/basis/math/miller-rabin/miller-rabin-tests.factor similarity index 100% rename from extra/math/miller-rabin/miller-rabin-tests.factor rename to basis/math/miller-rabin/miller-rabin-tests.factor diff --git a/extra/math/miller-rabin/miller-rabin.factor b/basis/math/miller-rabin/miller-rabin.factor similarity index 87% rename from extra/math/miller-rabin/miller-rabin.factor rename to basis/math/miller-rabin/miller-rabin.factor index def8a04738..afaa66e68f 100755 --- a/extra/math/miller-rabin/miller-rabin.factor +++ b/basis/math/miller-rabin/miller-rabin.factor @@ -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 ; diff --git a/extra/math/miller-rabin/summary.txt b/basis/math/miller-rabin/summary.txt similarity index 100% rename from extra/math/miller-rabin/summary.txt rename to basis/math/miller-rabin/summary.txt diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index d2494ee32a..09caebcf07 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -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 - ; diff --git a/basis/opengl/gl/extensions/extensions.factor b/basis/opengl/gl/extensions/extensions.factor index ea37829d0e..fb2ddfaf3e 100644 --- a/basis/opengl/gl/extensions/extensions.factor +++ b/basis/opengl/gl/extensions/extensions.factor @@ -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 ; diff --git a/basis/opengl/gl/gl.factor b/basis/opengl/gl/gl.factor index a7337da353..c32f62bf33 100644 --- a/basis/opengl/gl/gl.factor +++ b/basis/opengl/gl/gl.factor @@ -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 diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index 5b63b63afe..eb5bbb0ee8 100755 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -115,7 +115,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; PREDICATE: gl-program < integer (gl-program?) ; : ( vertex-shader-source fragment-shader-source -- program ) - >r check-gl-shader - r> check-gl-shader + [ check-gl-shader ] + [ check-gl-shader ] bi* 2array check-gl-program ; diff --git a/basis/openssl/libssl/libssl.factor b/basis/openssl/libssl/libssl.factor index b8f897463a..e512e3134c 100644 --- a/basis/openssl/libssl/libssl.factor +++ b/basis/openssl/libssl/libssl.factor @@ -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 diff --git a/extra/pack/authors.txt b/basis/pack/authors.txt similarity index 100% rename from extra/pack/authors.txt rename to basis/pack/authors.txt diff --git a/extra/pack/pack-tests.factor b/basis/pack/pack-tests.factor similarity index 100% rename from extra/pack/pack-tests.factor rename to basis/pack/pack-tests.factor diff --git a/extra/pack/pack.factor b/basis/pack/pack.factor similarity index 100% rename from extra/pack/pack.factor rename to basis/pack/pack.factor diff --git a/basis/persistent/deques/deques.factor b/basis/persistent/deques/deques.factor index 83c4a196d9..be63d807b9 100644 --- a/basis/persistent/deques/deques.factor +++ b/basis/persistent/deques/deques.factor @@ -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 : 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 0 [ drop 1+ ] reduce ; : cut ( list index -- back front-reversed ) - f swap [ >r [ cdr>> ] [ car>> ] bi r> ] times ; + f swap [ [ [ cdr>> ] [ car>> ] bi ] dip ] 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 -- ? ) diff --git a/basis/persistent/heaps/heaps.factor b/basis/persistent/heaps/heaps.factor index 6381b91dc3..f6d38b5b25 100644 --- a/basis/persistent/heaps/heaps.factor +++ b/basis/persistent/heaps/heaps.factor @@ -32,7 +32,7 @@ PRIVATE> [ >branch< swap remove-left -rot [ ] 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 ) diff --git a/extra/cords/authors.txt b/basis/porter-stemmer/authors.txt similarity index 100% rename from extra/cords/authors.txt rename to basis/porter-stemmer/authors.txt diff --git a/extra/porter-stemmer/porter-stemmer-docs.factor b/basis/porter-stemmer/porter-stemmer-docs.factor similarity index 100% rename from extra/porter-stemmer/porter-stemmer-docs.factor rename to basis/porter-stemmer/porter-stemmer-docs.factor diff --git a/extra/porter-stemmer/porter-stemmer-tests.factor b/basis/porter-stemmer/porter-stemmer-tests.factor similarity index 100% rename from extra/porter-stemmer/porter-stemmer-tests.factor rename to basis/porter-stemmer/porter-stemmer-tests.factor diff --git a/extra/porter-stemmer/porter-stemmer.factor b/basis/porter-stemmer/porter-stemmer.factor similarity index 100% rename from extra/porter-stemmer/porter-stemmer.factor rename to basis/porter-stemmer/porter-stemmer.factor diff --git a/extra/porter-stemmer/summary.txt b/basis/porter-stemmer/summary.txt similarity index 100% rename from extra/porter-stemmer/summary.txt rename to basis/porter-stemmer/summary.txt diff --git a/extra/porter-stemmer/test/output.txt b/basis/porter-stemmer/test/output.txt similarity index 100% rename from extra/porter-stemmer/test/output.txt rename to basis/porter-stemmer/test/output.txt diff --git a/extra/porter-stemmer/test/voc.txt b/basis/porter-stemmer/test/voc.txt similarity index 100% rename from extra/porter-stemmer/test/voc.txt rename to basis/porter-stemmer/test/voc.txt diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index 6b49c4a35a..b3800babe8 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -2,13 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays generic generic.standard assocs io kernel math namespaces make sequences strings io.styles io.streams.string -vectors words prettyprint.backend prettyprint.custom +vectors words words.symbol prettyprint.backend prettyprint.custom prettyprint.sections prettyprint.config sorting splitting grouping math.parser vocabs definitions effects classes.builtin classes.tuple io.pathnames classes continuations hashtables classes.mixin classes.union classes.intersection classes.predicate classes.singleton combinators quotations sets -accessors colors parser summary ; +accessors colors parser summary vocabs.parser ; IN: prettyprint : make-pprint ( obj quot -- block in use ) @@ -357,12 +357,12 @@ M: builtin-class see-class* ] when drop ; M: word see - dup see-class - dup class? over symbol? not and [ - nl - ] when - dup [ class? ] [ symbol? ] bi and - [ drop ] [ call-next-method ] if ; + [ see-class ] + [ [ class? ] [ symbol? not ] bi and [ nl ] when ] + [ + dup [ class? ] [ symbol? ] bi and + [ drop ] [ call-next-method ] if + ] tri ; : see-all ( seq -- ) natural-sort [ nl ] [ see ] interleave ; diff --git a/basis/qualified/authors.txt b/basis/qualified/authors.txt deleted file mode 100644 index f990dd0ed2..0000000000 --- a/basis/qualified/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Daniel Ehrenberg diff --git a/basis/qualified/qualified-docs.factor b/basis/qualified/qualified-docs.factor deleted file mode 100644 index 828d811b46..0000000000 --- a/basis/qualified/qualified-docs.factor +++ /dev/null @@ -1,55 +0,0 @@ -USING: help.markup help.syntax ; -IN: qualified - -HELP: QUALIFIED: -{ $syntax "QUALIFIED: vocab" } -{ $description "Similar to " { $link POSTPONE: USE: } " but loads vocabulary with prefix." } -{ $examples { $example - "USING: prettyprint qualified ;" - "QUALIFIED: math" - "1 2 math:+ ." "3" -} } ; - -HELP: QUALIFIED-WITH: -{ $syntax "QUALIFIED-WITH: vocab word-prefix" } -{ $description "Works like " { $link POSTPONE: QUALIFIED: } " but uses " { $snippet "word-prefix" } " as prefix." } -{ $examples { $code - "USING: prettyprint qualified ;" - "QUALIFIED-WITH: math m" - "1 2 m:+ ." - "3" -} } ; - -HELP: FROM: -{ $syntax "FROM: vocab => words ... ;" } -{ $description "Imports " { $snippet "words" } " from " { $snippet "vocab" } "." } -{ $examples { $code - "FROM: math.parser => bin> hex> ; ! imports only bin> and hex>" } } ; - -HELP: EXCLUDE: -{ $syntax "EXCLUDE: vocab => words ... ;" } -{ $description "Imports everything from " { $snippet "vocab" } " excluding " { $snippet "words" } "." } -{ $examples { $code - "EXCLUDE: math.parser => bin> hex> ; ! imports everything but bin> and hex>" } } ; - -HELP: RENAME: -{ $syntax "RENAME: word vocab => newname " } -{ $description "Imports " { $snippet "word" } " from " { $snippet "vocab" } ", but renamed to " { $snippet "newname" } "." } -{ $examples { $example - "USING: prettyprint qualified ;" - "RENAME: + math => -" - "2 3 - ." - "5" -} } ; - -ARTICLE: "qualified" "Qualified word lookup" -"The " { $vocab-link "qualified" } " vocabulary provides a handful of parsing words which give more control over word lookup than is offered by " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } "." -$nl -"These words are useful when there is no way to avoid using two vocabularies with identical word names in the same source file." -{ $subsection POSTPONE: QUALIFIED: } -{ $subsection POSTPONE: QUALIFIED-WITH: } -{ $subsection POSTPONE: FROM: } -{ $subsection POSTPONE: EXCLUDE: } -{ $subsection POSTPONE: RENAME: } ; - -ABOUT: "qualified" diff --git a/basis/qualified/qualified-tests.factor b/basis/qualified/qualified-tests.factor deleted file mode 100644 index 78efec4861..0000000000 --- a/basis/qualified/qualified-tests.factor +++ /dev/null @@ -1,33 +0,0 @@ -USING: tools.test qualified eval accessors parser ; -IN: qualified.tests.foo -: x 1 ; -: y 5 ; -IN: qualified.tests.bar -: x 2 ; -: y 4 ; -IN: qualified.tests.baz -: x 3 ; - -QUALIFIED: qualified.tests.foo -QUALIFIED: qualified.tests.bar -[ 1 2 3 ] [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test - -QUALIFIED-WITH: qualified.tests.bar p -[ 2 ] [ p:x ] unit-test - -RENAME: x qualified.tests.baz => y -[ 3 ] [ y ] unit-test - -FROM: qualified.tests.baz => x ; -[ 3 ] [ x ] unit-test -[ 3 ] [ y ] unit-test - -EXCLUDE: qualified.tests.bar => x ; -[ 3 ] [ x ] unit-test -[ 4 ] [ y ] unit-test - -[ "USE: qualified IN: qualified.tests FROM: qualified.tests => doesnotexist ;" eval ] -[ error>> no-word-error? ] must-fail-with - -[ "USE: qualified IN: qualified.tests RENAME: doesnotexist qualified.tests => blah" eval ] -[ error>> no-word-error? ] must-fail-with diff --git a/basis/qualified/qualified.factor b/basis/qualified/qualified.factor deleted file mode 100644 index 2cd64e90bf..0000000000 --- a/basis/qualified/qualified.factor +++ /dev/null @@ -1,43 +0,0 @@ -! Copyright (C) 2007, 2008 Daniel Ehrenberg. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences assocs hashtables parser lexer -vocabs words namespaces vocabs.loader sets fry ; -IN: qualified - -: define-qualified ( vocab-name prefix-name -- ) - [ load-vocab vocab-words ] [ CHAR: : suffix ] bi* - '[ [ [ _ ] dip append ] dip ] assoc-map - use get push ; - -: QUALIFIED: - #! Syntax: QUALIFIED: vocab - scan dup define-qualified ; parsing - -: QUALIFIED-WITH: - #! Syntax: QUALIFIED-WITH: vocab prefix - scan scan define-qualified ; parsing - -: partial-vocab ( words vocab -- assoc ) - '[ dup _ lookup [ no-word-error ] unless* ] - { } map>assoc ; - -: FROM: - #! Syntax: FROM: vocab => words... ; - scan dup load-vocab drop "=>" expect - ";" parse-tokens swap partial-vocab use get push ; parsing - -: partial-vocab-excluding ( words vocab -- assoc ) - [ load-vocab vocab-words keys swap diff ] keep partial-vocab ; - -: EXCLUDE: - #! Syntax: EXCLUDE: vocab => words ... ; - scan "=>" expect - ";" parse-tokens swap partial-vocab-excluding use get push ; parsing - -: RENAME: - #! Syntax: RENAME: word vocab => newname - scan scan dup load-vocab drop - dupd lookup [ ] [ no-word-error ] ?if - "=>" expect - scan associate use get push ; parsing - diff --git a/basis/qualified/summary.txt b/basis/qualified/summary.txt deleted file mode 100644 index 94b44c6052..0000000000 --- a/basis/qualified/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Qualified naming for vocabularies diff --git a/basis/qualified/tags.txt b/basis/qualified/tags.txt deleted file mode 100644 index f4274299b1..0000000000 --- a/basis/qualified/tags.txt +++ /dev/null @@ -1 +0,0 @@ -extensions diff --git a/basis/regexp/classes/classes.factor b/basis/regexp/classes/classes.factor index eec0d309b1..4a807fa51b 100644 --- a/basis/regexp/classes/classes.factor +++ b/basis/regexp/classes/classes.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel math math.order symbols -words regexp.utils unicode.categories combinators.short-circuit ; +USING: accessors kernel math math.order words regexp.utils +unicode.categories combinators.short-circuit ; IN: regexp.classes SINGLETONS: any-char any-char-no-nl diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index 4d8f3ddfbc..25509ec798 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators io io.streams.string -kernel math math.parser namespaces qualified sets -quotations sequences splitting symbols vectors math.order +kernel math math.parser namespaces sets +quotations sequences splitting vectors math.order unicode.categories strings regexp.backend regexp.utils unicode.case words locals regexp.classes ; IN: regexp.parser diff --git a/extra/roman/authors.txt b/basis/roman/authors.txt similarity index 100% rename from extra/roman/authors.txt rename to basis/roman/authors.txt diff --git a/extra/roman/roman-docs.factor b/basis/roman/roman-docs.factor similarity index 100% rename from extra/roman/roman-docs.factor rename to basis/roman/roman-docs.factor diff --git a/extra/roman/roman-tests.factor b/basis/roman/roman-tests.factor similarity index 100% rename from extra/roman/roman-tests.factor rename to basis/roman/roman-tests.factor diff --git a/extra/roman/roman.factor b/basis/roman/roman.factor similarity index 96% rename from extra/roman/roman.factor rename to basis/roman/roman.factor index 978587c685..866ac92872 100644 --- a/extra/roman/roman.factor +++ b/basis/roman/roman.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs kernel math math.order math.vectors -namespaces make quotations sequences sequences.lib +namespaces make quotations sequences splitting.monotonic sequences.private strings unicode.case lexer parser ; IN: roman diff --git a/extra/roman/summary.txt b/basis/roman/summary.txt similarity index 100% rename from extra/roman/summary.txt rename to basis/roman/summary.txt diff --git a/extra/roman/tags.txt b/basis/roman/tags.txt similarity index 100% rename from extra/roman/tags.txt rename to basis/roman/tags.txt diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor index f062548482..3ec1e96c72 100644 --- a/basis/serialize/serialize.factor +++ b/basis/serialize/serialize.factor @@ -70,9 +70,10 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ; } cond ; : serialize-shared ( obj quot -- ) - >r dup object-id - [ CHAR: o write1 serialize-cell drop ] - r> if* ; inline + [ + dup object-id + [ CHAR: o write1 serialize-cell drop ] + ] dip if* ; inline M: f (serialize) ( obj -- ) drop CHAR: n write1 ; @@ -256,7 +257,7 @@ SYMBOL: deserialized [ ] tri ; : copy-seq-to-tuple ( seq tuple -- ) - >r dup length r> [ set-array-nth ] curry 2each ; + [ dup length ] dip [ set-array-nth ] curry 2each ; : deserialize-tuple ( -- array ) #! Ugly because we have to intern the tuple before reading diff --git a/extra/soundex/author.txt b/basis/soundex/author.txt similarity index 100% rename from extra/soundex/author.txt rename to basis/soundex/author.txt diff --git a/extra/soundex/soundex-tests.factor b/basis/soundex/soundex-tests.factor similarity index 100% rename from extra/soundex/soundex-tests.factor rename to basis/soundex/soundex-tests.factor diff --git a/extra/soundex/soundex.factor b/basis/soundex/soundex.factor similarity index 100% rename from extra/soundex/soundex.factor rename to basis/soundex/soundex.factor diff --git a/extra/soundex/summary.txt b/basis/soundex/summary.txt similarity index 100% rename from extra/soundex/summary.txt rename to basis/soundex/summary.txt diff --git a/basis/symbols/authors.txt b/basis/splitting/monotonic/authors.txt similarity index 50% rename from basis/symbols/authors.txt rename to basis/splitting/monotonic/authors.txt index f372b574ae..7c1b2f2279 100644 --- a/basis/symbols/authors.txt +++ b/basis/splitting/monotonic/authors.txt @@ -1,2 +1 @@ -Slava Pestov Doug Coleman diff --git a/basis/splitting/monotonic/monotonic-tests.factor b/basis/splitting/monotonic/monotonic-tests.factor new file mode 100644 index 0000000000..ab4c48b292 --- /dev/null +++ b/basis/splitting/monotonic/monotonic-tests.factor @@ -0,0 +1,8 @@ +IN: splitting.monotonic +USING: tools.test math arrays kernel sequences ; + +[ { { 1 } { -1 5 } { 2 4 } } ] +[ { 1 -1 5 2 4 } [ < ] monotonic-split [ >array ] map ] unit-test +[ { { 1 1 1 1 } { 2 2 } { 3 } { 4 } { 5 } { 6 6 6 } } ] +[ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split [ >array ] map ] unit-test + diff --git a/basis/splitting/monotonic/monotonic.factor b/basis/splitting/monotonic/monotonic.factor new file mode 100644 index 0000000000..5bc7a51522 --- /dev/null +++ b/basis/splitting/monotonic/monotonic.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: make namespaces sequences kernel fry ; +IN: splitting.monotonic + +: ,, ( obj -- ) building get peek push ; +: v, ( -- ) V{ } clone , ; +: ,v ( -- ) building get dup peek empty? [ dup pop* ] when drop ; + +: (monotonic-split) ( seq quot -- newseq ) + [ + [ dup unclip suffix ] dip + v, '[ over ,, @ [ v, ] unless ] 2each ,v + ] { } make ; inline + +: monotonic-split ( seq quot -- newseq ) + over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline diff --git a/basis/splitting/monotonic/summary.txt b/basis/splitting/monotonic/summary.txt new file mode 100644 index 0000000000..6782bd0010 --- /dev/null +++ b/basis/splitting/monotonic/summary.txt @@ -0,0 +1 @@ +Split a sequence into monotonically-increasing subsequences diff --git a/basis/splitting/monotonic/tags.txt b/basis/splitting/monotonic/tags.txt new file mode 100644 index 0000000000..d4c087751e --- /dev/null +++ b/basis/splitting/monotonic/tags.txt @@ -0,0 +1,2 @@ +algorithms +sequences diff --git a/basis/stack-checker/errors/errors-docs.factor b/basis/stack-checker/errors/errors-docs.factor index d4a074031d..c3b9797a36 100644 --- a/basis/stack-checker/errors/errors-docs.factor +++ b/basis/stack-checker/errors/errors-docs.factor @@ -28,22 +28,10 @@ $nl } ; HELP: too-many->r -{ $error-description "Thrown if inference notices a quotation pushing elements on the retain stack without popping them at the end." } -{ $examples - { $code - ": too-many->r-example ( a b -- )" - " >r 3 + >r ;" - } -} ; +{ $error-description "Thrown if inference notices a quotation pushing elements on the retain stack without popping them at the end." } ; HELP: too-many-r> -{ $error-description "Thrown if inference notices a quotation popping elements from the return stack it did not place there." } -{ $examples - { $code - ": too-many-r>-example ( a b -- )" - " r> 3 + >r ;" - } -} ; +{ $error-description "Thrown if inference notices a quotation popping elements from the return stack it did not place there." } ; HELP: missing-effect { $error-description "Thrown when inference encounters a word lacking a stack effect declaration. Stack effects of words must be declared, with the exception of words which only push literals on the stack." } diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index bce42f1456..3836fadeb7 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -174,8 +174,6 @@ M: object infer-call* : infer-special ( word -- ) { - { \ >r [ 1 infer->r ] } - { \ r> [ 1 infer-r> ] } { \ declare [ infer-declare ] } { \ call [ infer-call ] } { \ (call) [ infer-call ] } @@ -194,6 +192,7 @@ M: object infer-call* { \ [ infer- ] } { \ (throw) [ infer-(throw) ] } { \ exit [ infer-exit ] } + { \ load-local [ 1 infer->r ] } { \ load-locals [ infer-load-locals ] } { \ get-local [ infer-get-local ] } { \ drop-locals [ infer-drop-locals ] } @@ -213,9 +212,9 @@ M: object infer-call* "local-word-def" word-prop infer-quot-here ; { - >r r> declare call (call) slip 2slip 3slip dip 2dip 3dip + declare call (call) slip 2slip 3slip dip 2dip 3dip curry compose execute (execute) if dispatch - (throw) load-locals get-local drop-locals do-primitive + (throw) load-local load-locals get-local drop-locals do-primitive alien-invoke alien-indirect alien-callback } [ t "special" set-word-prop ] each diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index defcde53f0..8dd07b9619 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -218,7 +218,7 @@ DEFER: do-crap* MATH: xyz ( a b -- c ) M: fixnum xyz 2array ; M: float xyz - [ 3 ] bi@ swapd >r 2array swap r> 2array swap ; + [ 3 ] bi@ swapd [ 2array swap ] dip 2array swap ; [ [ xyz ] infer ] [ inference-error? ] must-fail-with @@ -480,7 +480,7 @@ DEFER: an-inline-word dup [ normal-word-2 ] when ; : an-inline-word ( obj quot -- ) - >r normal-word r> call ; inline + [ normal-word ] dip call ; inline { 1 1 } [ [ 3 * ] an-inline-word ] must-infer-as @@ -503,7 +503,7 @@ ERROR: custom-error ; ] unit-test [ T{ effect f 1 1 t } ] [ - [ dup >r 3 throw r> ] infer + [ dup [ 3 throw ] dip ] infer ] unit-test ! This was a false trigger of the undecidable quotation @@ -511,7 +511,7 @@ ERROR: custom-error ; { 2 1 } [ find-last-sep ] must-infer-as ! Regression -: missing->r-check >r ; +: missing->r-check 1 load-locals ; [ [ missing->r-check ] infer ] must-fail @@ -548,7 +548,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ; [ [ inference-invalidation-d ] infer ] must-fail -: bad-recursion-3 ( -- ) dup [ >r bad-recursion-3 r> ] when ; inline +: bad-recursion-3 ( -- ) dup [ [ bad-recursion-3 ] dip ] when ; inline [ [ bad-recursion-3 ] infer ] must-fail : bad-recursion-4 ( -- ) 4 [ dup call roll ] times ; inline @@ -572,7 +572,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ; DEFER: eee' : ddd' ( ? -- ) [ f eee' ] when ; inline recursive -: eee' ( ? -- ) >r swap [ ] r> ddd' call ; inline recursive +: eee' ( ? -- ) [ swap [ ] ] dip ddd' call ; inline recursive [ [ eee' ] infer ] [ inference-error? ] must-fail-with diff --git a/basis/symbols/summary.txt b/basis/symbols/summary.txt deleted file mode 100644 index 3093468c50..0000000000 --- a/basis/symbols/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Utility for defining multiple symbols at a time diff --git a/basis/symbols/symbols-docs.factor b/basis/symbols/symbols-docs.factor deleted file mode 100644 index 9f79b71365..0000000000 --- a/basis/symbols/symbols-docs.factor +++ /dev/null @@ -1,9 +0,0 @@ -USING: help.markup help.syntax ; -IN: symbols - -HELP: SYMBOLS: -{ $syntax "SYMBOLS: words... ;" } -{ $values { "words" "a sequence of new words to define" } } -{ $description "Creates a new word for every token until the ';'." } -{ $examples { $example "USING: prettyprint symbols ;" "IN: scratchpad" "SYMBOLS: foo bar baz ;\nfoo . bar . baz ." "foo\nbar\nbaz" } } -{ $see-also POSTPONE: SYMBOL: } ; diff --git a/basis/symbols/symbols-tests.factor b/basis/symbols/symbols-tests.factor deleted file mode 100644 index 274c4de85b..0000000000 --- a/basis/symbols/symbols-tests.factor +++ /dev/null @@ -1,21 +0,0 @@ -USING: kernel symbols tools.test parser generic words accessors -eval ; -IN: symbols.tests - -[ ] [ SYMBOLS: a b c ; ] unit-test -[ a ] [ a ] unit-test -[ b ] [ b ] unit-test -[ c ] [ c ] unit-test - -DEFER: blah - -[ ] [ "IN: symbols.tests GENERIC: blah" eval ] unit-test -[ ] [ "IN: symbols.tests USE: symbols SYMBOLS: blah ;" eval ] unit-test - -[ f ] [ \ blah generic? ] unit-test -[ t ] [ \ blah symbol? ] unit-test - -[ "IN: symbols.tests USE: symbols SINGLETONS: blah blah blah ;" eval ] -[ error>> error>> def>> \ blah eq? ] -must-fail-with - diff --git a/basis/symbols/symbols.factor b/basis/symbols/symbols.factor deleted file mode 100644 index 6cf8eac6fb..0000000000 --- a/basis/symbols/symbols.factor +++ /dev/null @@ -1,15 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: parser lexer sequences words kernel classes.singleton -classes.parser ; -IN: symbols - -: SYMBOLS: - ";" parse-tokens - [ create-in dup reset-generic define-symbol ] each ; - parsing - -: SINGLETONS: - ";" parse-tokens - [ create-class-in define-singleton-class ] each ; - parsing diff --git a/basis/symbols/tags.txt b/basis/symbols/tags.txt deleted file mode 100644 index f4274299b1..0000000000 --- a/basis/symbols/tags.txt +++ /dev/null @@ -1 +0,0 @@ -extensions diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor index 10e1566290..1dcc6fe4c1 100644 --- a/basis/tools/deploy/macosx/macosx.factor +++ b/basis/tools/deploy/macosx/macosx.factor @@ -5,7 +5,7 @@ io.directories io.directories.hierarchy kernel namespaces make sequences system tools.deploy.backend tools.deploy.config tools.deploy.config.editor assocs hashtables prettyprint io.backend.unix cocoa io.encodings.utf8 io.backend -cocoa.application cocoa.classes cocoa.plists qualified +cocoa.application cocoa.classes cocoa.plists combinators ; IN: tools.deploy.macosx diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 135679444b..c894a8931b 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors qualified io.backend io.streams.c init fry +USING: accessors io.backend io.streams.c init fry namespaces make assocs kernel parser lexer strings.parser vocabs sequences words words.private memory kernel.private continuations io vocabs.loader system strings sets diff --git a/basis/tools/disassembler/gdb/gdb.factor b/basis/tools/disassembler/gdb/gdb.factor index e97cc203a2..9076b67606 100755 --- a/basis/tools/disassembler/gdb/gdb.factor +++ b/basis/tools/disassembler/gdb/gdb.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files io.files.temp io words alien kernel math.parser alien.syntax io.launcher system assocs arrays sequences -namespaces make qualified system math io.encodings.ascii +namespaces make system math io.encodings.ascii accessors tools.disassembler ; IN: tools.disassembler.gdb diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index 54882800b0..3670891e41 100755 --- a/basis/tools/files/files.factor +++ b/basis/tools/files/files.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators io io.files io.files.info io.directories kernel math.parser sequences system vocabs.loader -calendar math symbols fry prettyprint ; +calendar math fry prettyprint ; IN: tools.files > nth ] [ class>> ] bi prefix >tuple ; M: tuple-array set-nth ( elt n seq -- ) - >r >r tuple>array 1 tail r> r> seq>> set-nth ; + [ tuple>array 1 tail ] 2dip seq>> set-nth ; M: tuple-array new-sequence class>> ; diff --git a/basis/ui/gadgets/theme/theme.factor b/basis/ui/gadgets/theme/theme.factor index fa36e61d90..6ca3868d87 100644 --- a/basis/ui/gadgets/theme/theme.factor +++ b/basis/ui/gadgets/theme/theme.factor @@ -2,7 +2,7 @@ ! Copyright (C) 2006, 2007 Alex Chapman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel sequences io.styles ui.gadgets ui.render -colors colors.gray qualified accessors ; +colors colors.gray accessors ; QUALIFIED: colors IN: ui.gadgets.theme diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index 123a7620d1..b74a36bc0b 100644 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -3,7 +3,7 @@ USING: accessors arrays assocs kernel math math.order models namespaces make sequences words strings system hashtables math.parser math.vectors classes.tuple classes boxes calendar -alarms symbols combinators sets columns fry deques ui.gadgets ; +alarms combinators sets columns fry deques ui.gadgets ; IN: ui.gestures GENERIC: handle-gesture ( gesture gadget -- ? ) diff --git a/basis/ui/tools/interactor/interactor.factor b/basis/ui/tools/interactor/interactor.factor index 51425b124d..40da6ebafc 100644 --- a/basis/ui/tools/interactor/interactor.factor +++ b/basis/ui/tools/interactor/interactor.factor @@ -7,7 +7,7 @@ quotations sequences strings threads listener classes.tuple ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.status-bar ui.gadgets.presentations ui.gadgets.worlds ui.gestures definitions calendar concurrency.flags concurrency.mailboxes -ui.tools.workspace accessors sets destructors fry ; +ui.tools.workspace accessors sets destructors fry vocabs.parser ; IN: ui.tools.interactor ! If waiting is t, we're waiting for user input, and invoking diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor index 2297382a96..a9405424dc 100644 --- a/basis/ui/tools/operations/operations.factor +++ b/basis/ui/tools/operations/operations.factor @@ -8,7 +8,8 @@ io.styles kernel namespaces parser prettyprint quotations tools.annotations editors tools.profiler tools.test tools.time tools.walker ui.commands ui.gadgets.editors ui.gestures ui.operations ui.tools.deploy vocabs vocabs.loader words -sequences tools.vocabs classes compiler.units accessors ; +sequences tools.vocabs classes compiler.units accessors +vocabs.parser ; IN: ui.tools.operations V{ } clone operations set-global diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index d6bab73017..c22fcb6cbe 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -8,7 +8,7 @@ make sequences strings vectors words windows.kernel32 windows.gdi32 windows.user32 windows.opengl32 windows.messages windows.types windows.nt windows threads libc combinators fry combinators.short-circuit continuations command-line shuffle -opengl ui.render ascii math.bitwise locals symbols accessors +opengl ui.render ascii math.bitwise locals accessors math.geometry.rect math.order ascii calendar io.encodings.utf16n ; IN: ui.windows diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor index 96633198c0..666ebf2f18 100755 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -5,7 +5,7 @@ ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render ui.event-loop assocs kernel math namespaces opengl sequences strings x11.xlib x11.events x11.xim x11.glx x11.clipboard x11.constants x11.windows io.encodings.string io.encodings.ascii -io.encodings.utf8 combinators command-line qualified +io.encodings.utf8 combinators command-line math.vectors classes.tuple opengl.gl threads math.geometry.rect environment ascii ; IN: ui.x11 diff --git a/basis/unix/bsd/bsd.factor b/basis/unix/bsd/bsd.factor index 42f2a07e62..bb0f9b5201 100644 --- a/basis/unix/bsd/bsd.factor +++ b/basis/unix/bsd/bsd.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax combinators system vocabs.loader alias -constants ; +USING: alien.syntax combinators system vocabs.loader ; IN: unix CONSTANT: MAXPATHLEN 1024 diff --git a/basis/unix/bsd/freebsd/freebsd.factor b/basis/unix/bsd/freebsd/freebsd.factor index d58cfbb90d..4536c532bf 100644 --- a/basis/unix/bsd/freebsd/freebsd.factor +++ b/basis/unix/bsd/freebsd/freebsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax alias constants ; +USING: alien.syntax ; IN: unix : FD_SETSIZE 1024 ; diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/bsd/macosx/macosx.factor index f38707b456..32dd4d80d8 100644 --- a/basis/unix/bsd/macosx/macosx.factor +++ b/basis/unix/bsd/macosx/macosx.factor @@ -1,4 +1,4 @@ -USING: alien.syntax unix.time alias constants ; +USING: alien.syntax unix.time ; IN: unix CONSTANT: FD_SETSIZE 1024 diff --git a/basis/unix/bsd/netbsd/netbsd.factor b/basis/unix/bsd/netbsd/netbsd.factor index 8ca78c72a6..f124e7f998 100644 --- a/basis/unix/bsd/netbsd/netbsd.factor +++ b/basis/unix/bsd/netbsd/netbsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax alien.c-types math vocabs.loader constants alias ; +USING: alien.syntax alien.c-types math vocabs.loader ; IN: unix CONSTANT: FD_SETSIZE 256 diff --git a/basis/unix/bsd/openbsd/openbsd.factor b/basis/unix/bsd/openbsd/openbsd.factor index 4d40e9e502..e915b6ffcd 100644 --- a/basis/unix/bsd/openbsd/openbsd.factor +++ b/basis/unix/bsd/openbsd/openbsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax constants alias ; +USING: alien.syntax ; IN: unix CONSTANT: FD_SETSIZE 1024 diff --git a/basis/unix/getfsstat/freebsd/freebsd.factor b/basis/unix/getfsstat/freebsd/freebsd.factor index 0cc63229c4..44d85680a7 100644 --- a/basis/unix/getfsstat/freebsd/freebsd.factor +++ b/basis/unix/getfsstat/freebsd/freebsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.getfsstat.freebsd CONSTANT: MNT_WAIT 1 ! synchronously wait for I/O to complete diff --git a/basis/unix/getfsstat/macosx/macosx.factor b/basis/unix/getfsstat/macosx/macosx.factor index 23d9a14b9b..0db1bb86ad 100644 --- a/basis/unix/getfsstat/macosx/macosx.factor +++ b/basis/unix/getfsstat/macosx/macosx.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.getfsstat.macosx CONSTANT: MNT_WAIT 1 ! synchronously wait for I/O to complete diff --git a/basis/unix/getfsstat/netbsd/netbsd.factor b/basis/unix/getfsstat/netbsd/netbsd.factor index 18064822eb..1eca6d7dc3 100644 --- a/basis/unix/getfsstat/netbsd/netbsd.factor +++ b/basis/unix/getfsstat/netbsd/netbsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.getfsstat.netbsd CONSTANT: MNT_WAIT 1 ! synchronously wait for I/O to complete diff --git a/basis/unix/getfsstat/openbsd/openbsd.factor b/basis/unix/getfsstat/openbsd/openbsd.factor index 41adfeaacd..19465d8040 100644 --- a/basis/unix/getfsstat/openbsd/openbsd.factor +++ b/basis/unix/getfsstat/openbsd/openbsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.getfsstat.openbsd CONSTANT: MNT_WAIT 1 ! synchronously wait for I/O to complete diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index f6aa7fa3e9..60785a5b17 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.strings io.encodings.utf8 io.backend.unix kernel math sequences splitting unix strings -combinators.short-circuit byte-arrays combinators qualified +combinators.short-circuit byte-arrays combinators accessors math.parser fry assocs namespaces continuations unix.users unix.utilities ; IN: unix.groups diff --git a/basis/unix/kqueue/freebsd/freebsd.factor b/basis/unix/kqueue/freebsd/freebsd.factor index 4c90ef739e..1153b997c2 100644 --- a/basis/unix/kqueue/freebsd/freebsd.factor +++ b/basis/unix/kqueue/freebsd/freebsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.kqueue C-STRUCT: kevent diff --git a/basis/unix/kqueue/kqueue.factor b/basis/unix/kqueue/kqueue.factor index 0f75354589..6c3b9ef2cb 100644 --- a/basis/unix/kqueue/kqueue.factor +++ b/basis/unix/kqueue/kqueue.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax system sequences vocabs.loader words -accessors alias constants ; +accessors ; IN: unix.kqueue << "unix.kqueue." os name>> append require >> diff --git a/basis/unix/kqueue/macosx/macosx.factor b/basis/unix/kqueue/macosx/macosx.factor index 0bc6ce5785..843a0afad9 100644 --- a/basis/unix/kqueue/macosx/macosx.factor +++ b/basis/unix/kqueue/macosx/macosx.factor @@ -1,4 +1,4 @@ -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.kqueue C-STRUCT: kevent diff --git a/basis/unix/kqueue/netbsd/netbsd.factor b/basis/unix/kqueue/netbsd/netbsd.factor index 5e23626e1d..7ba942d712 100644 --- a/basis/unix/kqueue/netbsd/netbsd.factor +++ b/basis/unix/kqueue/netbsd/netbsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.kqueue C-STRUCT: kevent diff --git a/basis/unix/kqueue/openbsd/openbsd.factor b/basis/unix/kqueue/openbsd/openbsd.factor index fc2e7d20ca..c62ba05a4c 100644 --- a/basis/unix/kqueue/openbsd/openbsd.factor +++ b/basis/unix/kqueue/openbsd/openbsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.kqueue C-STRUCT: kevent diff --git a/basis/unix/linux/epoll/epoll.factor b/basis/unix/linux/epoll/epoll.factor index ebc3ab8bd1..7c68dfa45a 100644 --- a/basis/unix/linux/epoll/epoll.factor +++ b/basis/unix/linux/epoll/epoll.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: unix.linux.epoll -USING: alien.syntax math constants ; +USING: alien.syntax math ; FUNCTION: int epoll_create ( int size ) ; diff --git a/basis/unix/linux/inotify/inotify.factor b/basis/unix/linux/inotify/inotify.factor index 9084b41c50..e3d40b5b28 100644 --- a/basis/unix/linux/inotify/inotify.factor +++ b/basis/unix/linux/inotify/inotify.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax math math.bitwise constants ; +USING: alien.syntax math math.bitwise ; IN: unix.linux.inotify C-STRUCT: inotify-event diff --git a/basis/unix/linux/linux.factor b/basis/unix/linux/linux.factor index 61ced5c97b..0cf33be1bf 100644 --- a/basis/unix/linux/linux.factor +++ b/basis/unix/linux/linux.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax alias constants ; +USING: alien.syntax ; IN: unix ! Linux. diff --git a/basis/unix/process/process.factor b/basis/unix/process/process.factor index ec782f5164..6e83ea9a42 100644 --- a/basis/unix/process/process.factor +++ b/basis/unix/process/process.factor @@ -1,6 +1,6 @@ USING: kernel alien.c-types alien.strings sequences math alien.syntax unix vectors kernel namespaces continuations threads assocs vectors -io.backend.unix io.encodings.utf8 unix.utilities constants ; +io.backend.unix io.encodings.utf8 unix.utilities ; IN: unix.process ! Low-level Unix process launching utilities. These are used diff --git a/basis/unix/solaris/solaris.factor b/basis/unix/solaris/solaris.factor index fc7e152931..d91fbdfddc 100644 --- a/basis/unix/solaris/solaris.factor +++ b/basis/unix/solaris/solaris.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Patrick Mauritz. ! See http://factorcode.org/license.txt for BSD license. IN: unix -USING: alien.syntax system kernel layouts constants ; +USING: alien.syntax system kernel layouts ; ! Solaris. diff --git a/basis/unix/stat/stat.factor b/basis/unix/stat/stat.factor index 2164d89ac6..156be96190 100644 --- a/basis/unix/stat/stat.factor +++ b/basis/unix/stat/stat.factor @@ -1,5 +1,5 @@ USING: kernel system combinators alien.syntax alien.c-types -math io.backend.unix vocabs.loader unix constants ; +math io.backend.unix vocabs.loader unix ; IN: unix.stat ! File Types diff --git a/basis/unix/statfs/freebsd/freebsd.factor b/basis/unix/statfs/freebsd/freebsd.factor index 17b58aede6..e6a033e09d 100644 --- a/basis/unix/statfs/freebsd/freebsd.factor +++ b/basis/unix/statfs/freebsd/freebsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.statfs.freebsd CONSTANT: MFSNAMELEN 16 ! length of type name including null */ diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index 829a49c81f..f80eb29ccd 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -2,8 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types io.encodings.utf8 io.encodings.string kernel sequences unix.stat accessors unix combinators math -grouping system alien.strings math.bitwise alien.syntax -alias constants ; +grouping system alien.strings math.bitwise alien.syntax ; IN: unix.statfs.macosx CONSTANT: MNT_RDONLY HEX: 00000001 diff --git a/basis/unix/statfs/openbsd/openbsd.factor b/basis/unix/statfs/openbsd/openbsd.factor index d9e6b867b6..f495f2af4e 100644 --- a/basis/unix/statfs/openbsd/openbsd.factor +++ b/basis/unix/statfs/openbsd/openbsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.statfs.openbsd CONSTANT: MFSNAMELEN 16 diff --git a/basis/unix/statvfs/freebsd/freebsd.factor b/basis/unix/statvfs/freebsd/freebsd.factor index a2a3168464..3140b85004 100644 --- a/basis/unix/statvfs/freebsd/freebsd.factor +++ b/basis/unix/statvfs/freebsd/freebsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.statvfs.freebsd C-STRUCT: statvfs diff --git a/basis/unix/statvfs/linux/linux.factor b/basis/unix/statvfs/linux/linux.factor index 5c04468ad3..c92fef6aaa 100644 --- a/basis/unix/statvfs/linux/linux.factor +++ b/basis/unix/statvfs/linux/linux.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.statvfs.linux C-STRUCT: statvfs64 diff --git a/basis/unix/statvfs/macosx/macosx.factor b/basis/unix/statvfs/macosx/macosx.factor index fc85b9d9dc..0aafad69fa 100644 --- a/basis/unix/statvfs/macosx/macosx.factor +++ b/basis/unix/statvfs/macosx/macosx.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.statvfs.macosx C-STRUCT: statvfs diff --git a/basis/unix/statvfs/netbsd/netbsd.factor b/basis/unix/statvfs/netbsd/netbsd.factor index e3e54fb4e2..1adc1a3da8 100644 --- a/basis/unix/statvfs/netbsd/netbsd.factor +++ b/basis/unix/statvfs/netbsd/netbsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.statvfs.netbsd CONSTANT: _VFS_NAMELEN 32 diff --git a/basis/unix/statvfs/openbsd/openbsd.factor b/basis/unix/statvfs/openbsd/openbsd.factor index 76c2af9127..4ca8d0749d 100644 --- a/basis/unix/statvfs/openbsd/openbsd.factor +++ b/basis/unix/statvfs/openbsd/openbsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax constants ; +USING: alien.syntax ; IN: unix.statvfs.openbsd C-STRUCT: statvfs diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index c0e496a041..52e7473800 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax kernel libc sequences continuations byte-arrays strings math namespaces -system combinators vocabs.loader qualified accessors +system combinators vocabs.loader accessors stack-checker macros locals generalizations unix.types -io vocabs vocabs.loader constants ; +io vocabs vocabs.loader ; IN: unix CONSTANT: PROT_NONE 0 diff --git a/basis/unix/utmpx/utmpx.factor b/basis/unix/utmpx/utmpx.factor index 30dac2de1f..6b70ceee2e 100644 --- a/basis/unix/utmpx/utmpx.factor +++ b/basis/unix/utmpx/utmpx.factor @@ -3,7 +3,7 @@ USING: alien.c-types alien.syntax combinators continuations io.encodings.string io.encodings.utf8 kernel sequences strings unix calendar system accessors unix.time calendar.unix -vocabs.loader constants ; +vocabs.loader ; IN: unix.utmpx CONSTANT: EMPTY 0 diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor index 7c41d3efdb..78e01fdaf7 100644 --- a/basis/validators/validators.factor +++ b/basis/validators/validators.factor @@ -51,7 +51,7 @@ IN: validators ] if ; : v-regexp ( str what regexp -- str ) - >r over r> matches? + [ over ] dip matches? [ drop ] [ "invalid " prepend throw ] if ; : v-email ( str -- str ) diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor index 0d95c06a87..f76e389dce 100644 --- a/basis/windows/advapi32/advapi32.factor +++ b/basis/windows/advapi32/advapi32.factor @@ -1,5 +1,4 @@ -USING: alias alien.syntax kernel math windows.types math.bitwise -constants ; +USING: alien.syntax kernel math windows.types math.bitwise ; IN: windows.advapi32 LIBRARY: advapi32 diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index e3bec6d7ac..0e9a03f075 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -1,6 +1,6 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces -combinators sequences symbols fry math accessors macros words quotations +combinators sequences fry math accessors macros words quotations libc continuations generalizations splitting locals assocs init struct-arrays ; IN: windows.dinput.constants diff --git a/basis/windows/dinput/dinput.factor b/basis/windows/dinput/dinput.factor index 76cba4ff36..1cd22beb75 100755 --- a/basis/windows/dinput/dinput.factor +++ b/basis/windows/dinput/dinput.factor @@ -1,6 +1,5 @@ USING: windows.kernel32 windows.ole32 windows.com windows.com.syntax -alien alien.c-types alien.syntax kernel system namespaces math constants -alias ; +alien alien.c-types alien.syntax kernel system namespaces math ; IN: windows.dinput << diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor index 8384bb1acc..4543aa703a 100644 --- a/basis/windows/dragdrop-listener/dragdrop-listener.factor +++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor @@ -36,26 +36,30 @@ SYMBOL: +listener-dragdrop-wrapper+ { { "IDropTarget" { [ ! DragEnter - >r 2drop - filenames-from-data-object - length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if - dup 0 r> set-ulong-nth + [ + 2drop + filenames-from-data-object + length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if + dup 0 + ] dip set-ulong-nth >>last-drop-effect drop S_OK ] [ ! DragOver - >r 2drop last-drop-effect>> 0 r> set-ulong-nth + [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth S_OK ] [ ! DragLeave drop S_OK ] [ ! Drop - >r 2drop nip - filenames-from-data-object - dup length 1 = [ - first unparse [ "USE: parser " % % " run-file" % ] "" make - eval-listener - DROPEFFECT_COPY - ] [ 2drop DROPEFFECT_NONE ] if - 0 r> set-ulong-nth + [ + 2drop nip + filenames-from-data-object + dup length 1 = [ + first unparse [ "USE: parser " % % " run-file" % ] "" make + eval-listener + DROPEFFECT_COPY + ] [ 2drop DROPEFFECT_NONE ] if + 0 + ] dip set-ulong-nth S_OK ] } } diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 7c19cbde53..56bba768de 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -1,4 +1,3 @@ -USING: kernel constants ; IN: windows.errors CONSTANT: ERROR_SUCCESS 0 diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor index 9c16664de8..077adf1961 100755 --- a/basis/windows/gdi32/gdi32.factor +++ b/basis/windows/gdi32/gdi32.factor @@ -1,7 +1,7 @@ ! FUNCTION: AbortDoc ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.syntax kernel windows.types alias constants ; +USING: alien alien.syntax kernel windows.types ; IN: windows.gdi32 ! Stock Logical Objects diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index cdfb31cbf7..c38b5f94ca 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.syntax kernel windows.types alias constants ; +USING: alien alien.syntax kernel windows.types ; IN: windows.kernel32 CONSTANT: MAX_PATH 260 @@ -987,8 +987,6 @@ FUNCTION: DWORD GetFileType ( HANDLE hFile ) ; FUNCTION: DWORD GetFullPathNameW ( LPCTSTR lpFileName, DWORD nBufferLength, LPTSTR lpBuffer, LPTSTR* lpFilePart ) ; ALIAS: GetFullPathName GetFullPathNameW -! clear "license.txt" 32768 "char[32768]" f over >r GetFullPathName r> swap 2 * head >string . - ! FUNCTION: GetGeoInfoA ! FUNCTION: GetGeoInfoW ! FUNCTION: GetHandleContext diff --git a/basis/windows/messages/messages.factor b/basis/windows/messages/messages.factor index bb30968217..10e6cd43c5 100755 --- a/basis/windows/messages/messages.factor +++ b/basis/windows/messages/messages.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs hashtables kernel math namespaces words -windows.types vocabs sequences constants alias ; +windows.types vocabs sequences ; IN: windows.messages SYMBOL: windows-messages diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor index 1282d3b9a5..b8e6d2c2b0 100644 --- a/basis/windows/shell32/shell32.factor +++ b/basis/windows/shell32/shell32.factor @@ -3,7 +3,7 @@ USING: alien alien.c-types alien.strings alien.syntax combinators io.encodings.utf16n io.files io.pathnames kernel windows windows.com windows.com.syntax windows.ole32 -windows.user32 constants alias ; +windows.user32 ; IN: windows.shell32 CONSTANT: CSIDL_DESKTOP HEX: 00 diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor index 88c6d54f0a..e2e2c7e150 100644 --- a/basis/windows/user32/user32.factor +++ b/basis/windows/user32/user32.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.syntax parser namespaces kernel math -windows.types generalizations math.bitwise alias constants ; +windows.types generalizations math.bitwise ; IN: windows.user32 ! HKL for ActivateKeyboardLayout diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor index 5c70e82ea9..27069ed743 100644 --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -2,8 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.strings alien.syntax arrays byte-arrays kernel math sequences windows.types windows.kernel32 -windows.errors windows math.bitwise alias io.encodings.utf16n -alias constants ; +windows.errors windows math.bitwise io.encodings.utf16n ; IN: windows.winsock USE: libc diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor index 07872fe576..f86c24b845 100644 --- a/basis/x11/xlib/xlib.factor +++ b/basis/x11/xlib/xlib.factor @@ -13,7 +13,7 @@ USING: kernel arrays alien alien.c-types alien.strings alien.syntax math math.bitwise words sequences namespaces -continuations io io.encodings.ascii alias ; +continuations io io.encodings.ascii ; IN: x11.xlib LIBRARY: xlib diff --git a/basis/xml-rpc/example.factor b/basis/xml-rpc/example.factor index 836a85d52d..e2be36c450 100644 --- a/basis/xml-rpc/example.factor +++ b/basis/xml-rpc/example.factor @@ -10,7 +10,7 @@ USING: kernel hashtables xml-rpc xml calendar sequences { "divide" [ / ] } } ; : apply-function ( name args -- {number} ) - >r functions hash r> first2 rot call 1array ; + [ functions hash ] dip first2 rot call 1array ; : problem>solution ( xml-doc -- xml-doc ) receive-rpc dup rpc-method-name swap rpc-method-params diff --git a/basis/xml-rpc/xml-rpc.factor b/basis/xml-rpc/xml-rpc.factor index 9472f5e09d..602fb90172 100644 --- a/basis/xml-rpc/xml-rpc.factor +++ b/basis/xml-rpc/xml-rpc.factor @@ -55,7 +55,7 @@ M: base64 item>xml "params" build-tag* ; : method-call ( name seq -- xml ) - params >r "methodName" build-tag r> + params [ "methodName" build-tag ] dip 2array "methodCall" build-tag* build-xml ; : return-params ( seq -- xml ) @@ -117,7 +117,7 @@ TAG: boolean xml>item : unstruct-member ( tag -- ) children-tags first2 first-child-tag xml>item - >r children>string r> swap set ; + [ children>string ] dip swap set ; TAG: struct xml>item [ @@ -158,10 +158,10 @@ TAG: array xml>item : post-rpc ( rpc url -- rpc ) ! This needs to do something in the event of an error - >r send-rpc r> http-post nip string>xml receive-rpc ; + [ send-rpc ] dip http-post nip string>xml receive-rpc ; : invoke-method ( params method url -- ) - >r swap r> post-rpc ; + [ swap ] dip post-rpc ; : put-http-response ( string -- ) "HTTP/1.1 200 OK\nConnection: close\nContent-Length: " write diff --git a/basis/xmode/catalog/catalog.factor b/basis/xmode/catalog/catalog.factor index 16da4be1d3..f8f1788bcf 100644 --- a/basis/xmode/catalog/catalog.factor +++ b/basis/xmode/catalog/catalog.factor @@ -8,12 +8,13 @@ TUPLE: mode file file-name-glob first-line-glob ; r - mode new { - { "FILE" f (>>file) } - { "FILE_NAME_GLOB" f (>>file-name-glob) } - { "FIRST_LINE_GLOB" f (>>first-line-glob) } - } init-from-tag r> + "NAME" over at [ + mode new { + { "FILE" f (>>file) } + { "FILE_NAME_GLOB" f (>>file-name-glob) } + { "FIRST_LINE_GLOB" f (>>first-line-glob) } + } init-from-tag + ] dip rot set-at ; TAGS> @@ -56,7 +57,7 @@ SYMBOL: rule-sets [ get-rule-set nip swap (>>delegate) ] [ 2drop ] if ; : each-rule ( rule-set quot -- ) - >r rules>> values concat r> each ; inline + [ rules>> values concat ] dip each ; inline : resolve-delegates ( ruleset -- ) [ resolve-delegate ] each-rule ; @@ -65,8 +66,7 @@ SYMBOL: rule-sets over [ dupd update ] [ nip clone ] if ; : import-keywords ( parent child -- ) - over >r [ keywords>> ] bi@ ?update - r> (>>keywords) ; + over [ [ keywords>> ] bi@ ?update ] dip (>>keywords) ; : import-rules ( parent child -- ) swap [ add-rule ] curry each-rule ; @@ -115,5 +115,5 @@ ERROR: mutually-recursive-rulesets ruleset ; : find-mode ( file-name first-line -- mode ) modes - [ nip >r 2dup r> suitable-mode? ] assoc-find - 2drop >r 2drop r> [ "text" ] unless* ; + [ nip [ 2dup ] dip suitable-mode? ] assoc-find + 2drop [ 2drop ] dip [ "text" ] unless* ; diff --git a/basis/xmode/loader/syntax/syntax.factor b/basis/xmode/loader/syntax/syntax.factor index cbebe090c3..9b53000e02 100644 --- a/basis/xmode/loader/syntax/syntax.factor +++ b/basis/xmode/loader/syntax/syntax.factor @@ -101,4 +101,4 @@ TAGS> : init-eol-span-tag ( -- ) [ drop init-eol-span ] , ; : parse-keyword-tag ( tag keyword-map -- ) - >r dup main>> string>token swap children>string r> set-at ; + [ dup main>> string>token swap children>string ] dip set-at ; diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor index f777eaa18c..c37d60df14 100644 --- a/basis/xmode/marker/marker.factor +++ b/basis/xmode/marker/marker.factor @@ -69,7 +69,7 @@ M: string-matcher text-matches? ] keep string>> length and ; M: regexp text-matches? - >r >string r> match-head ; + [ >string ] dip match-head ; : rule-start-matches? ( rule -- match-count/f ) dup start>> tuck swap can-match-here? [ @@ -97,7 +97,7 @@ DEFER: get-rules f swap rules>> at ?push-all ; : get-char-rules ( vector/f char ruleset -- vector/f ) - >r ch>upper r> rules>> at ?push-all ; + [ ch>upper ] dip rules>> at ?push-all ; : get-rules ( char ruleset -- seq ) f -rot [ get-char-rules ] keep get-always-rules ; diff --git a/basis/xmode/marker/state/state.factor b/basis/xmode/marker/state/state.factor index 096230ff4e..44d3a0285e 100644 --- a/basis/xmode/marker/state/state.factor +++ b/basis/xmode/marker/state/state.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: xmode.marker.context xmode.rules symbols accessors +USING: xmode.marker.context xmode.rules accessors xmode.tokens namespaces make kernel sequences assocs math ; IN: xmode.marker.state @@ -20,14 +20,14 @@ SYMBOLS: line last-offset position context current-rule-set keywords>> ; : token, ( from to id -- ) - 2over = [ 3drop ] [ >r line get subseq r> , ] if ; + 2over = [ 3drop ] [ [ line get subseq ] dip , ] if ; : prev-token, ( id -- ) - >r last-offset get position get r> token, + [ last-offset get position get ] dip token, position get last-offset set ; : next-token, ( len id -- ) - >r position get 2dup + r> token, + [ position get 2dup + ] dip token, position get + dup 1- position set last-offset set ; : push-context ( rules -- ) diff --git a/basis/xmode/rules/rules.factor b/basis/xmode/rules/rules.factor index e4f12bcc49..adc43d7bb6 100644 --- a/basis/xmode/rules/rules.factor +++ b/basis/xmode/rules/rules.factor @@ -41,7 +41,7 @@ MEMO: standard-rule-set ( id -- ruleset ) : ?push-all ( seq1 seq2 -- seq1+seq2 ) [ - over [ >r V{ } like r> over push-all ] [ nip ] if + over [ [ V{ } like ] dip over push-all ] [ nip ] if ] when* ; : rule-set-no-word-sep* ( ruleset -- str ) @@ -107,8 +107,7 @@ M: regexp text-hash-char drop f ; text-hash-char [ suffix ] when* ; : add-rule ( rule ruleset -- ) - >r dup rule-chars* >upper swap - r> rules>> inverted-index ; + [ dup rule-chars* >upper swap ] dip rules>> inverted-index ; : add-escape-rule ( string ruleset -- ) over [ diff --git a/basis/xmode/tokens/tokens.factor b/basis/xmode/tokens/tokens.factor index b8917529d6..945f4bb046 100644 --- a/basis/xmode/tokens/tokens.factor +++ b/basis/xmode/tokens/tokens.factor @@ -1,4 +1,5 @@ -USING: accessors parser words sequences namespaces kernel assocs +USING: accessors parser words words.symbol +sequences namespaces kernel assocs compiler.units ; IN: xmode.tokens diff --git a/basis/xmode/utilities/utilities.factor b/basis/xmode/utilities/utilities.factor index 69fc08742b..b5a2f6eb98 100644 --- a/basis/xmode/utilities/utilities.factor +++ b/basis/xmode/utilities/utilities.factor @@ -53,5 +53,5 @@ SYMBOL: tag-handler-word : TAGS> tag-handler-word get - tag-handlers get >alist [ >r dup main>> r> case ] curry + tag-handlers get >alist [ [ dup main>> ] dip case ] curry define ; parsing diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index b3c3cb88e4..61d178ccf8 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -380,12 +380,11 @@ tuple { "over" "kernel" } { "pick" "kernel" } { "swap" "kernel" } - { ">r" "kernel" } - { "r>" "kernel" } { "eq?" "kernel" } { "tag" "kernel.private" } { "slot" "slots.private" } { "get-local" "locals.backend" } + { "load-local" "locals.backend" } { "drop-locals" "locals.backend" } } [ make-sub-primitive ] assoc-each diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index badc1f5218..654a8f5f34 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: words sequences vocabs kernel ; +USING: words words.symbol sequences vocabs kernel ; IN: bootstrap.syntax "syntax" create-vocab drop @@ -40,7 +40,10 @@ IN: bootstrap.syntax "PRIVATE>" "SBUF\"" "SINGLETON:" + "SINGLETONS:" "SYMBOL:" + "SYMBOLS:" + "CONSTANT:" "TUPLE:" "SLOT:" "T{" @@ -48,6 +51,12 @@ IN: bootstrap.syntax "INTERSECTION:" "USE:" "USING:" + "QUALIFIED:" + "QUALIFIED-WITH:" + "FROM:" + "EXCLUDE:" + "RENAME:" + "ALIAS:" "V{" "W{" "[" diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 2ce4b934c8..acff3d57e5 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays definitions assocs kernel kernel.private -slots.private namespaces make sequences strings words vectors -math quotations combinators sorting effects graphs vocabs sets ; +slots.private namespaces make sequences strings words words.symbol +vectors math quotations combinators sorting effects graphs +vocabs sets ; IN: classes SYMBOL: class<=-cache diff --git a/core/classes/singleton/singleton-docs.factor b/core/classes/singleton/singleton-docs.factor index f647b006d9..d6911576dd 100644 --- a/core/classes/singleton/singleton-docs.factor +++ b/core/classes/singleton/singleton-docs.factor @@ -4,6 +4,7 @@ IN: classes.singleton ARTICLE: "singletons" "Singleton classes" "A singleton is a class with only one instance and with no state." { $subsection POSTPONE: SINGLETON: } +{ $subsection POSTPONE: SINGLETONS: } { $subsection define-singleton-class } "The set of all singleton classes is itself a class:" { $subsection singleton-class? } diff --git a/core/compiler/errors/errors-docs.factor b/core/compiler/errors/errors-docs.factor index cb896dbf53..aa4f8e329d 100644 --- a/core/compiler/errors/errors-docs.factor +++ b/core/compiler/errors/errors-docs.factor @@ -1,6 +1,6 @@ IN: compiler.errors USING: help.markup help.syntax vocabs.loader words io -quotations ; +quotations words.symbol ; ARTICLE: "compiler-errors" "Compiler warnings and errors" "The compiler saves various notifications in a global variable:" diff --git a/core/effects/effects.factor b/core/effects/effects.factor index db6b2461b5..8a06653eb8 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -44,8 +44,6 @@ M: effect effect>string ( effect -- string ) GENERIC: stack-effect ( word -- effect/f ) -M: symbol stack-effect drop (( -- symbol )) ; - M: word stack-effect { "declared-effect" "inferred-effect" } swap props>> [ at ] curry map [ ] find nip ; diff --git a/core/math/order/order-docs.factor b/core/math/order/order-docs.factor index c8d3095ce6..ef006bbc21 100644 --- a/core/math/order/order-docs.factor +++ b/core/math/order/order-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax kernel math quotations -math.private words ; +math.private words words.symbol ; IN: math.order HELP: <=> diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 92e5922802..625c1e9c43 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -1,78 +1,10 @@ USING: help.markup help.syntax kernel sequences words math strings vectors quotations generic effects classes vocabs.loader definitions io vocabs source-files -quotations namespaces compiler.units assocs lexer ; +quotations namespaces compiler.units assocs lexer +words.symbol words.alias words.constant vocabs.parser ; IN: parser -ARTICLE: "vocabulary-search-shadow" "Shadowing word names" -"If adding a vocabulary to the search path results in a word in another vocabulary becoming inaccessible due to the new vocabulary defining a word with the same name, we say that the old word has been " { $emphasis "shadowed" } "." -$nl -"Here is an example where shadowing occurs:" -{ $code - "IN: foe" - "USING: sequences io ;" - "" - ": append" - " \"foe::append calls sequences:append\" print append ;" - "" - "IN: fee" - "" - ": append" - " \"fee::append calls fee:append\" print append ;" - "" - "IN: fox" - "USE: foe" - "" - ": append" - " \"fox::append calls foe:append\" print append ;" - "" - "\"1234\" \"5678\" append print" - "" - "USE: fox" - "\"1234\" \"5678\" append print" -} -"When placed in a source file and run, the above code produces the following output:" -{ $code - "foe:append calls sequences:append" - "12345678" - "fee:append calls foe:append" - "foe:append calls sequences:append" - "12345678" -} -"The " { $vocab-link "qualified" } " vocabulary contains some tools for helping with shadowing." ; - -ARTICLE: "vocabulary-search-errors" "Word lookup errors" -"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies." -$nl -"If " { $link auto-use? } " mode is off, a restartable error is thrown with a restart for each vocabulary in question, together with a restart which defers the word in the current vocabulary, as if " { $link POSTPONE: DEFER: } " was used." -$nl -"If " { $link auto-use? } " mode is on and only one vocabulary has a word with this name, the vocabulary is added to the search path and parsing continues." -$nl -"If any restarts were invoked, or if " { $link auto-use? } " is on, the parser will print the correct " { $link POSTPONE: USING: } " after parsing completes. This form can be copy and pasted back into the source file." -{ $subsection auto-use? } ; - -ARTICLE: "vocabulary-search" "Vocabulary search path" -"When the parser reads a token, it attempts to look up a word named by that token. The lookup is performed by searching each vocabulary in the search path, in order." -$nl -"For a source file the vocabulary search path starts off with one vocabulary:" -{ $code "syntax" } -"The " { $vocab-link "syntax" } " vocabulary consists of a set of parsing words for reading Factor data and defining new words." -$nl -"In the listener, the " { $vocab-link "scratchpad" } " is the default vocabulary for new word definitions. However, when loading source files, there is no default vocabulary. Defining words before declaring a vocabulary with " { $link POSTPONE: IN: } " results in an error." -$nl -"At the interactive listener, the default search path contains many more vocabularies. Details on the default search path and parser invocation are found in " { $link "parser" } "." -$nl -"Three parsing words deal with the vocabulary search path:" -{ $subsection POSTPONE: USE: } -{ $subsection POSTPONE: USING: } -{ $subsection POSTPONE: IN: } -"Private words can be defined; note that this is just a convention and they can be called from other vocabularies anyway:" -{ $subsection POSTPONE: } -{ $subsection "vocabulary-search-errors" } -{ $subsection "vocabulary-search-shadow" } -{ $see-also "words" "qualified" } ; - ARTICLE: "reading-ahead" "Reading ahead" "Parsing words can consume input:" { $subsection scan } diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 6ddf299f7f..bdbd6b37a8 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -502,3 +502,54 @@ DEFER: blah [ ] [ f lexer set f file set "Hello world" note. ] unit-test [ "CHAR: \\u9999999999999" eval ] must-fail + +SYMBOLS: a b c ; + +[ a ] [ a ] unit-test +[ b ] [ b ] unit-test +[ c ] [ c ] unit-test + +DEFER: blah + +[ ] [ "IN: symbols.tests GENERIC: blah" eval ] unit-test +[ ] [ "IN: symbols.tests USE: symbols SYMBOLS: blah ;" eval ] unit-test + +[ f ] [ \ blah generic? ] unit-test +[ t ] [ \ blah symbol? ] unit-test + +[ "IN: symbols.tests USE: symbols SINGLETONS: blah blah blah ;" eval ] +[ error>> error>> def>> \ blah eq? ] +must-fail-with + +IN: qualified.tests.foo +: x 1 ; +: y 5 ; +IN: qualified.tests.bar +: x 2 ; +: y 4 ; +IN: qualified.tests.baz +: x 3 ; + +QUALIFIED: qualified.tests.foo +QUALIFIED: qualified.tests.bar +[ 1 2 3 ] [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test + +QUALIFIED-WITH: qualified.tests.bar p +[ 2 ] [ p:x ] unit-test + +RENAME: x qualified.tests.baz => y +[ 3 ] [ y ] unit-test + +FROM: qualified.tests.baz => x ; +[ 3 ] [ x ] unit-test +[ 3 ] [ y ] unit-test + +EXCLUDE: qualified.tests.bar => x ; +[ 3 ] [ x ] unit-test +[ 4 ] [ y ] unit-test + +[ "USE: qualified IN: qualified.tests FROM: qualified.tests => doesnotexist ;" eval ] +[ error>> no-word-error? ] must-fail-with + +[ "USE: qualified IN: qualified.tests RENAME: doesnotexist qualified.tests => blah" eval ] +[ error>> no-word-error? ] must-fail-with diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 4586cfe34e..81ed91290c 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays definitions generic assocs kernel math namespaces -sequences strings vectors words quotations io +sequences strings vectors words words.symbol quotations io combinators sorting splitting math.parser effects continuations io.files io.streams.string vocabs io.encodings.utf8 source-files classes hashtables compiler.errors compiler.units accessors sets -lexer ; +lexer vocabs.parser ; IN: parser : location ( -- loc ) @@ -29,27 +29,6 @@ t parser-notes set-global "Note: " write dup print ] when drop ; -SYMBOL: use -SYMBOL: in - -: (use+) ( vocab -- ) - vocab-words use get push ; - -: use+ ( vocab -- ) - load-vocab (use+) ; - -: add-use ( seq -- ) [ use+ ] each ; - -: set-use ( seq -- ) - [ vocab-words ] V{ } map-as sift use set ; - -: check-vocab-string ( name -- name ) - dup string? - [ "Vocabulary name must be a string" throw ] unless ; - -: set-in ( name -- ) - check-vocab-string dup in set create-vocab (use+) ; - M: parsing-word stack-effect drop (( parsed -- parsed )) ; TUPLE: no-current-vocab ; @@ -69,17 +48,6 @@ TUPLE: no-current-vocab ; : CREATE-WORD ( -- word ) CREATE dup reset-generic ; -: word-restarts ( name possibilities -- restarts ) - natural-sort - [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc - swap "Defer word in current vocabulary" swap 2array - suffix ; - -ERROR: no-word-error name ; - -: ( name possibilities -- error restarts ) - [ drop \ no-word-error boa ] [ word-restarts ] 2bi ; - SYMBOL: amended-use SYMBOL: auto-use? diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 7a1cb5fd92..54b8b1b401 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -1,7 +1,7 @@ USING: generic help.syntax help.markup kernel math parser words effects classes generic.standard classes.tuple generic.math generic.standard arrays io.pathnames vocabs.loader io sequences -assocs ; +assocs words.symbol words.alias words.constant ; IN: syntax ARTICLE: "parser-algorithm" "Parser algorithm" @@ -344,7 +344,41 @@ HELP: SYMBOL: { $description "Defines a new symbol word in the current vocabulary. Symbols push themselves on the stack when executed, and are used to identify variables (see " { $link "namespaces" } ") as well as for storing crufties in word properties (see " { $link "word-props" } ")." } { $examples { $example "USE: prettyprint" "IN: scratchpad" "SYMBOL: foo\nfoo ." "foo" } } ; -{ define-symbol POSTPONE: SYMBOL: } related-words +{ define-symbol POSTPONE: SYMBOL: POSTPONE: SYMBOLS: } related-words + +HELP: SYMBOLS: +{ $syntax "SYMBOLS: words... ;" } +{ $values { "words" "a sequence of new words to define" } } +{ $description "Creates a new symbol for every token until the " { $snippet ";" } "." } +{ $examples { $example "USING: prettyprint ;" "IN: scratchpad" "SYMBOLS: foo bar baz ;\nfoo . bar . baz ." "foo\nbar\nbaz" } } ; + +HELP: SINGLETONS: +{ $syntax "SINGLETONS: words... ;" } +{ $values { "words" "a sequence of new words to define" } } +{ $description "Creates a new singleton for every token until the " { $snippet ";" } "." } ; + +HELP: ALIAS: +{ $syntax "ALIAS: new-word existing-word" } +{ $values { "new-word" word } { "existing-word" word } } +{ $description "Creates a new inlined word that calls the existing word." } +{ $examples + { $example "USING: prettyprint sequences ;" + "IN: alias.test" + "ALIAS: sequence-nth nth" + "0 { 10 20 30 } sequence-nth ." + "10" + } +} ; + +{ define-alias POSTPONE: ALIAS: } related-words + +HELP: CONSTANT: +{ $syntax "CONSTANT: word value" } +{ $values { "word" word } { "value" object } } +{ $description "Creates a word which pushes a value on the stack." } +{ $examples { $code "CONSTANT: magic 1" "CONSTANT: science HEX: ff0f" } } ; + +{ define-constant POSTPONE: CONSTANT: } related-words HELP: \ { $syntax "\\ word" } @@ -376,6 +410,47 @@ HELP: USING: { $description "Adds a list of vocabularies to the front of the search path, with later vocabularies taking precedence." } { $errors "Throws an error if one of the vocabularies does not exist." } ; +HELP: QUALIFIED: +{ $syntax "QUALIFIED: vocab" } +{ $description "Similar to " { $link POSTPONE: USE: } " but loads vocabulary with prefix." } +{ $examples { $example + "USING: prettyprint qualified ;" + "QUALIFIED: math" + "1 2 math:+ ." "3" +} } ; + +HELP: QUALIFIED-WITH: +{ $syntax "QUALIFIED-WITH: vocab word-prefix" } +{ $description "Works like " { $link POSTPONE: QUALIFIED: } " but uses " { $snippet "word-prefix" } " as prefix." } +{ $examples { $code + "USING: prettyprint qualified ;" + "QUALIFIED-WITH: math m" + "1 2 m:+ ." + "3" +} } ; + +HELP: FROM: +{ $syntax "FROM: vocab => words ... ;" } +{ $description "Imports " { $snippet "words" } " from " { $snippet "vocab" } "." } +{ $examples { $code + "FROM: math.parser => bin> hex> ; ! imports only bin> and hex>" } } ; + +HELP: EXCLUDE: +{ $syntax "EXCLUDE: vocab => words ... ;" } +{ $description "Imports everything from " { $snippet "vocab" } " excluding " { $snippet "words" } "." } +{ $examples { $code + "EXCLUDE: math.parser => bin> hex> ; ! imports everything but bin> and hex>" } } ; + +HELP: RENAME: +{ $syntax "RENAME: word vocab => newname" } +{ $description "Imports " { $snippet "word" } " from " { $snippet "vocab" } ", but renamed to " { $snippet "newname" } "." } +{ $examples { $example + "USING: prettyprint qualified ;" + "RENAME: + math => -" + "2 3 - ." + "5" +} } ; + HELP: IN: { $syntax "IN: vocabulary" } { $values { "vocabulary" "a new vocabulary name" } } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 9640aa9275..c81fc9201e 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -2,12 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien arrays byte-arrays definitions generic hashtables kernel math namespaces parser lexer sequences strings -strings.parser sbufs vectors words quotations io assocs -splitting classes.tuple generic.standard generic.math -generic.parser classes io.pathnames vocabs classes.parser -classes.union classes.intersection classes.mixin -classes.predicate classes.singleton classes.tuple.parser -compiler.units combinators effects.parser slots ; +strings.parser sbufs vectors words words.symbol words.constant +words.alias quotations io assocs splitting classes.tuple +generic.standard generic.math generic.parser classes +io.pathnames vocabs vocabs.parser classes.parser classes.union +classes.intersection classes.mixin classes.predicate +classes.singleton classes.tuple.parser compiler.units +combinators effects.parser slots ; IN: bootstrap.syntax ! These words are defined as a top-level form, instead of with @@ -22,7 +23,8 @@ IN: bootstrap.syntax "syntax" lookup t "delimiter" set-word-prop ; : define-syntax ( name quot -- ) - [ "syntax" lookup dup ] dip define make-parsing ; + [ dup "syntax" lookup [ dup ] [ no-word-error ] ?if ] dip + define make-parsing ; [ { "]" "}" ";" ">>" } [ define-delimiter ] each @@ -51,6 +53,22 @@ IN: bootstrap.syntax "USING:" [ ";" parse-tokens add-use ] define-syntax + "QUALIFIED:" [ scan dup add-qualified ] define-syntax + + "QUALIFIED-WITH:" [ scan scan add-qualified ] define-syntax + + "FROM:" [ + scan "=>" expect ";" parse-tokens swap add-words-from + ] define-syntax + + "EXCLUDE:" [ + scan "=>" expect ";" parse-tokens swap add-words-excluding + ] define-syntax + + "RENAME:" [ + scan scan "=>" expect scan add-renamed-word + ] define-syntax + "HEX:" [ 16 parse-base ] define-syntax "OCT:" [ 8 parse-base ] define-syntax "BIN:" [ 2 parse-base ] define-syntax @@ -97,6 +115,24 @@ IN: bootstrap.syntax CREATE-WORD define-symbol ] define-syntax + "SYMBOLS:" [ + ";" parse-tokens + [ create-in dup reset-generic define-symbol ] each + ] define-syntax + + "SINGLETONS:" [ + ";" parse-tokens + [ create-class-in define-singleton-class ] each + ] define-syntax + + "ALIAS:" [ + CREATE-WORD scan-word define-alias + ] define-syntax + + "CONSTANT:" [ + CREATE scan-object define-constant + ] define-syntax + "DEFER:" [ scan current-vocab create dup old-definitions get [ delete-at ] with each diff --git a/core/vocabs/parser/authors.txt b/core/vocabs/parser/authors.txt new file mode 100644 index 0000000000..3095b9b26c --- /dev/null +++ b/core/vocabs/parser/authors.txt @@ -0,0 +1,3 @@ +Daniel Ehrenberg +Bruno Deferrari +Slava Pestov diff --git a/core/vocabs/parser/parser-docs.factor b/core/vocabs/parser/parser-docs.factor new file mode 100644 index 0000000000..b2e964962d --- /dev/null +++ b/core/vocabs/parser/parser-docs.factor @@ -0,0 +1,81 @@ +USING: help.markup help.syntax parser ; +IN: vocabs.parser + +ARTICLE: "vocabulary-search-shadow" "Shadowing word names" +"If adding a vocabulary to the search path results in a word in another vocabulary becoming inaccessible due to the new vocabulary defining a word with the same name, we say that the old word has been " { $emphasis "shadowed" } "." +$nl +"Here is an example where shadowing occurs:" +{ $code + "IN: foe" + "USING: sequences io ;" + "" + ": append" + " \"foe::append calls sequences:append\" print append ;" + "" + "IN: fee" + "" + ": append" + " \"fee::append calls fee:append\" print append ;" + "" + "IN: fox" + "USE: foe" + "" + ": append" + " \"fox::append calls foe:append\" print append ;" + "" + "\"1234\" \"5678\" append print" + "" + "USE: fox" + "\"1234\" \"5678\" append print" +} +"When placed in a source file and run, the above code produces the following output:" +{ $code + "foe:append calls sequences:append" + "12345678" + "fee:append calls foe:append" + "foe:append calls sequences:append" + "12345678" +} +"The " { $vocab-link "qualified" } " vocabulary contains some tools for helping with shadowing." ; + +ARTICLE: "vocabulary-search-errors" "Word lookup errors" +"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies." +$nl +"If " { $link auto-use? } " mode is off, a restartable error is thrown with a restart for each vocabulary in question, together with a restart which defers the word in the current vocabulary, as if " { $link POSTPONE: DEFER: } " was used." +$nl +"If " { $link auto-use? } " mode is on and only one vocabulary has a word with this name, the vocabulary is added to the search path and parsing continues." +$nl +"If any restarts were invoked, or if " { $link auto-use? } " is on, the parser will print the correct " { $link POSTPONE: USING: } " after parsing completes. This form can be copy and pasted back into the source file." +{ $subsection auto-use? } ; + +ARTICLE: "vocabulary-search" "Vocabulary search path" +"When the parser reads a token, it attempts to look up a word named by that token. The lookup is performed by searching each vocabulary in the search path, in order." +$nl +"For a source file the vocabulary search path starts off with one vocabulary:" +{ $code "syntax" } +"The " { $vocab-link "syntax" } " vocabulary consists of a set of parsing words for reading Factor data and defining new words." +$nl +"In the listener, the " { $vocab-link "scratchpad" } " is the default vocabulary for new word definitions. However, when loading source files, there is no default vocabulary. Defining words before declaring a vocabulary with " { $link POSTPONE: IN: } " results in an error." +$nl +"At the interactive listener, the default search path contains many more vocabularies. Details on the default search path and parser invocation are found in " { $link "parser" } "." +$nl +"Three parsing words deal with the vocabulary search path:" +{ $subsection POSTPONE: IN: } +{ $subsection POSTPONE: USE: } +{ $subsection POSTPONE: USING: } +"There are some additional parsing words give more control over word lookup than is offered by " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } ":" +{ $subsection POSTPONE: QUALIFIED: } +{ $subsection POSTPONE: QUALIFIED-WITH: } +{ $subsection POSTPONE: FROM: } +{ $subsection POSTPONE: EXCLUDE: } +{ $subsection POSTPONE: RENAME: } +"These words are useful when there is no way to avoid using two vocabularies with identical word names in the same source file." +$nl +"Private words can be defined; note that this is just a convention and they can be called from other vocabularies anyway:" +{ $subsection POSTPONE: } +{ $subsection "vocabulary-search-errors" } +{ $subsection "vocabulary-search-shadow" } +{ $see-also "words" } ; + +ABOUT: "vocabulary-search" diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor new file mode 100644 index 0000000000..35feae34bb --- /dev/null +++ b/core/vocabs/parser/parser.factor @@ -0,0 +1,59 @@ +! Copyright (C) 2007, 2008 Daniel Ehrenberg, Bruno Deferrari, +! Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: assocs hashtables kernel namespaces sequences +sets strings vocabs sorting accessors arrays ; +IN: vocabs.parser + +ERROR: no-word-error name ; + +: word-restarts ( name possibilities -- restarts ) + natural-sort + [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc + swap "Defer word in current vocabulary" swap 2array + suffix ; + +: ( name possibilities -- error restarts ) + [ drop \ no-word-error boa ] [ word-restarts ] 2bi ; + +SYMBOL: use +SYMBOL: in + +: (use+) ( vocab -- ) + vocab-words use get push ; + +: use+ ( vocab -- ) + load-vocab (use+) ; + +: add-use ( seq -- ) [ use+ ] each ; + +: set-use ( seq -- ) + [ vocab-words ] V{ } map-as sift use set ; + +: add-qualified ( vocab prefix -- ) + [ load-vocab vocab-words ] [ CHAR: : suffix ] bi* + [ swap [ prepend ] dip ] curry assoc-map + use get push ; + +: partial-vocab ( words vocab -- assoc ) + load-vocab vocab-words + [ dupd at [ no-word-error ] unless* ] curry { } map>assoc ; + +: add-words-from ( words vocab -- ) + partial-vocab use get push ; + +: partial-vocab-excluding ( words vocab -- assoc ) + load-vocab [ vocab-words keys swap diff ] keep partial-vocab ; + +: add-words-excluding ( words vocab -- ) + partial-vocab-excluding use get push ; + +: add-renamed-word ( word vocab new-name -- ) + [ load-vocab vocab-words dupd at [ ] [ no-word-error ] ?if ] dip + associate use get push ; + +: check-vocab-string ( name -- name ) + dup string? [ "Vocabulary name must be a string" throw ] unless ; + +: set-in ( name -- ) + check-vocab-string dup in set create-vocab (use+) ; diff --git a/core/words/alias/alias-docs.factor b/core/words/alias/alias-docs.factor new file mode 100644 index 0000000000..d5696479cc --- /dev/null +++ b/core/words/alias/alias-docs.factor @@ -0,0 +1,12 @@ +USING: help.markup help.syntax words.alias ; +IN: words.alias + +ARTICLE: "words.alias" "Word aliasing" +"There is a syntax for defining new names for existing words. This useful for C library bindings, for example in the Win32 API, where words need to be renamed for symmetry." +$nl +"Define a new word that aliases another word:" +{ $subsection POSTPONE: ALIAS: } +"Define an alias at run-time:" +{ $subsection define-alias } ; + +ABOUT: "words.alias" diff --git a/basis/alias/alias.factor b/core/words/alias/alias.factor similarity index 64% rename from basis/alias/alias.factor rename to core/words/alias/alias.factor index 79914527ff..0615e8333e 100644 --- a/basis/alias/alias.factor +++ b/core/words/alias/alias.factor @@ -1,19 +1,16 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors words quotations kernel effects sequences -parser definitions ; -IN: alias - -PREDICATE: alias < word "alias" word-prop ; - -: define-alias ( new old -- ) - [ [ 1quotation ] [ stack-effect ] bi define-inline ] - [ drop t "alias" set-word-prop ] 2bi ; - -: ALIAS: CREATE-WORD scan-word define-alias ; parsing - -M: alias reset-word - [ call-next-method ] [ f "alias" set-word-prop ] bi ; - -M: alias stack-effect - def>> first stack-effect ; +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: quotations effects accessors sequences words kernel ; +IN: words.alias + +PREDICATE: alias < word "alias" word-prop ; + +: define-alias ( new old -- ) + [ [ 1quotation ] [ stack-effect ] bi define-inline ] + [ drop t "alias" set-word-prop ] 2bi ; + +M: alias reset-word + [ call-next-method ] [ f "alias" set-word-prop ] bi ; + +M: alias stack-effect + def>> first stack-effect ; diff --git a/extra/porter-stemmer/authors.txt b/core/words/alias/authors.txt similarity index 100% rename from extra/porter-stemmer/authors.txt rename to core/words/alias/authors.txt diff --git a/basis/alias/summary.txt b/core/words/alias/summary.txt similarity index 100% rename from basis/alias/summary.txt rename to core/words/alias/summary.txt diff --git a/core/words/constant/constant.factor b/core/words/constant/constant.factor new file mode 100644 index 0000000000..43b7f37599 --- /dev/null +++ b/core/words/constant/constant.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel sequences words ; +IN: words.constant + +PREDICATE: constant < word ( obj -- ? ) + def>> dup length 1 = [ first word? not ] [ drop f ] if ; + +: define-constant ( word value -- ) + [ ] curry (( -- value )) define-inline ; diff --git a/core/words/symbol/symbol-docs.factor b/core/words/symbol/symbol-docs.factor new file mode 100644 index 0000000000..1fcba9a3e2 --- /dev/null +++ b/core/words/symbol/symbol-docs.factor @@ -0,0 +1,28 @@ +USING: help.syntax help.markup words.symbol words compiler.units ; +IN: words.symbol + +HELP: symbol +{ $description "The class of symbols created by " { $link POSTPONE: SYMBOL: } "." } ; + +HELP: define-symbol +{ $values { "word" word } } +{ $description "Defines the word to push itself on the stack when executed. This is the run time equivalent of " { $link POSTPONE: SYMBOL: } "." } +{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } +{ $side-effects "word" } ; + +ARTICLE: "words.symbol" "Symbols" +"A symbol pushes itself on the stack when executed. By convention, symbols are used as variable names (" { $link "namespaces" } ")." +{ $subsection symbol } +{ $subsection symbol? } +"Defining symbols at parse time:" +{ $subsection POSTPONE: SYMBOL: } +{ $subsection POSTPONE: SYMBOLS: } +"Defining symbols at run time:" +{ $subsection define-symbol } +"Symbols are just compound definitions in disguise. The following two lines are equivalent:" +{ $code + "SYMBOL: foo" + ": foo ( -- value ) \\ foo ;" +} ; + +ABOUT: "words.symbol" diff --git a/core/words/symbol/symbol.factor b/core/words/symbol/symbol.factor new file mode 100644 index 0000000000..a107808eec --- /dev/null +++ b/core/words/symbol/symbol.factor @@ -0,0 +1,15 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel sequences accessors definitions +words words.constant ; +IN: words.symbol + +PREDICATE: symbol < constant ( obj -- ? ) + [ def>> ] [ [ ] curry ] bi sequence= ; + +M: symbol definer drop \ SYMBOL: f ; + +M: symbol definition drop f ; + +: define-symbol ( word -- ) + dup define-constant ; diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index 389f16c68e..02fb5cf54e 100644 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -35,20 +35,6 @@ $nl $nl "All other types of word definitions, such as " { $link "symbols" } " and " { $link "generic" } ", are just special cases of the above." ; -ARTICLE: "symbols" "Symbols" -"A symbol pushes itself on the stack when executed. By convention, symbols are used as variable names (" { $link "namespaces" } ")." -{ $subsection symbol } -{ $subsection symbol? } -"Defining symbols at parse time:" -{ $subsection POSTPONE: SYMBOL: } -"Defining symbols at run time:" -{ $subsection define-symbol } -"Symbols are just compound definitions in disguise. The following two lines are equivalent:" -{ $code - "SYMBOL: foo" - ": foo \\ foo ;" -} ; - ARTICLE: "primitives" "Primitives" "Primitives are words defined in the Factor VM. They provide the essential low-level services to the rest of the system." { $subsection primitive } @@ -91,7 +77,8 @@ ARTICLE: "word-definition" "Defining words" } "The latter is a more dynamic feature that can be used to implement code generation and such, and in fact parse time defining words are implemented in terms of run time defining words." { $subsection "colon-definition" } -{ $subsection "symbols" } +{ $subsection "words.symbol" } +{ $subsection "words.alias" } { $subsection "primitives" } { $subsection "deferred" } { $subsection "declarations" } @@ -193,9 +180,6 @@ HELP: deferred HELP: primitive { $description "The class of primitive words." } ; -HELP: symbol -{ $description "The class of symbols created by " { $link POSTPONE: SYMBOL: } "." } ; - HELP: word-prop { $values { "word" word } { "name" "a property name" } { "value" "a property value" } } { $description "Retrieves a word property. Word property names are conventionally strings." } ; @@ -214,12 +198,6 @@ HELP: word-xt ( word -- start end ) { $values { "word" word } { "start" "the word's start address" } { "end" "the word's end address" } } { $description "Outputs the machine code address of the word's definition." } ; -HELP: define-symbol -{ $values { "word" word } } -{ $description "Defines the word to push itself on the stack when executed. This is the run time equivalent of " { $link POSTPONE: SYMBOL: } "." } -{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } -{ $side-effects "word" } ; - HELP: define { $values { "word" word } { "def" quotation } } { $description "Defines the word to call a quotation when executed. This is the run time equivalent of " { $link POSTPONE: : } "." } diff --git a/core/words/words.factor b/core/words/words.factor index f0beab1809..c75711ea39 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -28,11 +28,6 @@ PREDICATE: deferred < word ( obj -- ? ) M: deferred definer drop \ DEFER: f ; M: deferred definition drop f ; -PREDICATE: symbol < word ( obj -- ? ) - [ def>> ] [ [ ] curry ] bi sequence= ; -M: symbol definer drop \ SYMBOL: f ; -M: symbol definition drop f ; - PREDICATE: primitive < word ( obj -- ? ) [ def>> [ do-primitive ] tail? ] [ sub-primitive>> >boolean ] @@ -195,9 +190,6 @@ SYMBOL: visited : define-inline ( word def effect -- ) [ define-declared ] [ 2drop make-inline ] 3bi ; -: define-symbol ( word -- ) - dup [ ] curry (( -- word )) define-inline ; - GENERIC: reset-word ( word -- ) M: word reset-word diff --git a/extra/advice/advice.factor b/extra/advice/advice.factor index 383812e602..fbdfa9c66b 100644 --- a/extra/advice/advice.factor +++ b/extra/advice/advice.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences symbols fry words assocs linked-assocs tools.annotations +USING: kernel sequences fry words assocs linked-assocs tools.annotations coroutines lexer parser quotations arrays namespaces continuations ; IN: advice diff --git a/extra/benchmark/binary-trees/binary-trees.factor b/extra/benchmark/binary-trees/binary-trees.factor index f562072f28..8e3918656a 100644 --- a/extra/benchmark/binary-trees/binary-trees.factor +++ b/extra/benchmark/binary-trees/binary-trees.factor @@ -10,8 +10,8 @@ C: tree-node dup 0 > [ 1 - [ drop ] - [ >r 2 * 1 - r> bottom-up-tree ] - [ >r 2 * r> bottom-up-tree ] 2tri + [ [ 2 * 1 - ] dip bottom-up-tree ] + [ [ 2 * ] dip bottom-up-tree ] 2tri ] [ drop f f ] if ; inline recursive diff --git a/extra/benchmark/knucleotide/knucleotide.factor b/extra/benchmark/knucleotide/knucleotide.factor index 7b8e2d34c9..7e65059643 100644 --- a/extra/benchmark/knucleotide/knucleotide.factor +++ b/extra/benchmark/knucleotide/knucleotide.factor @@ -29,7 +29,7 @@ IN: benchmark.knucleotide : small-groups ( x n -- b ) swap [ length swap - 1+ ] 2keep - [ >r over + r> subseq ] 2curry map ; + [ [ over + ] dip subseq ] 2curry map ; : handle-table ( inputs n -- ) small-groups diff --git a/extra/benchmark/nsieve-bits/nsieve-bits.factor b/extra/benchmark/nsieve-bits/nsieve-bits.factor index ddb70972b9..246a962a55 100644 --- a/extra/benchmark/nsieve-bits/nsieve-bits.factor +++ b/extra/benchmark/nsieve-bits/nsieve-bits.factor @@ -6,7 +6,7 @@ bit-arrays make io ; 2dup length >= [ 3drop ] [ - f 2over set-nth-unsafe >r over + r> clear-flags + f 2over set-nth-unsafe [ over + ] dip clear-flags ] if ; inline recursive : (nsieve-bits) ( count i seq -- count ) @@ -14,7 +14,7 @@ bit-arrays make io ; 2dup nth-unsafe [ over dup 2 * pick clear-flags rot 1+ -rot ! increment count - ] when >r 1+ r> (nsieve-bits) + ] when [ 1+ ] dip (nsieve-bits) ] [ 2drop ] if ; inline recursive diff --git a/extra/benchmark/nsieve-bytes/nsieve-bytes.factor b/extra/benchmark/nsieve-bytes/nsieve-bytes.factor index 11745e4463..bbeccf750b 100644 --- a/extra/benchmark/nsieve-bytes/nsieve-bytes.factor +++ b/extra/benchmark/nsieve-bytes/nsieve-bytes.factor @@ -6,7 +6,7 @@ byte-arrays make io ; 2dup length >= [ 3drop ] [ - 0 2over set-nth-unsafe >r over + r> clear-flags + 0 2over set-nth-unsafe [ over + ] dip clear-flags ] if ; inline recursive : (nsieve) ( count i seq -- count ) @@ -14,7 +14,7 @@ byte-arrays make io ; 2dup nth-unsafe 0 > [ over dup 2 * pick clear-flags rot 1+ -rot ! increment count - ] when >r 1+ r> (nsieve) + ] when [ 1+ ] dip (nsieve) ] [ 2drop ] if ; inline recursive diff --git a/extra/benchmark/nsieve/nsieve.factor b/extra/benchmark/nsieve/nsieve.factor index 76d991f734..6fbc144e80 100644 --- a/extra/benchmark/nsieve/nsieve.factor +++ b/extra/benchmark/nsieve/nsieve.factor @@ -6,7 +6,7 @@ arrays make io ; 2dup length >= [ 3drop ] [ - f 2over set-nth-unsafe >r over + r> clear-flags + f 2over set-nth-unsafe [ over + ] dip clear-flags ] if ; inline recursive : (nsieve) ( count i seq -- count ) @@ -14,7 +14,7 @@ arrays make io ; 2dup nth-unsafe [ over dup 2 * pick clear-flags rot 1+ -rot ! increment count - ] when >r 1+ r> (nsieve) + ] when [ 1+ ] dip (nsieve) ] [ 2drop ] if ; inline recursive diff --git a/extra/boolean-expr/boolean-expr.factor b/extra/boolean-expr/boolean-expr.factor index 5bf4bf3ad3..8cb5acf74b 100644 --- a/extra/boolean-expr/boolean-expr.factor +++ b/extra/boolean-expr/boolean-expr.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays classes kernel sequences sets -io prettyprint multi-methods symbols ; +io prettyprint multi-methods ; IN: boolean-expr ! Demonstrates the use of Unicode symbols in source files, and diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 3e00191108..255e6eb343 100755 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -23,7 +23,7 @@ IN: bunny.model : n ( vs triple -- n ) swap [ nth ] curry map - dup third over first v- >r dup second swap first v- r> cross + [ [ second ] [ first ] bi v- ] [ [ third ] [ first ] bi v- ] bi cross vneg normalize ; : normal ( ns vs triple -- ) @@ -31,7 +31,7 @@ IN: bunny.model : normals ( vs is -- ns ) over length { 0.0 0.0 0.0 } -rot - [ >r 2dup r> normal ] each drop + [ [ 2dup ] dip normal ] each drop [ normalize ] map ; : read-model ( stream -- model ) diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index 3cf3f94d73..c91a895ce1 100755 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -2,7 +2,7 @@ USING: arrays bunny.model bunny.cel-shaded continuations destructors kernel math multiline opengl opengl.shaders opengl.framebuffers opengl.gl opengl.demo-support fry opengl.capabilities sequences ui.gadgets combinators accessors -macros ; +macros locals ; IN: bunny.outlined STRING: outlined-pass1-fragment-shader-main-source @@ -143,19 +143,17 @@ TUPLE: bunny-outlined pass1-program pass2-program f f f f f bunny-outlined boa ] [ drop f ] if ; -: (framebuffer-texture) ( dim iformat xformat -- texture ) - swapd >r >r >r +:: (framebuffer-texture) ( dim iformat xformat -- texture ) GL_TEXTURE0 glActiveTexture gen-texture GL_TEXTURE_2D over glBindTexture GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST glTexParameteri - GL_TEXTURE_2D 0 r> r> first2 0 r> GL_UNSIGNED_BYTE f glTexImage2D ; + GL_TEXTURE_2D 0 iformat dim first2 0 xformat GL_UNSIGNED_BYTE f glTexImage2D ; -: (attach-framebuffer-texture) ( texture attachment -- ) - swap >r >r - GL_FRAMEBUFFER_EXT r> GL_TEXTURE_2D r> 0 glFramebufferTexture2DEXT +:: (attach-framebuffer-texture) ( texture attachment -- ) + GL_FRAMEBUFFER_EXT attachment GL_TEXTURE_2D texture 0 glFramebufferTexture2DEXT gl-error ; : (make-framebuffer) ( color-texture normal-texture depth-texture -- framebuffer ) diff --git a/extra/cairo/samples/samples.factor b/extra/cairo-samples/cairo-samples.factor similarity index 99% rename from extra/cairo/samples/samples.factor rename to extra/cairo-samples/cairo-samples.factor index bdd02c9e13..a29e12c1d7 100644 --- a/extra/cairo/samples/samples.factor +++ b/extra/cairo-samples/cairo-samples.factor @@ -7,7 +7,7 @@ USING: cairo cairo.ffi locals math.constants math io.backend kernel alien.c-types libc namespaces cairo.gadgets ui.gadgets accessors specialized-arrays.double ; -IN: cairo.samples +IN: cairo-samples TUPLE: arc-gadget < cairo-gadget ; M:: arc-gadget render-cairo* ( gadget -- ) diff --git a/extra/cfdg/cfdg.factor b/extra/cfdg/cfdg.factor index e1c89374fd..e2acd6e5d5 100644 --- a/extra/cfdg/cfdg.factor +++ b/extra/cfdg/cfdg.factor @@ -6,7 +6,7 @@ USING: kernel alien.c-types combinators namespaces make arrays vars colors self self.slots random-weighted colors.hsv cfdg.gl accessors ui.gadgets.handler ui.gestures assocs ui.gadgets macros - qualified specialized-arrays.double ; + specialized-arrays.double ; QUALIFIED: syntax diff --git a/extra/crypto/passwd-md5/passwd-md5.factor b/extra/crypto/passwd-md5/passwd-md5.factor index 32a913ef23..e292981876 100644 --- a/extra/crypto/passwd-md5/passwd-md5.factor +++ b/extra/crypto/passwd-md5/passwd-md5.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel base64 checksums.md5 symbols sequences checksums +USING: kernel base64 checksums.md5 sequences checksums locals prettyprint math math.bitwise grouping io combinators fry make combinators.short-circuit math.functions splitting ; IN: crypto.passwd-md5 diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor index be3ba40ac0..980af0fd81 100644 --- a/extra/dns/dns.factor +++ b/extra/dns/dns.factor @@ -7,7 +7,6 @@ USING: kernel byte-arrays combinators strings arrays sequences splitting accessors combinators.cleave newfx - symbols ; IN: dns diff --git a/extra/game-input/dinput/dinput.factor b/extra/game-input/dinput/dinput.factor index cb7b34d8a4..328e4ff013 100755 --- a/extra/game-input/dinput/dinput.factor +++ b/extra/game-input/dinput/dinput.factor @@ -1,4 +1,4 @@ -USING: windows.dinput windows.dinput.constants parser symbols +USING: windows.dinput windows.dinput.constants parser alien.c-types windows.ole32 namespaces assocs kernel arrays vectors windows.kernel32 windows.com windows.dinput shuffle windows.user32 windows.messages sequences combinators locals diff --git a/extra/game-input/game-input.factor b/extra/game-input/game-input.factor index 7699b8bd1e..46e3ba9e8d 100755 --- a/extra/game-input/game-input.factor +++ b/extra/game-input/game-input.factor @@ -1,6 +1,5 @@ -USING: arrays accessors continuations kernel symbols system -combinators.lib sequences namespaces init vocabs vocabs.loader -combinators ; +USING: arrays accessors continuations kernel system +sequences namespaces init vocabs vocabs.loader combinators ; IN: game-input SYMBOLS: game-input-backend game-input-opened ; @@ -59,9 +58,10 @@ HOOK: instance-id game-input-backend ( controller -- id ) get-controllers [ product-id = ] with filter ; : find-controller-instance ( product-id instance-id -- controller/f ) get-controllers [ + tuck [ product-id = ] - [ instance-id = ] bi, bi* and - ] 2with find nip ; + [ instance-id = ] 2bi* and + ] with with find nip ; HOOK: read-controller game-input-backend ( controller -- controller-state ) HOOK: calibrate-controller game-input-backend ( controller -- ) diff --git a/extra/game-input/iokit/iokit.factor b/extra/game-input/iokit/iokit.factor index 8bfce00fb0..26f2c40464 100755 --- a/extra/game-input/iokit/iokit.factor +++ b/extra/game-input/iokit/iokit.factor @@ -1,7 +1,7 @@ USING: cocoa cocoa.plists core-foundation iokit iokit.hid kernel cocoa.enumeration destructors math.parser cocoa.application sequences locals combinators.short-circuit threads -symbols namespaces assocs vectors arrays combinators +namespaces assocs vectors arrays combinators core-foundation.run-loop accessors sequences.private alien.c-types math parser game-input ; IN: game-input.iokit diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 0e3d48fe5b..c34fcf5f57 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations continuations debugger classes.tuple namespaces make vectors bit-arrays byte-arrays strings sbufs math.functions macros sequences.private combinators mirrors -combinators.short-circuit fry qualified ; +combinators.short-circuit fry ; RENAME: _ fry => __ IN: inverse diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 622b5eaa2c..c1cbdcf8b8 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -1,4 +1,4 @@ -USING: kernel tools.test accessors arrays sequences qualified +USING: kernel tools.test accessors arrays sequences io io.streams.duplex namespaces threads destructors calendar irc.client.private irc.client irc.messages.private concurrency.mailboxes classes assocs combinators ; diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 8199347feb..0eba6f6af5 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Bruno Deferrari, Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar - accessors destructors namespaces io assocs arrays qualified fry + accessors destructors namespaces io assocs arrays fry continuations threads strings classes combinators splitting hashtables ascii irc.messages ; RENAME: join sequences => sjoin diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor index 41272a43f2..ac1d003b1b 100644 --- a/extra/irc/messages/messages-tests.factor +++ b/extra/irc/messages/messages-tests.factor @@ -1,4 +1,4 @@ -USING: kernel tools.test accessors arrays qualified +USING: kernel tools.test accessors arrays irc.messages irc.messages.private ; EXCLUDE: sequences => join ; IN: irc.messages.tests diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 8054dc8075..c88bbc072a 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Bruno Deferrari ! See http://factorcode.org/license.txt for BSD license. -USING: kernel fry splitting ascii calendar accessors combinators qualified +USING: kernel fry splitting ascii calendar accessors combinators arrays classes.tuple math.order ; RENAME: join sequences => sjoin EXCLUDE: sequences => join ; diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index fd64e9a07e..59e4cf6cb4 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -3,7 +3,7 @@ USING: accessors kernel threads combinators concurrency.mailboxes sequences strings hashtables splitting fry assocs hashtables colors - sorting qualified unicode.collation math.order + sorting unicode.collation math.order ui ui.gadgets ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs ui.gadgets.grids ui.gadgets.packs ui.gadgets.labels diff --git a/extra/joystick-demo/joystick-demo.factor b/extra/joystick-demo/joystick-demo.factor index 6a0b9f728f..9e457c7bdd 100755 --- a/extra/joystick-demo/joystick-demo.factor +++ b/extra/joystick-demo/joystick-demo.factor @@ -1,7 +1,7 @@ USING: ui ui.gadgets sequences kernel arrays math colors ui.render math.vectors accessors fry ui.gadgets.packs game-input ui.gadgets.labels ui.gadgets.borders alarms -calendar locals combinators.lib strings ui.gadgets.buttons +calendar locals strings ui.gadgets.buttons combinators math.parser assocs threads ; IN: joystick-demo @@ -51,9 +51,9 @@ M: axis-gadget pref-dim* drop SIZE ; [ (xy>loc) ] dip (z>loc) ; : move-axis ( gadget x y z -- ) - (xyz>loc) rot + (xyz>loc) rot tuck [ indicator>> (>>loc) ] - [ z-indicator>> (>>loc) ] bi, bi* ; + [ z-indicator>> (>>loc) ] 2bi* ; : move-pov ( gadget pov -- ) swap pov>> [ interior>> -rot = [ gray ] [ white ] if >>color drop ] @@ -82,10 +82,10 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ; [ >>controller ] [ product-string