From 0efa16c1f1ad60c7e3a61292c9695d47ed691969 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 25 Jun 2016 17:43:42 -0700 Subject: [PATCH] factor: rename :> to set: --- .../3d-matrix-scalar/3d-matrix-scalar.factor | 6 +- .../3d-matrix-vector/3d-matrix-vector.factor | 6 +- benchmarks/benchmark/ant/ant.factor | 8 +- benchmarks/benchmark/beust2/beust2.factor | 8 +- benchmarks/benchmark/fasta/fasta.factor | 10 +- benchmarks/benchmark/fib7/fib7.factor | 4 +- .../matrix-exponential-scalar.factor | 4 +- .../matrix-exponential-simd.factor | 2 +- benchmarks/benchmark/pidigits/pidigits.factor | 2 +- benchmarks/benchmark/sieve/sieve.factor | 2 +- .../benchmark/yuv-to-rgb/yuv-to-rgb.factor | 8 +- collections/bitstreams/bitstreams.factor | 18 +-- .../disjoint-sets/disjoint-sets.factor | 2 +- collections/dlists/dlists-tests.factor | 24 ++-- collections/documents/documents.factor | 6 +- collections/heaps/heaps.factor | 6 +- .../io/files/acls/macosx/macosx.factor | 6 +- collections/io/random/random.factor | 4 +- collections/io/serial/windows/windows.factor | 2 +- collections/io/streams/peek/peek.factor | 8 +- collections/memory/pools/pools.factor | 2 +- .../hashtables/nodes/bitmap/bitmap.factor | 38 +++--- .../nodes/collision/collision.factor | 6 +- .../hashtables/nodes/full/full.factor | 14 +-- .../hashtables/nodes/leaf/leaf.factor | 2 +- collections/sequences/extras/extras.factor | 24 ++-- .../sequences/inserters/inserters.factor | 6 +- collections/sequences/parser/parser.factor | 10 +- collections/sequences/product/product.factor | 6 +- collections/sets/extras/extras.factor | 4 +- .../splitting/monotonic/monotonic.factor | 2 +- core/bootstrap/syntax.factor | 2 +- core/locals/errors/errors.factor | 6 +- core/locals/locals-docs.factor | 74 +++++------ core/locals/locals-tests.factor | 86 ++++++------- core/locals/parser/parser-docs.factor | 2 +- core/locals/parser/parser-tests.factor | 4 +- .../rewrite/point-free/point-free.factor | 2 +- core/locals/rewrite/sugar/sugar.factor | 2 +- core/modern/lexer/lexer.factor | 32 ++--- core/modern/modern.factor | 28 ++--- core/modern/slices/slices.factor | 22 ++-- core/multiline/multiline.factor | 2 +- core/stack-checker/backend/backend.factor | 14 +-- .../known-words/known-words.factor | 8 +- core/syntax/syntax.factor | 4 +- core/typed/namespaces/namespaces.factor | 2 +- core/typed/typed.factor | 2 +- demos/boids/boids.factor | 2 +- demos/boids/simulation/simulation.factor | 8 +- demos/project-euler/073/073.factor | 2 +- demos/project-euler/150/150.factor | 2 +- .../balanced-brackets.factor | 4 +- .../bitmap-bezier/bitmap-bezier.factor | 2 +- .../bitmap-line/bitmap-line.factor | 18 +-- .../continued-fraction.factor | 4 +- .../count-the-coins/count-the-coins.factor | 2 +- demos/rosetta-code/dice7/dice7.factor | 2 +- demos/rosetta-code/gray-code/gray-code.factor | 2 +- .../hamming-lazy/hamming-lazy.factor | 6 +- demos/rosetta-code/knapsack/knapsack.factor | 12 +- demos/rosetta-code/n-queens/n-queens.factor | 2 +- demos/rosetta-code/odd-word/odd-word.factor | 6 +- demos/smalltalk/compiler/compiler.factor | 2 +- demos/talks/otug-talk/otug-talk.factor | 2 +- ffi/cairo-samples/cairo-samples.factor | 24 ++-- ffi/cocoa/enumeration/enumeration.factor | 4 +- ffi/cocoa/subclassing/subclassing.factor | 4 +- ffi/core-text/core-text-tests.factor | 4 +- ffi/core-text/core-text.factor | 26 ++-- ffi/cuda/devices/devices.factor | 8 +- ffi/cuda/nvcc/nvcc.factor | 2 +- ffi/curses/curses.factor | 2 +- ffi/ecdsa/ecdsa.factor | 20 +-- ffi/fftw/fftw.factor | 2 +- ffi/gdbm/gdbm.factor | 2 +- .../gobject-introspection.factor | 2 +- .../hello-world/hello-world.factor | 10 +- ffi/gtk-samples/opengl/opengl.factor | 14 +-- ffi/macho/macho.factor | 2 +- ffi/mongodb/connection/connection.factor | 6 +- ffi/mongodb/driver/driver.factor | 4 +- ffi/mongodb/operations/operations.factor | 2 +- ffi/opencl/ffi/ffi-tests.factor | 16 +-- ffi/opencl/opencl-tests.factor | 16 +-- ffi/opengl/opengl.factor | 8 +- ffi/opengl/textures/textures.factor | 2 +- ffi/python/syntax/syntax.factor | 2 +- ffi/unix/unix.factor | 14 +-- ffi/windows/registry/registry.factor | 42 +++---- ffi/windows/streams/streams.factor | 12 +- ffi/windows/uniscribe/uniscribe.factor | 2 +- ffi/x11/xinput2/ffi/ffi.factor | 6 +- frameworks/db/sqlite/sqlite.factor | 4 +- .../furnace/auth/providers/providers.factor | 4 +- frameworks/furnace/recaptcha/recaptcha.factor | 4 +- frameworks/game/debug/debug.factor | 2 +- frameworks/game/debug/tests/tests.factor | 2 +- .../input/demos/joysticks/joysticks.factor | 2 +- frameworks/game/input/iokit/iokit.factor | 2 +- frameworks/game/models/util/util.factor | 6 +- frameworks/gpu/buffers/buffers.factor | 16 +-- frameworks/gpu/demos/bunny/bunny.factor | 2 +- frameworks/gpu/demos/raytrace/raytrace.factor | 4 +- frameworks/gpu/effects/blur/blur.factor | 4 +- frameworks/gpu/effects/step/step.factor | 2 +- .../gpu/framebuffers/framebuffers.factor | 2 +- frameworks/gpu/render/render.factor | 34 ++--- frameworks/gpu/shaders/shaders.factor | 40 +++--- frameworks/gpu/textures/textures.factor | 20 +-- frameworks/gpu/util/util.factor | 2 +- frameworks/gpu/util/wasd/wasd.factor | 18 +-- frameworks/ui/backend/cocoa/cocoa.factor | 4 +- .../ui/backend/cocoa/views/views.factor | 10 +- frameworks/ui/backend/gtk/gtk.factor | 12 +- frameworks/ui/backend/gtk/io/unix/unix.factor | 2 +- frameworks/ui/backend/x11/x11.factor | 8 +- .../baseline-alignment.factor | 14 +-- frameworks/ui/gadgets/editors/editors.factor | 2 +- .../ui/gadgets/grid-lines/grid-lines.factor | 2 +- .../search-tables/search-tables.factor | 2 +- frameworks/ui/gadgets/tables/tables.factor | 2 +- .../ui/tools/error-list/error-list.factor | 2 +- frameworks/ui/tools/listener/listener.factor | 4 +- games/fluids/fluids.factor | 6 +- games/jamshred/player/player.factor | 4 +- games/jamshred/tunnel/tunnel.factor | 12 +- games/snake-game/sprites/sprites.factor | 12 +- games/space-invaders/space-invaders.factor | 2 +- games/terrain/terrain.factor | 30 ++--- .../cxx/demangle/libstdcxx/libstdcxx.factor | 6 +- language/alien/data/data.factor | 2 +- language/alien/data/map/map.factor | 6 +- language/alien/fortran/fortran.factor | 4 +- .../libraries/finder/macosx/macosx.factor | 8 +- language/alien/parser/parser.factor | 6 +- .../remote-control-tests.factor | 2 +- language/bootstrap/image/image.factor | 2 +- .../image/primitives/primitives.factor | 4 +- language/channels/examples/examples.factor | 4 +- .../struct/bit-accessors/bit-accessors.factor | 8 +- language/classes/struct/struct.factor | 8 +- language/combinators/tuple/tuple.factor | 6 +- .../cfg/alias-analysis/alias-analysis.factor | 10 +- .../branch-splitting/branch-splitting.factor | 2 +- .../build-stack-frame.factor | 4 +- .../cfg/builder/alien/boxing/boxing.factor | 4 +- .../dataflow-analysis.factor | 4 +- .../compiler/cfg/dominance/dominance.factor | 4 +- .../compiler/cfg/gc-checks/gc-checks.factor | 10 +- language/compiler/cfg/gvn/gvn.factor | 2 +- .../cfg/intrinsics/alien/alien.factor | 2 +- .../cfg/intrinsics/allot/allot.factor | 14 +-- .../intrinsics/simd/backend/backend.factor | 2 +- .../cfg/intrinsics/simd/simd-tests.factor | 2 +- .../compiler/cfg/intrinsics/simd/simd.factor | 118 +++++++++--------- .../cfg/intrinsics/slots/slots.factor | 6 +- .../allocation/splitting/splitting.factor | 4 +- .../live-intervals/live-intervals.factor | 8 +- .../cfg/linear-scan/resolve/resolve.factor | 6 +- .../compiler/cfg/liveness/liveness.factor | 2 +- .../cfg/parallel-copy/parallel-copy.factor | 6 +- .../conversion/conversion.factor | 10 +- .../representations/peephole/peephole.factor | 2 +- .../representations/rewrite/rewrite.factor | 4 +- .../selection/selection.factor | 2 +- language/compiler/cfg/ssa/cssa/cssa.factor | 10 +- .../cfg/ssa/interference/interference.factor | 10 +- .../compiler/cfg/utilities/utilities.factor | 2 +- .../value-numbering/value-numbering.factor | 2 +- language/compiler/codegen/codegen.factor | 4 +- language/compiler/tests/curry.factor | 2 +- language/compiler/tree/builder/builder.factor | 2 +- .../tree/dead-code/recursive/recursive.factor | 14 +-- .../tree/dead-code/simple/simple.factor | 4 +- .../known-words/known-words.factor | 4 +- .../propagation/recursive/recursive.factor | 2 +- language/compiler/utilities/utilities.factor | 4 +- language/constructors/constructors.factor | 4 +- language/cpu/ppc/assembler/assembler.factor | 4 +- language/cpu/ppc/ppc.factor | 22 ++-- language/cpu/x86/sse/sse.factor | 6 +- language/cpu/x86/x86.factor | 22 ++-- language/interpolate/interpolate-tests.factor | 2 +- language/interpolate/interpolate.factor | 4 +- language/io/encodings/gb18030/gb18030.factor | 2 +- language/io/encodings/string/string.factor | 6 +- language/io/files/unique/unique.factor | 8 +- language/io/files/windows/windows.factor | 4 +- language/io/launcher/unix/unix-tests.factor | 4 +- language/io/mmap/windows/windows.factor | 4 +- language/io/monitors/macosx/macosx.factor | 2 +- language/io/ports/ports.factor | 12 +- .../io/sockets/secure/openssl/openssl.factor | 8 +- .../io/sockets/secure/windows/windows.factor | 8 +- language/io/sockets/sockets.factor | 8 +- language/io/sockets/unix/unix.factor | 2 +- language/io/sockets/windows/windows.factor | 4 +- language/io/streams/limited/limited.factor | 2 +- .../locals/prettyprint/prettyprint.factor | 4 +- language/models/product/product-tests.factor | 10 +- .../parser-combinators.factor | 4 +- language/peg/ebnf/ebnf.factor | 6 +- language/peg/peg.factor | 16 +-- language/threads/threads-tests.factor | 2 +- libs/audio/aiff/aiff.factor | 2 +- libs/audio/engine/engine.factor | 36 +++--- libs/audio/engine/test/test.factor | 16 +-- libs/audio/gadget/gadget.factor | 4 +- libs/audio/vorbis/vorbis.factor | 16 +-- libs/audio/wav/wav.factor | 2 +- libs/binary-search/binary-search.factor | 4 +- libs/boyer-moore/boyer-moore.factor | 6 +- libs/c/lexer/lexer.factor | 4 +- libs/c/preprocessor/preprocessor.factor | 6 +- libs/calendar/calendar.factor | 36 +++--- libs/calendar/holidays/holidays.factor | 2 +- libs/checksums/fletcher/fletcher.factor | 6 +- libs/checksums/hmac/hmac.factor | 4 +- libs/checksums/sha/sha.factor | 10 +- libs/checksums/xxhash/xxhash.factor | 8 +- libs/chipmunk/demo/demo.factor | 12 +- libs/colors/distances/distances.factor | 114 ++++++++--------- libs/colors/hsl/hsl.factor | 12 +- libs/colors/hsv/hsv.factor | 4 +- libs/colors/lab/lab.factor | 20 +-- libs/colors/lch/lch.factor | 16 +-- libs/colors/luv/luv.factor | 32 ++--- libs/colors/mix/mix.factor | 12 +- libs/colors/ryb/ryb.factor | 8 +- libs/colors/xyy/xyy.factor | 4 +- libs/colors/xyz/xyz.factor | 4 +- libs/colors/yiq/yiq.factor | 12 +- libs/colors/yuv/yuv.factor | 8 +- libs/compression/huffman/huffman.factor | 6 +- libs/compression/inflate/inflate.factor | 10 +- libs/compression/run-length/run-length.factor | 24 ++-- .../exchangers/exchangers-tests.factor | 10 +- libs/concurrency/flags/flags-tests.factor | 10 +- libs/concurrency/locks/locks-tests.factor | 30 ++--- libs/crypto/aes/aes.factor | 24 ++-- libs/crypto/passwd-md5/passwd-md5.factor | 2 +- libs/decimals/decimals.factor | 2 +- libs/elf/elf.factor | 58 ++++----- libs/enigma/enigma.factor | 6 +- libs/euler/b-rep/b-rep-tests.factor | 6 +- libs/euler/b-rep/b-rep.factor | 4 +- libs/euler/b-rep/examples/examples.factor | 6 +- libs/euler/b-rep/io/obj/obj.factor | 22 ++-- .../b-rep/subdivision/subdivision.factor | 58 ++++----- .../b-rep/triangulation/triangulation.factor | 8 +- libs/euler/modeling/modeling.factor | 22 ++-- libs/euler/operators/operators.factor | 102 +++++++-------- libs/farkup/farkup.factor | 4 +- libs/fullscreen/fullscreen.factor | 4 +- libs/globs/globs.factor | 8 +- libs/gml/core/core.factor | 4 +- libs/gml/macros/macros.factor | 6 +- libs/gml/parser/parser.factor | 4 +- libs/gml/runtime/runtime.factor | 4 +- libs/gml/viewer/viewer.factor | 54 ++++---- libs/html/components/components.factor | 10 +- libs/images/atlas/atlas.factor | 36 +++--- libs/images/images.factor | 14 +-- libs/images/loader/cocoa/cocoa.factor | 4 +- libs/images/loader/gdiplus/gdiplus.factor | 8 +- libs/images/loader/gtk/gtk.factor | 4 +- .../images/normalization/normalization.factor | 4 +- libs/images/pbm/pbm.factor | 8 +- libs/images/pgm/pgm.factor | 14 +-- libs/images/png/png.factor | 50 ++++---- libs/images/ppm/ppm.factor | 12 +- libs/images/tessellation/tessellation.factor | 6 +- libs/images/tga/tga.factor | 74 +++++------ libs/infix/infix-docs.factor | 8 +- libs/infix/infix-tests.factor | 34 ++--- libs/koszul/koszul.factor | 2 +- libs/lcs/lcs.factor | 2 +- libs/math/approx/approx.factor | 6 +- libs/math/binpack/binpack.factor | 4 +- libs/math/cardinality/cardinality.factor | 10 +- libs/math/combinatorics/combinatorics.factor | 8 +- libs/math/extras/extras.factor | 8 +- libs/math/floats/env/env.factor | 6 +- .../matrices/elimination/elimination.factor | 4 +- libs/math/matrices/matrices.factor | 30 ++--- libs/math/matrices/simd/simd.factor | 78 ++++++------ libs/math/primes/erato/erato.factor | 6 +- libs/math/primes/erato/fast/fast.factor | 6 +- .../primes/miller-rabin/miller-rabin.factor | 6 +- .../solovay-strassen/solovay-strassen.factor | 2 +- libs/math/quaternions/quaternions.factor | 6 +- libs/math/splines/splines.factor | 10 +- libs/math/splines/viewer/viewer.factor | 12 +- libs/math/statistics/statistics.factor | 14 +-- libs/math/transforms/fft/fft.factor | 6 +- .../conversion/conversion-tests.factor | 10 +- .../math/vectors/conversion/conversion.factor | 12 +- .../vectors/simd/intrinsics/intrinsics.factor | 36 +++--- libs/math/vectors/simd/simd-tests.factor | 28 ++--- libs/noise/noise.factor | 24 ++-- libs/nurbs/nurbs.factor | 28 ++--- libs/oauth/oauth.factor | 8 +- libs/picomath/picomath.factor | 36 +++--- libs/poker/poker.factor | 10 +- libs/pong/pong.factor | 8 +- libs/processing/shapes/shapes.factor | 4 +- .../lagged-fibonacci/lagged-fibonacci.factor | 18 +-- libs/random/random.factor | 40 +++--- libs/random/sfmt/sfmt.factor | 16 +-- libs/regexp/dfa/dfa.factor | 8 +- libs/regexp/disambiguate/disambiguate.factor | 2 +- libs/regexp/minimize/minimize.factor | 8 +- libs/regexp/nfa/nfa.factor | 10 +- libs/sorting/quick/quick.factor | 2 +- libs/tzinfo/tzinfo.factor | 8 +- libs/unicode/breaks/breaks.factor | 2 +- libs/unicode/case/case.factor | 2 +- libs/unicode/collation/collation.factor | 2 +- libs/unicode/data/data.factor | 2 +- libs/unicode/normalize/normalize.factor | 2 +- libs/units/reduction/reduction.factor | 4 +- libs/uu/uu.factor | 10 +- libs/xml/syntax/syntax-docs.factor | 10 +- libs/xml/syntax/syntax-tests.factor | 2 +- libs/xml/tokenize/tokenize.factor | 10 +- libs/xmode/code2html/code2html.factor | 4 +- libs/yaml/dbg/dbg.factor | 8 +- libs/yaml/yaml-tests.factor | 16 +-- libs/yaml/yaml.factor | 20 +-- libs/z-algorithm/z-algorithm.factor | 10 +- tools/codebook/codebook.factor | 38 +++--- tools/graphviz/graphviz-tests.factor | 4 +- tools/graphviz/render/render.factor | 2 +- tools/help/html/html.factor | 2 +- tools/mason/common/common.factor | 8 +- tools/mason/report/report.factor | 4 +- tools/pdf/layout/layout.factor | 6 +- tools/spider/spider.factor | 10 +- tools/tools/annotations/annotations.factor | 4 +- tools/tools/deploy/backend/backend.factor | 6 +- tools/tools/deploy/embed/embed.factor | 2 +- tools/tools/deploy/shaker/shaker.factor | 4 +- tools/tools/deploy/windows/ico/ico.factor | 12 +- .../data-heap-reader/data-heap-reader.factor | 2 +- tools/tools/image-analyzer/utils/utils.factor | 2 +- tools/tools/profiler/sampling/sampling.factor | 6 +- tools/tools/ps/windows/windows.factor | 6 +- tools/tools/test/test.factor | 2 +- tools/tools/walker/debug/debug.factor | 2 +- unmaintained/alien/cxx/cxx.factor | 12 +- .../alien/marshall/structs/structs.factor | 2 +- .../lowlevel/gstreamer/gstreamer.factor | 12 +- unmaintained/images/jpeg/jpeg.factor | 12 +- .../processing/rotation/rotation.factor | 6 +- unmaintained/modern/compiler/compiler.factor | 2 +- .../mongodb/gridfs/gridfs/gridfs.factor | 6 +- unmaintained/recipes/recipes.factor | 16 +-- unmaintained/sudokus/sudokus.factor | 2 +- unmaintained/tc-lisp-talk/tc-lisp-talk.factor | 2 +- unmaintained/ui/gadgets/alerts/alerts.factor | 6 +- webapps/webapps/mason/version/version.factor | 4 +- 362 files changed, 1883 insertions(+), 1883 deletions(-) diff --git a/benchmarks/benchmark/3d-matrix-scalar/3d-matrix-scalar.factor b/benchmarks/benchmark/3d-matrix-scalar/3d-matrix-scalar.factor index 9515a330ef..d7c49d7fa8 100644 --- a/benchmarks/benchmark/3d-matrix-scalar/3d-matrix-scalar.factor +++ b/benchmarks/benchmark/3d-matrix-scalar/3d-matrix-scalar.factor @@ -12,10 +12,10 @@ IN: benchmark.3d-matrix-scalar location vneg translation-matrix4 m. m. ; :: 3d-matrix-scalar-benchmark ( -- ) - f :> result! + f set: result! 100000 [ - { 1024.0 768.0 } 0.7 0.25 1024.0 p-matrix :> p - 3.0 1.0 { 10.0 -0.0 2.0 } mv-matrix :> mv + { 1024.0 768.0 } 0.7 0.25 1024.0 p-matrix set: p + 3.0 1.0 { 10.0 -0.0 2.0 } mv-matrix set: mv mv p m. result! ] times result . ; diff --git a/benchmarks/benchmark/3d-matrix-vector/3d-matrix-vector.factor b/benchmarks/benchmark/3d-matrix-vector/3d-matrix-vector.factor index d9e071d7b0..4786f2051b 100644 --- a/benchmarks/benchmark/3d-matrix-vector/3d-matrix-vector.factor +++ b/benchmarks/benchmark/3d-matrix-vector/3d-matrix-vector.factor @@ -16,10 +16,10 @@ TYPED:: mv-matrix ( pitch: float yaw: float location: float-4 -- matrix: matrix4 location vneg translation-matrix4 m4. m4. ; :: 3d-matrix-vector-benchmark ( -- ) - f :> result! + f set: result! 100000 [ - float-4{ 1024.0 768.0 0.0 0.0 } 0.7 0.25 1024.0 p-matrix :> p - 3.0 1.0 float-4{ 10.0 -0.0 2.0 0.0 } mv-matrix :> mv + float-4{ 1024.0 768.0 0.0 0.0 } 0.7 0.25 1024.0 p-matrix set: p + 3.0 1.0 float-4{ 10.0 -0.0 2.0 0.0 } mv-matrix set: mv mv p m4. result! ] times result . ; diff --git a/benchmarks/benchmark/ant/ant.factor b/benchmarks/benchmark/ant/ant.factor index 10936476da..0c7c2ba123 100644 --- a/benchmarks/benchmark/ant/ant.factor +++ b/benchmarks/benchmark/ant/ant.factor @@ -35,14 +35,14 @@ C: point ; [ x>> ] [ y>> ] bi [ sum-digits ] bi@ + 25 <= ; inline :: ant-benchmark ( -- ) - 200000 :> seen - 100000 :> stack - 0 :> total! + 200000 set: seen + 100000 set: stack + 0 set: total! 1000 1000 stack push [ stack empty? ] [ - stack pop :> p + stack pop set: p p seen ?adjoin [ p walkable? [ total 1 + total! diff --git a/benchmarks/benchmark/beust2/beust2.factor b/benchmarks/benchmark/beust2/beust2.factor index 18262d0270..f71b6a4ee4 100644 --- a/benchmarks/benchmark/beust2/beust2.factor +++ b/benchmarks/benchmark/beust2/beust2.factor @@ -7,9 +7,9 @@ IN: benchmark.beust2 :: (count-numbers) ( remaining first value used max listener: ( -- ) -- ? ) 10 first - iota |[ i | - i first + :> digit - digit 2^ :> mask - i value + :> value' + i first + set: digit + digit 2^ set: mask + i value + set: value' used mask bitand zero? [ value max > [ t ] [ remaining 1 <= [ @@ -31,7 +31,7 @@ IN: benchmark.beust2 10 iota [ 1 + 1 1 0 max listener (count-numbers) ] any? drop ; inline :: beust2-benchmark ( -- ) - 0 :> i! + 0 set: i! 5000000000 [ i 1 + i! ] count-numbers i 7063290 assert= ; diff --git a/benchmarks/benchmark/fasta/fasta.factor b/benchmarks/benchmark/fasta/fasta.factor index c62e66503e..f07f323682 100644 --- a/benchmarks/benchmark/fasta/fasta.factor +++ b/benchmarks/benchmark/fasta/fasta.factor @@ -68,15 +68,15 @@ TYPED: write-random-fasta ( seed: float n: fixnum chars: byte-array floats: doub $[ _ _ make-random-fasta ] split-lines ; TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum ) - alu length :> kn + alu length set: kn len iota [ k + kn mod alu nth-unsafe ] "" map-as print k len + ; : write-repeat-fasta ( n alu desc id -- ) write-description let[ - :> alu - 0 :> k! + set: alu + 0 set: k! |[ len | k len alu make-repeat-fasta k! ] split-lines ] ; @@ -84,8 +84,8 @@ TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum ) homo-sapiens make-cumulative IUB make-cumulative let[ - :> ( n out IUB-chars IUB-floats homo-sapiens-chars homo-sapiens-floats ) - initial-seed :> seed + set: ( n out IUB-chars IUB-floats homo-sapiens-chars homo-sapiens-floats ) + initial-seed set: seed out ascii [ n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta diff --git a/benchmarks/benchmark/fib7/fib7.factor b/benchmarks/benchmark/fib7/fib7.factor index 3c9febcd7c..e3cdad678c 100644 --- a/benchmarks/benchmark/fib7/fib7.factor +++ b/benchmarks/benchmark/fib7/fib7.factor @@ -3,8 +3,8 @@ IN: benchmark.fib7 :: matrix-fib ( m -- n ) m 0 >= [ m throw ] unless - m 2 >base [ char: 1 = ] { } map-as :> bits - 1 :> a! 0 :> b! 1 :> c! + m 2 >base [ char: 1 = ] { } map-as set: bits + 1 set: a! 0 set: b! 1 set: c! bits [ [ a c + b * diff --git a/benchmarks/benchmark/matrix-exponential-scalar/matrix-exponential-scalar.factor b/benchmarks/benchmark/matrix-exponential-scalar/matrix-exponential-scalar.factor index 7ede4c5d5f..6ad4774aaa 100644 --- a/benchmarks/benchmark/matrix-exponential-scalar/matrix-exponential-scalar.factor +++ b/benchmarks/benchmark/matrix-exponential-scalar/matrix-exponential-scalar.factor @@ -14,8 +14,8 @@ IN: benchmark.matrix-exponential-scalar ] each ; :: matrix-exponential-scalar-benchmark ( -- ) - f :> result! - 4 identity-matrix :> i4 + f set: result! + 4 identity-matrix set: i4 10000 [ i4 20 e^m result! ] times diff --git a/benchmarks/benchmark/matrix-exponential-simd/matrix-exponential-simd.factor b/benchmarks/benchmark/matrix-exponential-simd/matrix-exponential-simd.factor index c4e5a8cd90..5db656598b 100644 --- a/benchmarks/benchmark/matrix-exponential-simd/matrix-exponential-simd.factor +++ b/benchmarks/benchmark/matrix-exponential-simd/matrix-exponential-simd.factor @@ -9,7 +9,7 @@ TYPED:: e^m4 ( m: matrix4 iterations: fixnum -- e^m: matrix4 ) ] each ; :: matrix-exponential-simd-benchmark ( -- ) - f :> result! + f set: result! 10000 [ identity-matrix4 20 e^m4 result! ] times diff --git a/benchmarks/benchmark/pidigits/pidigits.factor b/benchmarks/benchmark/pidigits/pidigits.factor index 5e45205660..59daf05ffd 100644 --- a/benchmarks/benchmark/pidigits/pidigits.factor +++ b/benchmarks/benchmark/pidigits/pidigits.factor @@ -36,7 +36,7 @@ IN: benchmark.pidigits :: (pidigits) ( k z n row col -- ) n 0 > [ - z next :> y + z next set: y z y safe? [ col 10 = [ row 10 + y "\t:%d\n%d" printf diff --git a/benchmarks/benchmark/sieve/sieve.factor b/benchmarks/benchmark/sieve/sieve.factor index 01ce745a59..19a30d1dab 100644 --- a/benchmarks/benchmark/sieve/sieve.factor +++ b/benchmarks/benchmark/sieve/sieve.factor @@ -3,7 +3,7 @@ sequences ; IN: benchmark.sieve :: sieve ( n -- #primes ) - n dup odd? [ 1 + ] when 2/ :> sieve + n dup odd? [ 1 + ] when 2/ set: sieve t 0 sieve set-nth 3 n sqrt 2 |[ i | diff --git a/benchmarks/benchmark/yuv-to-rgb/yuv-to-rgb.factor b/benchmarks/benchmark/yuv-to-rgb/yuv-to-rgb.factor index 3da80ec192..6a62f6951c 100644 --- a/benchmarks/benchmark/yuv-to-rgb/yuv-to-rgb.factor +++ b/benchmarks/benchmark/yuv-to-rgb/yuv-to-rgb.factor @@ -18,10 +18,10 @@ STRUCT: yuv-buffer { v void* } ; :: fake-data ( -- rgb yuv ) - 1600 :> w - 1200 :> h - yuv-buffer :> buffer - w h * 3 * :> rgb + 1600 set: w + 1200 set: h + yuv-buffer set: buffer + w h * 3 * set: rgb rgb buffer w >>y_width h >>y_height diff --git a/collections/bitstreams/bitstreams.factor b/collections/bitstreams/bitstreams.factor index 11051cfc42..d36e7a256a 100644 --- a/collections/bitstreams/bitstreams.factor +++ b/collections/bitstreams/bitstreams.factor @@ -109,20 +109,20 @@ ERROR: not-enough-widthed-bits widthed n ; [ swap bits>> ] B{ } produce-as nip swap ; :: |widthed ( widthed1 widthed2 -- widthed3 ) - widthed1 bits>> :> bits1 - widthed1 #bits>> :> #bits1 - widthed2 bits>> :> bits2 - widthed2 #bits>> :> #bits2 + widthed1 bits>> set: bits1 + widthed1 #bits>> set: #bits1 + widthed2 bits>> set: bits2 + widthed2 #bits>> set: #bits2 bits1 #bits2 shift bits2 bitor #bits1 #bits2 + ; PRIVATE> M:: lsb0-bit-writer poke ( value n bs -- ) - value n :> widthed + value n set: widthed widthed - bs widthed>> #bits>> 8 swap - split-widthed :> ( byte remainder ) - byte bs widthed>> |widthed :> new-byte + bs widthed>> #bits>> 8 swap - split-widthed set: ( byte remainder ) + byte bs widthed>> |widthed set: new-byte new-byte #bits>> 8 = [ new-byte bits>> bs bytes>> push zero-widthed bs widthed<< @@ -151,7 +151,7 @@ ERROR: not-enough-bits n bit-reader ; neg shift n bits ; :: adjust-bits ( n bs -- ) - n 8 /mod :> ( #bytes #bits ) + n 8 /mod set: ( #bytes #bits ) bs [ #bytes + ] change-byte-pos bit-pos>> #bits + dup 8 >= [ 8 - bs bit-pos<< @@ -173,7 +173,7 @@ M: msb0-bit-reader peek ( n bs -- bits ) \ be> \ subseq>bits-be (peek) ; :: bit-writer-bytes ( writer -- bytes ) - writer widthed>> #bits>> :> n + writer widthed>> #bits>> set: n n 0 = [ writer widthed>> bits>> 8 n - shift writer bytes>> push diff --git a/collections/disjoint-sets/disjoint-sets.factor b/collections/disjoint-sets/disjoint-sets.factor index 20fd5f7cff..773cf7aaa1 100644 --- a/collections/disjoint-sets/disjoint-sets.factor +++ b/collections/disjoint-sets/disjoint-sets.factor @@ -28,7 +28,7 @@ PRIVATE> GENERIC: representative ( a disjoint-set -- p ) ; M:: disjoint-set representative ( a disjoint-set -- p ) - a disjoint-set parents>> at :> p + a disjoint-set parents>> at set: p a p = [ a ] [ p disjoint-set representative [ a disjoint-set set-parent diff --git a/collections/dlists/dlists-tests.factor b/collections/dlists/dlists-tests.factor index 0944b42734..59893f50a0 100644 --- a/collections/dlists/dlists-tests.factor +++ b/collections/dlists/dlists-tests.factor @@ -118,30 +118,30 @@ TUPLE: my-node < dlist-link { obj fixnum } ; { V{ } } [ 1 over push-node-back [ [ back>> ] [ ] bi delete-node ] [ ] bi dlist>sequence ] unit-test [ V{ 1 2 } t ] |[ | - :> dl - 1 :> n1 n1 dl push-node-back - 2 :> n2 n2 dl push-node-back - 3 :> n3 n3 dl push-node-back + set: dl + 1 set: n1 n1 dl push-node-back + 2 set: n2 n2 dl push-node-back + 3 set: n3 n3 dl push-node-back n3 dl delete-node n3 assert-links dl dlist>sequence dup >dlist dl = ] unit-test [ V{ 1 3 } t ] |[ | - :> dl - 1 :> n1 n1 dl push-node-back - 2 :> n2 n2 dl push-node-back - 3 :> n3 n3 dl push-node-back + set: dl + 1 set: n1 n1 dl push-node-back + 2 set: n2 n2 dl push-node-back + 3 set: n3 n3 dl push-node-back n2 dl delete-node n2 assert-links dl dlist>sequence dup >dlist dl = ] unit-test [ V{ 2 3 } t ] |[ | - :> dl - 1 :> n1 n1 dl push-node-back - 2 :> n2 n2 dl push-node-back - 3 :> n3 n3 dl push-node-back + set: dl + 1 set: n1 n1 dl push-node-back + 2 set: n2 n2 dl push-node-back + 3 set: n3 n3 dl push-node-back n1 dl delete-node n1 assert-links dl dlist>sequence dup >dlist dl = diff --git a/collections/documents/documents.factor b/collections/documents/documents.factor index 1151ed8e19..b80eea22de 100644 --- a/collections/documents/documents.factor +++ b/collections/documents/documents.factor @@ -143,9 +143,9 @@ PRIVATE> :: set-doc-range ( string from to document -- ) from to = string empty? and [ - string split-lines :> new-lines - new-lines from text+loc :> new-to - from to document doc-range :> old-string + string split-lines set: new-lines + new-lines from text+loc set: new-to + from to document doc-range set: old-string old-string string from to new-to document add-undo new-lines from to document [ (set-doc-range) ] models:change-model new-to document update-locs diff --git a/collections/heaps/heaps.factor b/collections/heaps/heaps.factor index e2857ba526..503baf5524 100644 --- a/collections/heaps/heaps.factor +++ b/collections/heaps/heaps.factor @@ -93,7 +93,7 @@ M: heap heap-peek ( heap -- value key ) PRIVATE< :: sift-down ( heap from to -- ) - to heap data-nth :> tmp + to heap data-nth set: tmp to t [ over from > and ] [ dup up @@ -121,8 +121,8 @@ M: heap heap-push* PRIVATE< :: sift-up ( heap n -- ) - heap heap-size :> end - n heap data-nth :> tmp + heap heap-size set: end + n heap data-nth set: tmp n dup left [ dup end < ] [ dup 1 fixnum+fast diff --git a/collections/io/files/acls/macosx/macosx.factor b/collections/io/files/acls/macosx/macosx.factor index 38216693ac..3555e5a570 100644 --- a/collections/io/files/acls/macosx/macosx.factor +++ b/collections/io/files/acls/macosx/macosx.factor @@ -49,8 +49,8 @@ PRIVATE> :: acl-entry-each ( path quot -- ) [ - path file-acl &free-acl :> acl - f :> acl-entry! + path file-acl &free-acl set: acl + f set: acl-entry! acl [ acl first-acl-entry void* deref quot call [ acl next-acl-entry dup acl-entry! ] @@ -60,7 +60,7 @@ PRIVATE> :: acl-each ( path quot -- ) [ - path file-acl &free-acl :> acl + path file-acl &free-acl set: acl acl [ acl first-acl-entry drop acl quot call diff --git a/collections/io/random/random.factor b/collections/io/random/random.factor index e6c863b3d9..98dbd683fc 100644 --- a/collections/io/random/random.factor +++ b/collections/io/random/random.factor @@ -17,12 +17,12 @@ PRIVATE> f [ random zero? [ nip ] [ drop ] if ] each-numbered-line ; :: random-lines ( n -- lines ) - V{ } clone :> accum + V{ } clone set: accum |[ line line# | line# n <= [ line accum push ] [ - line# random :> r + line# random set: r r n < [ line r accum set-nth-unsafe ] when ] if ] each-numbered-line accum ; diff --git a/collections/io/serial/windows/windows.factor b/collections/io/serial/windows/windows.factor index 4ea3d5e9e4..0d955a5874 100644 --- a/collections/io/serial/windows/windows.factor +++ b/collections/io/serial/windows/windows.factor @@ -17,5 +17,5 @@ IN: io.serial.windows SetCommState win32-error=0/f ; :: with-comm-state ( duplex quot: ( dcb -- ) -- ) - duplex get-comm-state :> dcb + duplex get-comm-state set: dcb dcb clone quot curry [ dcb set-comm-state ] recover ; inline diff --git a/collections/io/streams/peek/peek.factor b/collections/io/streams/peek/peek.factor index 40e337423a..3ecaf7411b 100644 --- a/collections/io/streams/peek/peek.factor +++ b/collections/io/streams/peek/peek.factor @@ -36,8 +36,8 @@ M: peek-stream stream-read1 ] if-empty ; M:: peek-stream stream-read-unsafe ( n buf stream -- count ) - stream peeked>> :> peeked - peeked length :> #peeked + stream peeked>> set: peeked + peeked length set: #peeked #peeked 0 = [ n buf stream stream>> stream-read-unsafe ] [ @@ -48,12 +48,12 @@ M:: peek-stream stream-read-unsafe ( n buf stream -- count ) ] [ peeked 0 buf copy 0 peeked shorten - n #peeked - :> n' + n #peeked - set: n' stream stream>> input-port? [ #peeked buf ] [ buf #peeked tail-slice - ] if :> buf' + ] if set: buf' n' buf' stream stream-read-unsafe #peeked + ] if ] if ; diff --git a/collections/memory/pools/pools.factor b/collections/memory/pools/pools.factor index 21a029e391..615f1c471e 100644 --- a/collections/memory/pools/pools.factor +++ b/collections/memory/pools/pools.factor @@ -19,7 +19,7 @@ TUPLE: pool PRIVATE< :: copy-tuple ( from to -- to ) - from tuple-size :> size + from tuple-size set: size size |[ n | n from array-nth n to set-array-nth ] each-integer to ; inline diff --git a/collections/persistent/hashtables/nodes/bitmap/bitmap.factor b/collections/persistent/hashtables/nodes/bitmap/bitmap.factor index d623e90019..9b03056b76 100644 --- a/collections/persistent/hashtables/nodes/bitmap/bitmap.factor +++ b/collections/persistent/hashtables/nodes/bitmap/bitmap.factor @@ -10,10 +10,10 @@ IN: persistent.hashtables.nodes.bitmap : index ( bit bitmap -- n ) [ 1 - ] dip bitand bit-count ; inline M:: bitmap-node (entry-at) ( key hashcode bitmap-node -- entry ) - bitmap-node shift>> :> shift - hashcode shift bitpos :> bit - bitmap-node bitmap>> :> bitmap - bitmap-node nodes>> :> nodes + bitmap-node shift>> set: shift + hashcode shift bitpos set: bit + bitmap-node bitmap>> set: bitmap + bitmap-node nodes>> set: nodes bitmap bit bitand 0 eq? [ f ] [ key hashcode bit bitmap index nodes nth-unsafe @@ -21,22 +21,22 @@ M:: bitmap-node (entry-at) ( key hashcode bitmap-node -- entry ) ] if ; M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-leaf ) - bitmap-node shift>> :> shift - hashcode shift bitpos :> bit - bitmap-node bitmap>> :> bitmap - bit bitmap index :> idx - bitmap-node nodes>> :> nodes + bitmap-node shift>> set: shift + hashcode shift bitpos set: bit + bitmap-node bitmap>> set: bitmap + bit bitmap index set: idx + bitmap-node nodes>> set: nodes bitmap bit bitand 0 eq? [ - value key hashcode :> new-leaf + value key hashcode set: new-leaf bitmap bit bitor new-leaf idx nodes insert-nth shift new-leaf ] [ - idx nodes nth :> n - shift radix-bits + value key hashcode n (new-at) :> ( n' new-leaf ) + idx nodes nth set: n + shift radix-bits + value key hashcode n (new-at) set: ( n' new-leaf ) n n' eq? [ bitmap-node ] [ @@ -49,14 +49,14 @@ M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-l ] if ; M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' ) - hashcode bitmap-node shift>> bitpos :> bit - bitmap-node bitmap>> :> bitmap - bitmap-node nodes>> :> nodes - bitmap-node shift>> :> shift + hashcode bitmap-node shift>> bitpos set: bit + bitmap-node bitmap>> set: bitmap + bitmap-node nodes>> set: nodes + bitmap-node shift>> set: shift bit bitmap bitand 0 eq? [ bitmap-node ] [ - bit bitmap index :> idx - idx nodes nth-unsafe :> n - key hashcode n (pluck-at) :> n' + bit bitmap index set: idx + idx nodes nth-unsafe set: n + key hashcode n (pluck-at) set: n' n n' eq? [ bitmap-node ] [ diff --git a/collections/persistent/hashtables/nodes/collision/collision.factor b/collections/persistent/hashtables/nodes/collision/collision.factor index 7e47583b65..4cf11927ac 100644 --- a/collections/persistent/hashtables/nodes/collision/collision.factor +++ b/collections/persistent/hashtables/nodes/collision/collision.factor @@ -15,7 +15,7 @@ M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node ) M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node ) hashcode collision-node hashcode>> eq? [ - key hashcode collision-node find-index drop :> idx + key hashcode collision-node find-index drop set: idx idx [ idx collision-node leaves>> smash [ collision-node hashcode>> @@ -26,7 +26,7 @@ M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node ) M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' added-leaf ) hashcode collision-node hashcode>> eq? [ - key hashcode collision-node find-index :> ( idx leaf-node ) + key hashcode collision-node find-index set: ( idx leaf-node ) idx [ value leaf-node value>> = [ collision-node f @@ -40,7 +40,7 @@ M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' a f ] if ] [ - value key hashcode :> new-leaf-node + value key hashcode set: new-leaf-node hashcode collision-node leaves>> new-leaf-node diff --git a/collections/persistent/hashtables/nodes/full/full.factor b/collections/persistent/hashtables/nodes/full/full.factor index 5a9cc2506d..0a704d9ca8 100644 --- a/collections/persistent/hashtables/nodes/full/full.factor +++ b/collections/persistent/hashtables/nodes/full/full.factor @@ -8,11 +8,11 @@ persistent.hashtables.nodes ; IN: persistent.hashtables.nodes.full M:: full-node (new-at) ( shift value key hashcode full-node -- node' added-leaf ) - full-node nodes>> :> nodes - hashcode full-node shift>> mask :> idx - idx nodes nth-unsafe :> n + full-node nodes>> set: nodes + hashcode full-node shift>> mask set: idx + idx nodes nth-unsafe set: n - shift radix-bits + value key hashcode n (new-at) :> ( n' new-leaf ) + shift radix-bits + value key hashcode n (new-at) set: ( n' new-leaf ) n n' eq? [ full-node ] [ @@ -21,9 +21,9 @@ M:: full-node (new-at) ( shift value key hashcode full-node -- node' added-leaf new-leaf ; M:: full-node (pluck-at) ( key hashcode full-node -- node' ) - hashcode full-node shift>> mask :> idx - idx full-node nodes>> nth :> n - key hashcode n (pluck-at) :> n' + hashcode full-node shift>> mask set: idx + idx full-node nodes>> nth set: n + key hashcode n (pluck-at) set: n' n n' eq? [ full-node diff --git a/collections/persistent/hashtables/nodes/leaf/leaf.factor b/collections/persistent/hashtables/nodes/leaf/leaf.factor index 0a15ea6305..778df8ceef 100644 --- a/collections/persistent/hashtables/nodes/leaf/leaf.factor +++ b/collections/persistent/hashtables/nodes/leaf/leaf.factor @@ -19,7 +19,7 @@ M:: leaf-node (new-at) ( shift value key hashcode leaf-node -- node' added-leaf value leaf-node value>> = [ leaf-node f ] [ value key hashcode f ] if ] [ - value key hashcode :> new-leaf + value key hashcode set: new-leaf hashcode leaf-node new-leaf 2array new-leaf ] if diff --git a/collections/sequences/extras/extras.factor b/collections/sequences/extras/extras.factor index 4dadda7424..cc9d33282d 100644 --- a/collections/sequences/extras/extras.factor +++ b/collections/sequences/extras/extras.factor @@ -30,7 +30,7 @@ IN: sequences.extras [ swap ] 2dip each-from ; inline :: subseq* ( from to seq -- subseq ) - seq length :> len + seq length set: len from [ dup 0 < [ len + ] when ] [ 0 ] if* to [ dup 0 < [ len + ] when ] [ len ] if* [ 0 len clamp ] bi@ dupd max seq subseq ; @@ -42,11 +42,11 @@ IN: sequences.extras dup length [1,b] [ clump ] with map concat ; :: each-subseq ( ... seq quot: ( ... x -- ... ) -- ... ) - seq length :> len + seq length set: len len [0,b] [ - :> from + set: from from len (a,b] [ - :> to + set: to from to seq subseq quot call ] each ] each ; inline @@ -63,16 +63,16 @@ IN: sequences.extras [ dup length [1,b] ] dip filter-all-subseqs-range ; inline :: longest-subseq ( seq1 seq2 -- subseq ) - seq1 length :> len1 - seq2 length :> len2 - 0 :> n! - 0 :> end! - len1 1 + [ len2 1 + 0 ] replicate :> table + seq1 length set: len1 + seq2 length set: len2 + 0 set: n! + 0 set: end! + len1 1 + [ len2 1 + 0 ] replicate set: table len1 [1,b] |[ x | len2 [1,b] |[ y | x 1 - seq1 nth-unsafe y 1 - seq2 nth-unsafe = [ - y 1 - x 1 - table nth-unsafe nth-unsafe 1 + :> len + y 1 - x 1 - table nth-unsafe nth-unsafe 1 + set: len len y x table nth-unsafe set-nth-unsafe len n > [ len n! x end! ] when ] [ 0 y x table nth-unsafe set-nth-unsafe ] if @@ -139,7 +139,7 @@ PRIVATE> 2tri ; inline :: slice-when ( seq quot: ( elt -- ? ) -- seq' ) - seq length :> len + seq length set: len 0 [ len dupd < ] [ dup seq quot find-from drop [ 2dup = [ 1 + ] when ] [ len ] if* @@ -211,7 +211,7 @@ ERROR: underlying-mismatch slice1 slice2 ; 2dup and [ span-slices ] [ or ] if ; :: rotate! ( seq n -- ) - seq length :> len + seq length set: len n len mod dup 0 < [ len + ] when seq bounds-check drop 0 over [ 2dup = ] [ [ seq exchange-unsafe ] [ [ 1 + ] bi@ ] 2bi diff --git a/collections/sequences/inserters/inserters.factor b/collections/sequences/inserters/inserters.factor index 4ed0245fd0..1f1a322781 100644 --- a/collections/sequences/inserters/inserters.factor +++ b/collections/sequences/inserters/inserters.factor @@ -28,9 +28,9 @@ C: appender ; INSTANCE: appender inserter ; M:: appender new-sequence ( len inserter -- sequence ) - inserter underlying>> :> underlying - underlying length :> old-length - old-length len + :> new-length + inserter underlying>> set: underlying + underlying length set: old-length + old-length len + set: new-length new-length underlying set-length underlying old-length ; inline diff --git a/collections/sequences/parser/parser.factor b/collections/sequences/parser/parser.factor index 9e1578dc41..2818bef736 100644 --- a/collections/sequences/parser/parser.factor +++ b/collections/sequences/parser/parser.factor @@ -13,7 +13,7 @@ TUPLE: sequence-parser sequence n ; 0 >>n ; :: with-sequence-parser ( sequence-parser quot -- seq/f ) - sequence-parser n>> :> n + sequence-parser n>> set: n sequence-parser quot call [ n sequence-parser n<< f ] unless* ; inline @@ -79,13 +79,13 @@ TUPLE: sequence-parser sequence n ; take-sequence drop ; :: take-until-sequence ( sequence-parser sequence -- sequence'/f ) - sequence-parser n>> :> saved - sequence length :> growing + sequence-parser n>> set: saved + sequence length set: growing sequence-parser [ current growing growing-circular-push sequence growing sequence= - ] take-until :> found + ] take-until set: found growing sequence sequence= [ found dup length growing length 1 - - head @@ -97,7 +97,7 @@ TUPLE: sequence-parser sequence n ; ] if ; :: take-until-sequence* ( sequence-parser sequence -- sequence'/f ) - sequence-parser sequence take-until-sequence :> out + sequence-parser sequence take-until-sequence set: out out [ sequence-parser [ sequence length + ] change-n drop ] when out ; diff --git a/collections/sequences/product/product.factor b/collections/sequences/product/product.factor index 1871f3bd57..dcab8facd6 100644 --- a/collections/sequences/product/product.factor +++ b/collections/sequences/product/product.factor @@ -53,14 +53,14 @@ M: product-sequence nth product@ nths ; :: product-each ( ... sequences quot: ( ... seq -- ... ) -- ... ) - sequences start-product-iter :> ( ns lengths ) + sequences start-product-iter set: ( ns lengths ) lengths [ 0 = ] any? [ [ ns lengths end-product-iter? ] [ ns sequences nths quot call ns lengths product-iter ] until ] unless ; inline :: product-map-as ( ... sequences quot: ( ... seq -- ... value ) exemplar -- ... sequence ) - 0 :> i! + 0 set: i! sequences product-length exemplar |[ result | sequences [ quot call i result set-nth-unsafe i 1 + i! ] product-each @@ -71,7 +71,7 @@ M: product-sequence nth over product-map-as ; inline :: product-map>assoc ( ... sequences quot: ( ... seq -- ... key value ) exemplar -- ... assoc ) - 0 :> i! + 0 set: i! sequences product-length { } |[ result | sequences [ quot call 2array i result set-nth-unsafe i 1 + i! ] product-each diff --git a/collections/sets/extras/extras.factor b/collections/sets/extras/extras.factor index f84958c259..f839299c66 100644 --- a/collections/sets/extras/extras.factor +++ b/collections/sets/extras/extras.factor @@ -20,8 +20,8 @@ IN: sets.extras intersects? not ; :: non-repeating ( seq -- seq' ) - HS{ } clone :> visited - 0 seq new-resizable :> accum + HS{ } clone set: visited + 0 seq new-resizable set: accum seq [ accum over visited ?adjoin [ push ] [ remove-first! drop ] if diff --git a/collections/splitting/monotonic/monotonic.factor b/collections/splitting/monotonic/monotonic.factor index f81e4a2901..b4d38be6d9 100644 --- a/collections/splitting/monotonic/monotonic.factor +++ b/collections/splitting/monotonic/monotonic.factor @@ -7,7 +7,7 @@ IN: splitting.monotonic PRIVATE< :: monotonic-split-impl ( seq quot slice-quot n -- pieces ) - V{ 0 } clone :> accum + V{ 0 } clone set: accum 0 seq [ ] [ [ 1 + ] 2dip [ diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 527dd6b0fa..76b1bcb11f 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -108,7 +108,7 @@ IN: bootstrap.syntax "SBUF\"" "::" "M::" "MEMO:" "MEMO::" "MACRO:" "MACRO::" "IDENTITY-MEMO:" "IDENTITY-MEMO::" "TYPED:" "TYPED::" - ":>" "|[" "let[" "MEMO[" + "set:" "|[" "let[" "MEMO[" "$[" "_" "@" diff --git a/core/locals/errors/errors.factor b/core/locals/errors/errors.factor index ee6603497e..3d91422d78 100644 --- a/core/locals/errors/errors.factor +++ b/core/locals/errors/errors.factor @@ -19,10 +19,10 @@ ERROR: local-writer-in-literal-error ; M: local-writer-in-literal-error summary drop "Local writer words not permitted inside literals" ; -ERROR: :>-outside-lambda-error ; +ERROR: set:-outside-lambda-error ; -M: :>-outside-lambda-error summary - drop ":> cannot be used outside of let[, |[, or :: forms" ; +M: set:-outside-lambda-error summary + drop "set: cannot be used outside of let[, |[, or :: forms" ; ERROR: bad-local args obj ; diff --git a/core/locals/locals-docs.factor b/core/locals/locals-docs.factor index be3ab34190..61106f8b27 100644 --- a/core/locals/locals-docs.factor +++ b/core/locals/locals-docs.factor @@ -8,34 +8,34 @@ HELP: \ |[ { $examples "See " { $link "locals-examples" } "." } ; HELP: \ let[ -{ $syntax "let[ code :> var code :> var code... ]" } -{ $description "Establishes a new scope for lexical variable bindings. Variables bound with " { $link postpone\ :> } " within the body of the " { $snippet "let[" } " will be lexically scoped to the body of the " { $snippet "let[" } " form." } +{ $syntax "let[ code set: var code set: var code... ]" } +{ $description "Establishes a new scope for lexical variable bindings. Variables bound with " { $link \ set: } " within the body of the " { $snippet "let[" } " will be lexically scoped to the body of the " { $snippet "let[" } " form." } { $examples "See " { $link "locals-examples" } "." } ; -HELP: \ :> -{ $syntax ":> var" ":> var!" ":> ( var-1 var-2 ... )" } -{ $description "Binds one or more new lexical variables. In the " { $snippet ":> var" } " form, the value on the top of the datastack is bound to a new lexical variable named " { $snippet "var" } " and is scoped to the enclosing quotation, " { $link postpone\ let[ } " form, or " { $link postpone\ :: } " definition." +HELP: \ set: +{ $syntax "set: var" "set: var!" "set: ( var-1 var-2 ... )" } +{ $description "Binds one or more new lexical variables. In the " { $snippet "set: var" } " form, the value on the top of the datastack is bound to a new lexical variable named " { $snippet "var" } " and is scoped to the enclosing quotation, " { $link \ let[ } " form, or " { $link \ :: } " definition." $nl -"The " { $snippet ":> ( var-1 ... )" } " form binds multiple variables to the top values of the datastack in right to left order, with the last variable bound to the top of the datastack. These two snippets have the same effect:" -{ $code ":> c :> b :> a" } -{ $code ":> ( a b c )" } +"The " { $snippet "set: ( var-1 ... )" } " form binds multiple variables to the top values of the datastack in right to left order, with the last variable bound to the top of the datastack. These two snippets have the same effect:" +{ $code "set: c set: b set: a" } +{ $code "set: ( a b c )" } $nl "If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), that new variable is mutable. See " { $link "locals-mutable" } " for more information." } { $notes - "This syntax can only be used inside a lexical scope established by a " { $link postpone\ :: } " definition, " { $link postpone\ let[ } " form, or " { $link postpone\ |[ } " quotation. Normal quotations have their own lexical scope only if they are inside an outer scope. Definition forms such as " { $link postpone\ : } " do not establish a lexical scope by themselves unless documented otherwise, nor is there a lexical scope available at the top level of source files or in the listener. " { $link postpone\ let[ } " can be used to create a lexical scope where one is not otherwise available." } + "This syntax can only be used inside a lexical scope established by a " { $link \ :: } " definition, " { $link \ let[ } " form, or " { $link \ |[ } " quotation. Normal quotations have their own lexical scope only if they are inside an outer scope. Definition forms such as " { $link \ : } " do not establish a lexical scope by themselves unless documented otherwise, nor is there a lexical scope available at the top level of source files or in the listener. " { $link \ let[ } " can be used to create a lexical scope where one is not otherwise available." } { $examples "See " { $link "locals-examples" } "." } ; -{ postpone\ let[ postpone\ :> } related-words +{ \ let[ \ set: } related-words HELP: \ :: { $syntax ":: word ( vars... -- outputs... ) body... ;" } { $description "Defines a word with named inputs. The word binds its input values to lexical variables from left to right, then executes the body with those bindings in scope." $nl "If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information." } -{ $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link postpone\ : } " definitions." } +{ $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link \ : } " definitions." } { $examples "See " { $link "locals-examples" } "." } ; -{ postpone\ : postpone\ :: } related-words +{ \ : \ :: } related-words HELP: \ MACRO:: { $syntax "MACRO:: word ( vars... -- outputs... ) body... ;" } @@ -45,7 +45,7 @@ $nl { $notes "The expansion of a macro cannot reference lexical variables bound in the outer scope. There are also limitations on passing arguments involving lexical variables into macros. See " { $link "locals-limitations" } " for details." } { $examples "See " { $link "locals-examples" } "." } ; -{ postpone\ MACRO: postpone\ MACRO:: } related-words +{ \ MACRO: \ MACRO:: } related-words HELP: \ MEMO:: { $syntax "MEMO:: word ( vars... -- outputs... ) body... ;" } @@ -54,35 +54,35 @@ $nl "If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information." } { $examples "See " { $link "locals-examples" } "." } ; -{ postpone\ MEMO: postpone\ MEMO:: } related-words +{ \ MEMO: \ MEMO:: } related-words HELP: \ M:: { $syntax "M:: class generic ( vars... -- outputs... ) body... ;" } { $description "Defines a new method on " { $snippet "generic" } " for " { $snippet "class" } " with named inputs. The method binds its input values to lexical variables from left to right, then executes the body with those bindings in scope." $nl "If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information." } -{ $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link postpone\ M: } " definitions." } +{ $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link \ M: } " definitions." } { $examples "See " { $link "locals-examples" } "." } ; -{ postpone\ M: postpone\ M:: } related-words +{ \ M: \ M:: } related-words ARTICLE: "locals-examples" "Examples of lexical variables" { $heading "Definitions with lexical variables" } -"The following example demonstrates lexical variable bindings in word definitions. The " { $snippet "quadratic-roots" } " word is defined with " { $link postpone\ :: } ", so it takes its inputs from the top three elements of the datastack and binds them to the variables " { $snippet "a" } ", " { $snippet "b" } ", and " { $snippet "c" } ". In the body, the " { $snippet "disc" } " variable is bound using " { $link postpone\ :> } " and then used in the following line of code." +"The following example demonstrates lexical variable bindings in word definitions. The " { $snippet "quadratic-roots" } " word is defined with " { $link \ :: } ", so it takes its inputs from the top three elements of the datastack and binds them to the variables " { $snippet "a" } ", " { $snippet "b" } ", and " { $snippet "c" } ". In the body, the " { $snippet "disc" } " variable is bound using " { $link \ set: } " and then used in the following line of code." { $example "USING: locals math math.functions kernel ; IN: scratchpad :: quadratic-roots ( a b c -- x y ) - b sq 4 a c * * - sqrt :> disc + b sq 4 a c * * - sqrt set: disc b neg disc [ + ] [ - ] 2bi [ 2 a * / ] bi@ ; 1.0 1.0 -6.0 quadratic-roots [ . ] bi@" "2.0 -3.0" } -"If you wanted to perform the quadratic formula interactively from the listener, you could use " { $link postpone\ let[ } " to provide a scope for the variables:" +"If you wanted to perform the quadratic formula interactively from the listener, you could use " { $link \ let[ } " to provide a scope for the variables:" { $example "USING: locals math math.functions kernel ; IN: scratchpad -let[ 1.0 :> a 1.0 :> b -6.0 :> c - b sq 4 a c * * - sqrt :> disc +let[ 1.0 set: a 1.0 set: b -6.0 set: c + b sq 4 a c * * - sqrt set: disc b neg disc [ + ] [ - ] 2bi [ 2 a * / ] bi@ ] [ . ] bi@" "2.0 @@ -92,7 +92,7 @@ let[ 1.0 :> a 1.0 :> b -6.0 :> c $nl { $heading "Quotations with lexical variables, and closures" } -"These next two examples demonstrate lexical variable bindings in quotations defined with " { $link postpone\ |[ } ". In this example, the values " { $snippet "5" } " and " { $snippet "3" } " are put on the datastack. When the quotation is called, it takes those values as inputs and binds them respectively to " { $snippet "m" } " and " { $snippet "n" } " before executing the quotation:" +"These next two examples demonstrate lexical variable bindings in quotations defined with " { $link \ |[ } ". In this example, the values " { $snippet "5" } " and " { $snippet "3" } " are put on the datastack. When the quotation is called, it takes those values as inputs and binds them respectively to " { $snippet "m" } " and " { $snippet "n" } " before executing the quotation:" { $example "USING: kernel locals math prettyprint ;" "IN: scratchpad" @@ -120,7 +120,7 @@ IN: scratchpad TUPLE: counter adder subtractor ; :: ( -- counter ) - 0 :> value! + 0 set: value! counter new [ value 1 + dup value! ] >>adder [ value 1 - dup value! ] >>subtractor ; @@ -138,10 +138,10 @@ TUPLE: counter adder subtractor ; "USING: kernel locals prettyprint ; IN: scratchpad :: rebinding-example ( -- quot1 quot2 ) - 5 :> a [ a ] - 6 :> a [ a ] ; + 5 set: a [ a ] + 6 set: a [ a ] ; :: mutable-example ( -- quot1 quot2 ) - 5 :> a! [ a ] + 5 set: a! [ a ] 6 a! [ a ] ; rebinding-example [ call . ] bi@ mutable-example [ call . ] bi@" @@ -199,7 +199,7 @@ $nl "IN: scratchpad" "TUPLE: person first-name last-name ;" ":: constructor-test ( -- tuple )" - " \"Jane Smith\" \" \" split1 :> last :> first" + " \"Jane Smith\" \" \" split1 set: last set: first" " T{ person { first-name first } { last-name last } } ;" "constructor-test constructor-test eq? ." "f" @@ -207,7 +207,7 @@ $nl "One exception to the above rule is that array instances containing free lexical variables (that is, immutable lexical variables not referenced in a closure) do retain identity. This allows macros such as " { $link cond } " to expand at compile time even when their arguments reference variables." ; ARTICLE: "locals-mutable" "Mutable lexical variables" -"When a lexical variable is bound using " { $link postpone\ :> } ", " { $link postpone\ :: } ", or " { $link postpone\ |[ } ", the variable may be made mutable by suffixing its name with an exclamation point (" { $snippet "!" } "). A mutable variable's value is read by giving its name without the exclamation point as usual. To write to the variable, use its name with the " { $snippet "!" } " suffix." +"When a lexical variable is bound using " { $link \ set: } ", " { $link \ :: } ", or " { $link \ |[ } ", the variable may be made mutable by suffixing its name with an exclamation point (" { $snippet "!" } "). A mutable variable's value is read by giving its name without the exclamation point as usual. To write to the variable, use its name with the " { $snippet "!" } " suffix." $nl "Mutable bindings are implemented in a manner similar to that taken by the ML language. Each mutable binding is actually an immutable binding of a mutable cell. Reading the binding automatically unboxes the value from the cell, and writing to the binding stores into it." $nl @@ -224,7 +224,7 @@ $nl "Conceptually, " { $link curry } " is defined so that the following two code snippets are equivalent:" { $code "3 [ - ] curry" } { $code "[ 3 - ]" } -"When quotations take named parameters using " { $link postpone\ |[ } ", " { $link curry } " fills in the variable bindings from right to left. The following two snippets are equivalent:" +"When quotations take named parameters using " { $link \ |[ } ", " { $link curry } " fills in the variable bindings from right to left. The following two snippets are equivalent:" { $code "3 |[ a b | a b - ] curry" } { $code "|[ a | a 3 - ]" } "Because of this, the behavior of " { $snippet "fry" } " changes when applied to such a quotation to ensure that fry conceptually behaves the same as with normal quotations, placing the fried values “underneath” the variable bindings. Thus, the following snippets are no longer equivalent:" @@ -233,7 +233,7 @@ $nl "Instead, the first line above expands into something like the following:" { $code "[ [ swap |[ a | a - ] ] curry call ]" } $nl -"The precise behavior is as follows. When frying a " { $link postpone\ |[ } " quotation, a stack shuffle (" { $link mnswap } ") is prepended so that the " { $snippet "m" } " curried values, which start off at the top of the stack, are transposed with the quotation's " { $snippet "n" } " named input bindings." ; +"The precise behavior is as follows. When frying a " { $link \ |[ } " quotation, a stack shuffle (" { $link mnswap } ") is prepended so that the " { $snippet "m" } " curried values, which start off at the top of the stack, are transposed with the quotation's " { $snippet "n" } " named input bindings." ; ARTICLE: "locals-limitations" "Limitations of lexical variables" "There are two main limitations of the current implementation, and both concern macros." @@ -282,18 +282,18 @@ ARTICLE: "locals" "Lexical variables" } "Word definitions where the inputs are bound to lexical variables:" { $subsections - postpone\ :: - postpone\ M:: - postpone\ MEMO:: - postpone\ MACRO:: + \ :: + \ M:: + \ MEMO:: + \ MACRO:: } "Lexical scoping and binding forms:" { $subsections - postpone\ let[ - postpone\ :> + \ let[ + \ set: } "Quotation literals where the inputs are bound to lexical variables:" -{ $subsections postpone\ |[ } +{ $subsections \ |[ } "Additional topics:" { $subsections "locals-literals" diff --git a/core/locals/locals-tests.factor b/core/locals/locals-tests.factor index 48a8250539..3d62fdd109 100644 --- a/core/locals/locals-tests.factor +++ b/core/locals/locals-tests.factor @@ -27,30 +27,30 @@ IN: locals.tests { { 5 6 7 } } [ { 1 2 3 } 4 map-test-2 ] unit-test :: let-test ( c -- d ) - let[ 1 :> a 2 :> b a b + c + ] ; + let[ 1 set: a 2 set: b a b + c + ] ; { 7 } [ 4 let-test ] unit-test :: let-test-2 ( a -- a ) - a let[ :> a let[ a :> b a ] ] ; + a let[ set: a let[ a set: b a ] ] ; { 3 } [ 3 let-test-2 ] unit-test :: let-test-3 ( a -- a ) - a let[ :> a let[ [ a ] :> b let[ 3 :> a b ] ] ] ; + a let[ set: a let[ [ a ] set: b let[ 3 set: a b ] ] ] ; :: let-test-4 ( a -- b ) - a let[ 1 :> a :> b a b 2array ] ; + a let[ 1 set: a set: b a b 2array ] ; { { 1 2 } } [ 2 let-test-4 ] unit-test :: let-test-5 ( a b -- b ) - a b let[ :> a :> b a b 2array ] ; + a b let[ set: a set: b a b 2array ] ; { { 2 1 } } [ 1 2 let-test-5 ] unit-test :: let-test-6 ( a -- b ) - a let[ :> a 1 :> b a b 2array ] ; + a let[ set: a 1 set: b a b 2array ] ; { { 2 1 } } [ 2 let-test-6 ] unit-test @@ -72,7 +72,7 @@ IN: locals.tests { 5 } [ 2 "q" get call ] unit-test :: write-test-2 ( -- q ) - let[ 0 :> n! |[ i | n i + dup n! ] ] ; + let[ 0 set: n! |[ i | n i + dup n! ] ] ; write-test-2 "q" set @@ -93,11 +93,11 @@ write-test-2 "q" set { } [ 1 2 write-test-3 call ] unit-test -:: write-test-4 ( x! -- q ) [ let[ 0 :> y! f x! ] ] ; +:: write-test-4 ( x! -- q ) [ let[ 0 set: y! f x! ] ] ; { } [ 5 write-test-4 drop ] unit-test -:: let-let-test ( n -- n ) let[ n 3 + :> n n ] ; +:: let-let-test ( n -- n ) let[ n 3 + set: n n ] ; { 13 } [ 10 let-let-test ] unit-test @@ -135,9 +135,9 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ; { } [ \ lambda-generic see ] unit-test -:: unparse-test-1 ( a -- ) let[ 3 :> a! 4 :> b ] ; +:: unparse-test-1 ( a -- ) let[ 3 set: a! 4 set: b ] ; -{ "let[ 3 :> a! 4 :> b ]" } [ +{ "let[ 3 set: a! 4 set: b ]" } [ \ unparse-test-1 "lambda" word-prop body>> first unparse ] unit-test @@ -177,11 +177,11 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ; { 3 0 } |[ a b c | ] must-infer-as -{ } [ 1 let[ :> a ] ] unit-test +{ } [ 1 let[ set: a ] ] unit-test -{ 3 } [ 1 let[ :> a 3 ] ] unit-test +{ 3 } [ 1 let[ set: a 3 ] ] unit-test -{ } [ 1 2 let[ :> a :> b ] ] unit-test +{ } [ 1 2 let[ set: a set: b ] ] unit-test :: a-word-with-locals ( a b -- ) ; @@ -239,10 +239,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; { t } [ 12 &&-test ] unit-test :: let-and-cond-test-1 ( -- a ) - let[ 10 :> a - let[ 20 :> a + let[ 10 set: a + let[ 20 set: a { - { [ t ] [ let[ 30 :> c a ] ] } + { [ t ] [ let[ 30 set: c a ] ] } } cond ] ] ; @@ -252,8 +252,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; { 20 } [ let-and-cond-test-1 ] unit-test :: let-and-cond-test-2 ( -- pair ) - let[ 10 :> A - let[ 20 :> B + let[ 10 set: A + let[ 20 set: B { { [ t ] [ { A B } ] } } cond ] ] ; @@ -266,7 +266,7 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; { { 10 20 } } [ 10 20 |[ a b | { a b } ] call ] unit-test { { 10 20 30 } } [ 10 20 30 |[ a b c | { a b c } ] call ] unit-test -{ { 10 20 30 } } [ let[ 10 :> a 20 :> b 30 :> c { a b c } ] ] unit-test +{ { 10 20 30 } } [ let[ 10 set: a 20 set: b 30 set: c { a b c } ] ] unit-test { V{ 10 20 30 } } [ 10 20 30 |[ a b c | V{ a b c } ] call ] unit-test @@ -388,7 +388,7 @@ M:: integer lambda-method-forget-test ( a -- b ) a ; { 10 } [ 10 |[ A | { [ A ] } ] call first call ] unit-test [ - "USING: locals fry math ; 1 $[ let[ 10 :> A A _ + ] ]" + "USING: locals fry math ; 1 $[ let[ 10 set: A A _ + ] ]" eval( -- ) call ] [ error>> >r/r>-in-fry-error? ] must-fail-with @@ -416,28 +416,28 @@ M:: integer lambda-method-forget-test ( a -- b ) a ; { 3 } [ 3 |[ a | \ a ] call ] unit-test -[ "USE: locals |[ | { let[ 0 :> a a ] } ]" eval( -- ) ] must-fail +[ "USE: locals |[ | { let[ 0 set: a a ] } ]" eval( -- ) ] must-fail -[ "USE: locals |[ | let[ 0 :> a! { a! } ] ]" eval( -- ) ] must-fail +[ "USE: locals |[ | let[ 0 set: a! { a! } ] ]" eval( -- ) ] must-fail -[ "USE: locals |[ | { :> a } ]" eval( -- ) ] must-fail +[ "USE: locals |[ | { set: a } ]" eval( -- ) ] must-fail -[ "USE: locals 3 :> a" eval( -- ) ] must-fail +[ "USE: locals 3 set: a" eval( -- ) ] must-fail -{ 3 } [ 3 |[ | :> a a ] call ] unit-test +{ 3 } [ 3 |[ | set: a a ] call ] unit-test -{ 3 } [ 3 |[ | :> a! a ] call ] unit-test +{ 3 } [ 3 |[ | set: a! a ] call ] unit-test -{ 3 } [ 2 |[ | :> a! a 1 + a! a ] call ] unit-test +{ 3 } [ 2 |[ | set: a! a 1 + a! a ] call ] unit-test : fry-locals-test-1 ( -- n ) - let[ 6 $[ let[ 4 :> A A _ + ] ] call ] ; + let[ 6 $[ let[ 4 set: A A _ + ] ] call ] ; \ fry-locals-test-1 def>> must-infer { 10 } [ fry-locals-test-1 ] unit-test :: fry-locals-test-2 ( -- n ) - let[ 6 $[ let[ 4 :> A A _ + ] ] call ] ; + let[ 6 $[ let[ 4 set: A A _ + ] ] call ] ; \ fry-locals-test-2 def>> must-infer { 10 } [ fry-locals-test-2 ] unit-test @@ -455,31 +455,31 @@ M:: integer lambda-method-forget-test ( a -- b ) a ; ] unit-test { 10 } [ - |[ | 0 $[ let[ 10 :> A A _ + ] ] call ] call + |[ | 0 $[ let[ 10 set: A A _ + ] ] call ] call ] unit-test ! littledan found this problem -{ "bar" } [ let[ let[ "bar" :> foo foo ] :> a a ] ] unit-test -{ 10 } [ let[ 10 :> a let[ a :> b b ] ] ] unit-test +{ "bar" } [ let[ let[ "bar" set: foo foo ] set: a a ] ] unit-test +{ 10 } [ let[ 10 set: a let[ a set: b b ] ] ] unit-test -{ { \ + } } [ let[ \ + :> x { \ x } ] ] unit-test +{ { \ + } } [ let[ \ + set: x { \ x } ] ] unit-test -{ { \ + 3 } } [ let[ 3 :> a { \ + a } ] ] unit-test +{ { \ + 3 } } [ let[ 3 set: a { \ + a } ] ] unit-test -{ 3 } [ let[ \ + :> a 1 2 [ \ a execute ] ] call ] unit-test +{ 3 } [ let[ \ + set: a 1 2 [ \ a execute ] ] call ] unit-test ! erg found this problem -:: erg's-:>-bug ( n ? -- n ) ? [ n :> n n ] [ n :> b b ] if ; +:: erg's-set:-bug ( n ? -- n ) ? [ n set: n n ] [ n set: b b ] if ; -{ 3 } [ 3 f erg's-:>-bug ] unit-test +{ 3 } [ 3 f erg's-set:-bug ] unit-test -{ 3 } [ 3 t erg's-:>-bug ] unit-test +{ 3 } [ 3 t erg's-set:-bug ] unit-test -:: erg's-:>-bug-2 ( n ? -- n ) ? n $[ _ :> n n ] [ n :> b b ] if ; +:: erg's-set:-bug-2 ( n ? -- n ) ? n $[ _ set: n n ] [ n set: b b ] if ; -{ 3 } [ 3 f erg's-:>-bug-2 ] unit-test +{ 3 } [ 3 f erg's-set:-bug-2 ] unit-test -{ 3 } [ 3 t erg's-:>-bug-2 ] unit-test +{ 3 } [ 3 t erg's-set:-bug-2 ] unit-test ! dharmatech found this problem GENERIC: ed's-bug ( a -- b ) ; @@ -493,7 +493,7 @@ M: integer ed's-bug neg ; { t } [ \ ed's-test-case word-optimized? ] unit-test ! multiple bind -{ 3 1 2 } [ let[ 1 2 3 :> ( a b c ) c a b ] ] unit-test +{ 3 1 2 } [ let[ 1 2 3 set: ( a b c ) c a b ] ] unit-test ! Test smart combinators and locals interaction :: smart-combinator-locals ( a b c -- seq ) [ a b c ] output>array ; diff --git a/core/locals/parser/parser-docs.factor b/core/locals/parser/parser-docs.factor index d1d7046c64..c7d130dcb0 100644 --- a/core/locals/parser/parser-docs.factor +++ b/core/locals/parser/parser-docs.factor @@ -10,7 +10,7 @@ HELP: parse-def { "name/paren" string } { "def" "a " { $link def } " or a " { $link multi-def } } } -{ $description "Parses the lexical variable bindings following a " { $link postpone\ :> } " token." } ; +{ $description "Parses the lexical variable bindings following a " { $link postpone\ set: } " token." } ; HELP: with-lambda-scope { $values { "assoc" "local variables" } { "reader-quot" quotation } { "quot" quotation } } diff --git a/core/locals/parser/parser-tests.factor b/core/locals/parser/parser-tests.factor index e2e52b7862..d47e96f172 100644 --- a/core/locals/parser/parser-tests.factor +++ b/core/locals/parser/parser-tests.factor @@ -60,11 +60,11 @@ COMPILE> COMPILE< { - "V{ 99 :> kkk kkk }" + "V{ 99 set: kkk kkk }" } [ [ "locals" use-vocab - { "99 :> kkk kkk ;" } [ + { "99 set: kkk kkk ;" } [ H{ } clone [ \ ; parse-until ] with-lambda-scope ] with-lexer ] with-compilation-unit unparse diff --git a/core/locals/rewrite/point-free/point-free.factor b/core/locals/rewrite/point-free/point-free.factor index c26fd714b7..a80cdeeba0 100644 --- a/core/locals/rewrite/point-free/point-free.factor +++ b/core/locals/rewrite/point-free/point-free.factor @@ -35,7 +35,7 @@ M: def localize M: object localize 1quotation ; -! We special-case all the :> at the start of a quotation +! We special-case all the set: at the start of a quotation : load-locals-quot ( args -- quot ) [ [ ] ] [ dup [ local-reader? ] any? [ diff --git a/core/locals/rewrite/sugar/sugar.factor b/core/locals/rewrite/sugar/sugar.factor index 8376e84b06..40696f74c9 100644 --- a/core/locals/rewrite/sugar/sugar.factor +++ b/core/locals/rewrite/sugar/sugar.factor @@ -6,7 +6,7 @@ locals.errors locals.types make quotations sequences vectors words ; IN: locals.rewrite.sugar -! Step 1: rewrite |[ into :> forms, turn +! Step 1: rewrite |[ into set: forms, turn ! literals with locals in them into code which constructs ! the literal after pushing locals on the stack diff --git a/core/modern/lexer/lexer.factor b/core/modern/lexer/lexer.factor index 87ff1cf3a3..6f2860eb6e 100644 --- a/core/modern/lexer/lexer.factor +++ b/core/modern/lexer/lexer.factor @@ -43,12 +43,12 @@ ERROR: unexpected-end n string ; n [ n string $[ tokens member? ] find-from dup "\s\r\n" member? [ - :> ( n' ch ) + set: ( n' ch ) n' string n n' string ? ch ] [ - [ dup [ 1 + ] when ] dip :> ( n' ch ) + [ dup [ 1 + ] when ] dip set: ( n' ch ) n' string n n' string ? ch @@ -60,12 +60,12 @@ ERROR: unexpected-end n string ; ! ":foo" with partial>> slot broke this :: lex-til-either ( lexer tokens -- n'/f string' slice/f ch/f ) lexer >lexer< - lexer partial>> :> partial + lexer partial>> set: partial partial [ [ dup [ 1 - ] when ] dip f lexer partial<< ] when - tokens slice-til-either :> ( n' string' slice ch ) + tokens slice-til-either set: ( n' string' slice ch ) lexer n' >>n drop n' string' @@ -74,13 +74,13 @@ ERROR: unexpected-end n string ; :: slice-til-separator-inclusive ( n string tokens -- n' string slice/f ch/f ) - n string $[ tokens member? ] find-from [ dup [ 1 + ] when ] dip :> ( n' ch ) + n string $[ tokens member? ] find-from [ dup [ 1 + ] when ] dip set: ( n' ch ) n' string n n' string ? ch ; inline :: lex-til-separator-inclusive ( lexer tokens -- n' string' slice/f ch/f ) - lexer >lexer< tokens slice-til-separator-inclusive :> ( n' string' slice ch ) + lexer >lexer< tokens slice-til-separator-inclusive set: ( n' string' slice ch ) lexer n' >>n drop @@ -94,7 +94,7 @@ ERROR: unexpected-end n string ; ] when ; :: lex-til-separator-exclusive ( lexer tokens -- n'/f string' slice/f ch/f ) - lexer >lexer< tokens slice-til-separator-exclusive :> ( n' string' slice ch ) + lexer >lexer< tokens slice-til-separator-exclusive set: ( n' string' slice ch ) lexer n' >>n drop n' string' slice ch ; @@ -102,7 +102,7 @@ ERROR: unexpected-end n string ; ! Don't include the whitespace in the slice :: slice-til-whitespace ( n string -- n'/f string slice/f ch/f ) n [ - n string [ "\s\r\n" member? ] find-from :> ( n' ch ) + n string [ "\s\r\n" member? ] find-from set: ( n' ch ) n' string n n' string ? ch @@ -111,14 +111,14 @@ ERROR: unexpected-end n string ; ] if ; inline :: lex-til-whitespace ( lexer -- n'/f string slice/f ch/f ) - lexer >lexer< slice-til-whitespace :> ( n' string' slice ch ) + lexer >lexer< slice-til-whitespace set: ( n' string' slice ch ) lexer n' >>n drop n' string' slice ch ; ! rollback only n, other state is not rolled back :: with-lexer-rollback ( lexer quot -- ) - lexer n>> :> n + lexer n>> set: n lexer quot call lexer n >>n drop ; inline @@ -130,7 +130,7 @@ ERROR: unexpected-end n string ; :: slice-til-eol ( n string -- n'/f string slice/f ch/f ) n [ - n string $[ "\r\n" member? ] find-from :> ( n' ch ) + n string $[ "\r\n" member? ] find-from set: ( n' ch ) n' string n n' string ? ch @@ -139,7 +139,7 @@ ERROR: unexpected-end n string ; ] if ; inline :: lex-til-eol ( lexer -- n' string' slice/f ch/f ) - lexer >lexer< slice-til-eol :> ( n' string' slice ch ) + lexer >lexer< slice-til-eol set: ( n' string' slice ch ) lexer n' >>n drop n' string' slice ch ; @@ -148,14 +148,14 @@ ERROR: unexpected-end n string ; ERROR: subseq-expected-but-got-eof n string expected ; :: slice-til-string ( n string search -- n' string payload closing ) - search string n start* :> n' + search string n start* set: n' n' [ n string search subseq-expected-but-got-eof ] unless n' search length + string n n' string ? n' dup search length + string ? ; :: lex-til-string ( lexer search -- n'/f string' payload closing ) - lexer >lexer< search slice-til-string :> ( n' string' payload closing ) + lexer >lexer< search slice-til-string set: ( n' string' payload closing ) lexer n' >>n drop n' string' payload closing ; @@ -174,14 +174,14 @@ ERROR: subseq-expected-but-got-eof n string expected ; ERROR: char-expected-but-got-eof n string expected ; :: slice-til-not-char ( n string slice char -- n' string found ) - n string [ char = not ] find-from drop :> n' + n string [ char = not ] find-from drop set: n' n' [ n string char char-expected-but-got-eof ] unless n' string slice from>> n' string ? ; :: lex-til-not-char ( lexer slice char -- n'/f string' found ) - lexer >lexer< slice char slice-til-not-char :> ( n' string' found ) + lexer >lexer< slice char slice-til-not-char set: ( n' string' found ) lexer n' >>n drop n' string' found ; diff --git a/core/modern/modern.factor b/core/modern/modern.factor index 759b011690..7c917acf36 100644 --- a/core/modern/modern.factor +++ b/core/modern/modern.factor @@ -261,21 +261,21 @@ MACRO:: read-double-matched ( open-ch -- quot: ( lexer tag ch -- seq ) ) [ drop 2 swap ] [ drop 1string ] [ nip 2 swap ] - } 2cleave :> ( openstr2 openstr1 closestr2 ) + } 2cleave set: ( openstr2 openstr1 closestr2 ) |[ lexer tag! ch | ch { { char: = [ - lexer openstr1 lex-til-separator-inclusive [ -1 modify-from ] dip :> ( n' string' opening ch ) + lexer openstr1 lex-til-separator-inclusive [ -1 modify-from ] dip set: ( n' string' opening ch ) ch open-ch = [ tag openstr2 lexer ch long-opening-mismatch ] unless - opening matching-delimiter-string :> needle + opening matching-delimiter-string set: needle - lexer needle lex-til-string :> ( n'' string'' payload closing ) + lexer needle lex-til-string set: ( n'' string'' payload closing ) payload closing tag but-last-slice opening double-matched-literal make-matched-literal [ >string ] change-payload ] } { open-ch [ - tag 1 cut-slice* swap tag! 1 modify-to :> opening - lexer [ 1 + ] change-n closestr2 lex-til-string :> ( n' string' payload closing ) + tag 1 cut-slice* swap tag! 1 modify-to set: opening + lexer [ 1 + ] change-n closestr2 lex-til-string set: ( n' string' payload closing ) payload closing tag opening double-matched-literal make-matched-literal [ >string ] change-payload ] } @@ -317,7 +317,7 @@ MACRO:: read-matched ( ch -- quot: ( lexer tag -- slice' ) ) ch dup matching-delimiter { [ drop "=" swap prefix ] [ nip 1string ] - } 2cleave :> ( openstreq closestr1 ) ! [= ] + } 2cleave set: ( openstreq closestr1 ) ! [= ] |[ lexer tag | lexer tag @@ -339,7 +339,7 @@ MACRO:: read-matched ( ch -- quot: ( lexer tag -- slice' ) ) :: read-string-payload ( lexer -- n' string slice ) lexer dup ?lexer-nth [ - { char: \\ char: \" } lex-til-separator-inclusive :> ( n' string' slice ch ) + { char: \\ char: \" } lex-til-separator-inclusive set: ( n' string' slice ch ) ch { { f [ n' string' slice ] } { char: \" [ n' string' slice ] } @@ -350,8 +350,8 @@ MACRO:: read-matched ( ch -- quot: ( lexer tag -- slice' ) ) ] if ; :: read-string ( lexer tag -- seq ) - lexer n>> :> n - lexer read-string-payload :> ( n' string slice ) + lexer n>> set: n + lexer read-string-payload set: ( n' string slice ) n' [ n string string-expected-got-eof ] unless n n' 1 - string n' 1 - n' string @@ -426,11 +426,11 @@ ERROR: closing-tag-required lexer tag ; (trim-tail) [ length ] dip - ; inline :: read-backtick ( lexer slice -- obj ) - lexer slice char: \` lex-til-not-char 2nip :> tag-opening - tag-opening [ char: \` = ] count-tail :> count - tag-opening count cut-slice* :> ( tag opening ) + lexer slice char: \` lex-til-not-char 2nip set: tag-opening + tag-opening [ char: \` = ] count-tail set: count + tag-opening count cut-slice* set: ( tag opening ) count 1 > [ - lexer opening lex-til-string :> ( n' string' payload closing ) + lexer opening lex-til-string set: ( n' string' payload closing ) payload closing tag opening matched-backtick-literal make-matched-literal [ >string ] change-payload ] [ diff --git a/core/modern/slices/slices.factor b/core/modern/slices/slices.factor index 58155f44df..4920c665fa 100644 --- a/core/modern/slices/slices.factor +++ b/core/modern/slices/slices.factor @@ -61,13 +61,13 @@ ERROR: unexpected-end n string ; ! Don't include the whitespace in the slice :: slice-til-whitespace ( n string -- n' string slice/f ch/f ) - n string [ "\s\r\n" member? ] find-from :> ( n' ch ) + n string [ "\s\r\n" member? ] find-from set: ( n' ch ) n' string n n' string ? ch ; inline :: (slice-until) ( n string quot -- n' string slice/f ch/f ) - n string quot find-from :> ( n' ch ) + n string quot find-from set: ( n' ch ) n' string n n' string ? ch ; inline @@ -76,7 +76,7 @@ ERROR: unexpected-end n string ; (slice-until) drop ; inline :: slice-til-not-whitespace ( n string -- n' string slice/f ch/f ) - n string [ "\s\r\n" member? not ] find-from :> ( n' ch ) + n string [ "\s\r\n" member? not ] find-from set: ( n' ch ) n' string n n' string ? ch ; inline @@ -92,7 +92,7 @@ ERROR: unexpected-end n string ; :: slice-til-eol ( n string -- n' string slice/f ch/f ) n [ - n string $[ "\r\n" member? ] find-from :> ( n' ch ) + n string $[ "\r\n" member? ] find-from set: ( n' ch ) n' string n n' string ? ch @@ -102,7 +102,7 @@ ERROR: unexpected-end n string ; :: ((merge-slice-til-eol-slash)) ( n string -- n' string slice/f ch/f ) n [ - n string $[ "\r\n\\" member? ] find-from :> ( n' ch ) + n string $[ "\r\n\\" member? ] find-from set: ( n' ch ) n' string n n' string ? ch @@ -129,7 +129,7 @@ ERROR: unexpected-end n string ; over [ ?nth ] [ 2drop f ] if ; :: (merge-slice-til-eol-slash) ( n string slice -- n' string slice/f ch/f ) - n string ((merge-slice-til-eol-slash)) :> ( n' string' slice' ch' ) + n string ((merge-slice-til-eol-slash)) set: ( n' string' slice' ch' ) ch' char: \ = [ n' 1 + string' ?nth' "\r\n" member? [ n' 2 + string' slice slice' span-slices (merge-slice-til-eol-slash) @@ -145,7 +145,7 @@ ERROR: unexpected-end n string ; 2dup empty-slice-from (merge-slice-til-eol-slash) ; :: slice-til-separator-inclusive ( n string tokens -- n' string slice/f ch/f ) - n string $[ tokens member? ] find-from [ dup [ 1 + ] when ] dip :> ( n' ch ) + n string $[ tokens member? ] find-from [ dup [ 1 + ] when ] dip set: ( n' ch ) n' string n n' string ? ch ; inline @@ -159,12 +159,12 @@ ERROR: unexpected-end n string ; n [ n string $[ tokens member? ] find-from dup "\s\r\n" member? [ - :> ( n' ch ) + set: ( n' ch ) n' string n n' string ? ch ] [ - [ dup [ 1 + ] when ] dip :> ( n' ch ) + [ dup [ 1 + ] when ] dip set: ( n' ch ) n' string n n' string ? ch @@ -176,7 +176,7 @@ ERROR: unexpected-end n string ; ERROR: subseq-expected-but-got-eof n string expected ; :: slice-til-string ( n string search -- n' string payload end-string ) - search string n start* :> n' + search string n start* set: n' n' [ n string search subseq-expected-but-got-eof ] unless n' search length + string n n' string ? @@ -185,7 +185,7 @@ ERROR: subseq-expected-but-got-eof n string expected ; ERROR: char-expected-but-got-eof n string expected ; :: slice-til-not-char ( n string slice char -- n' string found ) - n string [ char = not ] find-from drop :> n' + n string [ char = not ] find-from drop set: n' n' [ n string char char-expected-but-got-eof ] unless B n' diff --git a/core/multiline/multiline.factor b/core/multiline/multiline.factor index d3ea589eb6..53fe03976e 100644 --- a/core/multiline/multiline.factor +++ b/core/multiline/multiline.factor @@ -6,7 +6,7 @@ IN: multiline PRIVATE< :: scan-multiline-string ( i end lexer -- j ) - lexer line-text>> :> text + lexer line-text>> set: text lexer still-parsing? [ end text i start* |[ j | i j text subseq % j end length + diff --git a/core/stack-checker/backend/backend.factor b/core/stack-checker/backend/backend.factor index d5e07a53b3..c160ffbeef 100644 --- a/core/stack-checker/backend/backend.factor +++ b/core/stack-checker/backend/backend.factor @@ -166,19 +166,19 @@ M: object apply-object push-literal ; dup pair? [ second dup effect? [ drop f ] unless ] [ drop f ] if ; :: declare-effect-d ( word effect variables branches n -- ) - meta-d length :> d-length + meta-d length set: d-length n d-length < [ - d-length 1 - n - :> n' - n' meta-d nth :> value - value known :> known - known word effect variables branches :> known' + d-length 1 - n - set: n' + n' meta-d nth set: value + value known set: known + known word effect variables branches set: known' known' value set-known known' branches push ] [ word unknown-macro-input ] if ; :: declare-input-effects ( word -- ) - H{ } clone :> variables - V{ } clone :> branches + H{ } clone set: variables + V{ } clone set: branches word stack-effect in>> |[ in n | in ?quotation-effect |[ effect | word effect variables branches n declare-effect-d diff --git a/core/stack-checker/known-words/known-words.factor b/core/stack-checker/known-words/known-words.factor index 0cf51b9483..8385674de2 100644 --- a/core/stack-checker/known-words/known-words.factor +++ b/core/stack-checker/known-words/known-words.factor @@ -206,10 +206,10 @@ M: object infer-call* \ call bad-macro-input ; \ load-local [ infer-load-local ] "special" set-word-prop :: infer-get-local ( -- ) - pop-literal nip 1 swap - :> n - n consume-r :> in-r - in-r first copy-value 1array :> out-d - in-r copy-values :> out-r + pop-literal nip 1 swap - set: n + n consume-r set: in-r + in-r first copy-value 1array set: out-d + in-r copy-values set: out-r out-d output-d out-r output-r diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 994858910c..83dfaff127 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -410,8 +410,8 @@ IN: bootstrap.syntax "IDENTITY-MEMO:" [ (:) define-identity-memoized ] define-core-syntax "IDENTITY-MEMO::" [ (::) define-identity-memoized ] define-core-syntax - ":>" [ - in-lambda? get [ :>-outside-lambda-error ] unless + "set:" [ + in-lambda? get [ set:-outside-lambda-error ] unless scan-token parse-def suffix! ] define-core-syntax diff --git a/core/typed/namespaces/namespaces.factor b/core/typed/namespaces/namespaces.factor index b5b3e9a3c9..25155ae62d 100644 --- a/core/typed/namespaces/namespaces.factor +++ b/core/typed/namespaces/namespaces.factor @@ -18,7 +18,7 @@ MACRO: declare1 ( type -- quot: ( value -- value ) ) PRIVATE> :: (typed-get) ( name type getter: ( name -- value ) -- value ) - name getter call :> value + name getter call set: value value type instance? [ name value type variable-type-error ] unless value type declare1 ; inline diff --git a/core/typed/typed.factor b/core/typed/typed.factor index dcf300bcaf..be2262cdf0 100644 --- a/core/typed/typed.factor +++ b/core/typed/typed.factor @@ -67,7 +67,7 @@ PRIVATE< [ (unboxed-types) ] map concat ; :: typed-inputs ( quot word types -- quot' ) - types unboxed-types :> unboxed-types + types unboxed-types set: unboxed-types [ input-mismatch-error ] word types make-unboxer unboxed-types quot $[ _ declare @ ] diff --git a/demos/boids/boids.factor b/demos/boids/boids.factor index 61f60f5b64..ad199d8469 100644 --- a/demos/boids/boids.factor +++ b/demos/boids/boids.factor @@ -137,7 +137,7 @@ M: range-observer model-changed :: create-gadgets ( -- gadgets ) - :> boids-gadget + set: boids-gadget boids-gadget [ start-boids-thread ] keep add-gadget diff --git a/demos/boids/simulation/simulation.factor b/demos/boids/simulation/simulation.factor index de006bb430..b22faa6111 100644 --- a/demos/boids/simulation/simulation.factor +++ b/demos/boids/simulation/simulation.factor @@ -65,10 +65,10 @@ GENERIC: force ( neighbors boid behaviour -- force ) ; :: simulate ( boids behaviours dt -- boids ) boids |[ boid | boid boids behaviours - [ [ (force) ] keep weight>> v*n ] 2with map vsum :> a + [ [ (force) ] keep weight>> v*n ] 2with map vsum set: a - boid vel>> a dt v*n v+ normalize :> vel - boid pos>> vel dt v*n v+ wrap-pos :> pos + boid vel>> a dt v*n v+ normalize set: vel + boid pos>> vel dt v*n v+ wrap-pos set: pos pos vel ] map ; @@ -95,6 +95,6 @@ M: alignment force ( neighbors boid behaviour -- force ) 2drop [ vel>> ] map vsum normalize ; M:: separation force ( neighbors boid behaviour -- force ) - behaviour radius>> :> r + behaviour radius>> set: r boid pos>> neighbors [ pos>> v- [ normalize ] [ r v/n ] bi v- ] with map vsum ; diff --git a/demos/project-euler/073/073.factor b/demos/project-euler/073/073.factor index 66eeea0d25..bf83ce4646 100644 --- a/demos/project-euler/073/073.factor +++ b/demos/project-euler/073/073.factor @@ -33,7 +33,7 @@ IN: project-euler.073 PRIVATE< :: (euler073) ( counter limit lo hi -- counter' ) - lo hi mediant :> m + lo hi mediant set: m m denominator limit <= [ counter 1 + limit lo m (euler073) diff --git a/demos/project-euler/150/150.factor b/demos/project-euler/150/150.factor index 09ddbb92c3..38011f3b8d 100644 --- a/demos/project-euler/150/150.factor +++ b/demos/project-euler/150/150.factor @@ -51,7 +51,7 @@ PRIVATE< 0 1000 [1,b] [ [ next ] replicate partial-sums ] map nip ; inline :: (euler150) ( m -- n ) - sums-triangle :> table + sums-triangle set: table m iota |[ x | x 1 + iota |[ y | m x - iota |[ z | diff --git a/demos/rosetta-code/balanced-brackets/balanced-brackets.factor b/demos/rosetta-code/balanced-brackets/balanced-brackets.factor index 4210ddaa48..a9d766377b 100644 --- a/demos/rosetta-code/balanced-brackets/balanced-brackets.factor +++ b/demos/rosetta-code/balanced-brackets/balanced-brackets.factor @@ -22,8 +22,8 @@ IN: rosetta-code.balanced-brackets ! [[][]] OK []][[] NOT OK :: balanced? ( str -- ? ) - 0 :> counter! - t :> ok! + 0 set: counter! + t set: ok! str [ { { char: \[ [ 1 ] } diff --git a/demos/rosetta-code/bitmap-bezier/bitmap-bezier.factor b/demos/rosetta-code/bitmap-bezier/bitmap-bezier.factor index e65a13aab7..123f4f33eb 100644 --- a/demos/rosetta-code/bitmap-bezier/bitmap-bezier.factor +++ b/demos/rosetta-code/bitmap-bezier/bitmap-bezier.factor @@ -11,7 +11,7 @@ IN: rosetta-code.bitmap-bezier ! draw a cubic bezier curves (definition on Wikipedia). :: (cubic-bezier) ( P0 P1 P2 P3 -- bezier ) - [ :> x + [ set: x 1 x - 3 ^ P0 n*v 1 x - sq 3 * x * P1 n*v 1 x - 3 * x sq * P2 n*v diff --git a/demos/rosetta-code/bitmap-line/bitmap-line.factor b/demos/rosetta-code/bitmap-line/bitmap-line.factor index 8c393f269f..c3045f2dcd 100644 --- a/demos/rosetta-code/bitmap-line/bitmap-line.factor +++ b/demos/rosetta-code/bitmap-line/bitmap-line.factor @@ -12,9 +12,9 @@ IN: rosetta-code.bitmap-line ! algorithm. :: line-points ( pt1 pt2 -- points ) - pt1 first2 :> y0! :> x0! - pt2 first2 :> y1! :> x1! - y1 y0 - abs x1 x0 - abs > :> steep + pt1 first2 set: y0! set: x0! + pt2 first2 set: y1! set: x1! + y1 y0 - abs x1 x0 - abs > set: steep steep [ y0 x0 y0! x0! y1 x1 y1! x1! @@ -23,12 +23,12 @@ IN: rosetta-code.bitmap-line x0 x1 x0! x1! y0 y1 y0! y1! ] when - x1 x0 - :> deltax - y1 y0 - abs :> deltay - 0 :> current-error! - deltay deltax / abs :> deltaerr - 0 :> ystep! - y0 :> y! + x1 x0 - set: deltax + y1 y0 - abs set: deltay + 0 set: current-error! + deltay deltax / abs set: deltaerr + 0 set: ystep! + y0 set: y! y0 y1 < [ 1 ystep! ] [ -1 ystep! ] if x0 x1 1 [ y steep [ swap ] when 2array diff --git a/demos/rosetta-code/continued-fraction/continued-fraction.factor b/demos/rosetta-code/continued-fraction/continued-fraction.factor index 4da2de3898..aa9fc80c47 100644 --- a/demos/rosetta-code/continued-fraction/continued-fraction.factor +++ b/demos/rosetta-code/continued-fraction/continued-fraction.factor @@ -50,7 +50,7 @@ M: pi cfrac-b :: cfrac-estimate ( cfrac terms -- number ) terms cfrac cfrac-a ! top = last a_n - terms 1 - 1 [a,b] [ :> n + terms 1 - 1 [a,b] [ set: n n cfrac cfrac-b swap / ! top = b_n / top n cfrac cfrac-a + ! top = top + a_n ] each ; @@ -59,7 +59,7 @@ M: pi cfrac-b rational 1 /mod ! split whole, fractional parts prec 10^ * ! multiply fraction by 10 ^ prec [ >integer unparse ] bi@ ! convert digits to strings - :> fraction + set: fraction "." ! push decimal point prec fraction length - dup 0 < [ drop 0 ] when diff --git a/demos/rosetta-code/count-the-coins/count-the-coins.factor b/demos/rosetta-code/count-the-coins/count-the-coins.factor index caf13c3f5f..6fff1552fb 100644 --- a/demos/rosetta-code/count-the-coins/count-the-coins.factor +++ b/demos/rosetta-code/count-the-coins/count-the-coins.factor @@ -29,7 +29,7 @@ IN: rosetta-code.count-the-coins PRIVATE< :: (make-change) ( cents coins -- ways ) - cents 1 + 0 :> ways + cents 1 + 0 set: ways 1 ways set-first coins |[ coin | coin cents [a,b] |[ j | diff --git a/demos/rosetta-code/dice7/dice7.factor b/demos/rosetta-code/dice7/dice7.factor index 1c7101bae3..cbe0ac7a6d 100644 --- a/demos/rosetta-code/dice7/dice7.factor +++ b/demos/rosetta-code/dice7/dice7.factor @@ -70,7 +70,7 @@ IN: rosetta-code.dice7 ! deviation from the ideal number of items in each bucket, ! expressed as a fraction of the total count. :: test-distribution ( #sides #trials quot error -- ) - #sides #trials quot replicate count-outcomes :> outcomes + #sides #trials quot replicate count-outcomes set: outcomes outcomes . outcomes error fair-counts? "Random enough" "Not random enough" ? . ; inline diff --git a/demos/rosetta-code/gray-code/gray-code.factor b/demos/rosetta-code/gray-code/gray-code.factor index c3a7e103f1..4e195c48f2 100644 --- a/demos/rosetta-code/gray-code/gray-code.factor +++ b/demos/rosetta-code/gray-code/gray-code.factor @@ -37,7 +37,7 @@ IN: rosetta-code.gray-code : gray-encode ( n -- n' ) dup -1 shift bitxor ; :: gray-decode ( n! -- n' ) - n :> p! + n set: p! [ n -1 shift dup n! 0 = not ] [ p n bitxor p! ] while diff --git a/demos/rosetta-code/hamming-lazy/hamming-lazy.factor b/demos/rosetta-code/hamming-lazy/hamming-lazy.factor index 738954cc50..474f5c5078 100644 --- a/demos/rosetta-code/hamming-lazy/hamming-lazy.factor +++ b/demos/rosetta-code/hamming-lazy/hamming-lazy.factor @@ -21,8 +21,8 @@ IN: rosetta-code.hamming-lazy ! a convenient library – supports arbitrary-precision integers). :: sort-merge ( xs ys -- result ) - xs car :> x - ys car :> y + xs car set: x + ys car set: y { { [ x y < ] [ [ x ] [ xs cdr ys sort-merge ] lazy-cons ] } { [ x y > ] [ [ y ] [ ys cdr xs sort-merge ] lazy-cons ] } @@ -30,7 +30,7 @@ IN: rosetta-code.hamming-lazy } cond ; :: hamming ( -- hamming ) - f :> h! + f set: h! [ 1 ] [ h 2 3 5 [ $[ _ * ] lmap-lazy ] tri-curry@ tri sort-merge sort-merge diff --git a/demos/rosetta-code/knapsack/knapsack.factor b/demos/rosetta-code/knapsack/knapsack.factor index d958f8bc45..d680b754a5 100644 --- a/demos/rosetta-code/knapsack/knapsack.factor +++ b/demos/rosetta-code/knapsack/knapsack.factor @@ -60,9 +60,9 @@ CONSTANT: limit 400 ; items length 1 + [ limit 1 + 0 ] replicate ; :: iterate ( item-no table -- ) - item-no table nth :> prev - item-no 1 + table nth :> curr - item-no items nth :> item + item-no table nth set: prev + item-no 1 + table nth set: curr + item-no items nth set: item limit [1,b] |[ weight | weight prev nth weight item weight>> - dup 0 >= @@ -77,10 +77,10 @@ CONSTANT: limit 400 ; :: extract-packed-items ( table -- items ) [ - limit :> weight! + limit set: weight! items length iota |[ item-no | - item-no table nth :> prev - item-no 1 + table nth :> curr + item-no table nth set: prev + item-no 1 + table nth set: curr weight [ curr nth ] [ prev nth ] bi = [ item-no items nth diff --git a/demos/rosetta-code/n-queens/n-queens.factor b/demos/rosetta-code/n-queens/n-queens.factor index ddc031d269..9eeccf5427 100644 --- a/demos/rosetta-code/n-queens/n-queens.factor +++ b/demos/rosetta-code/n-queens/n-queens.factor @@ -9,7 +9,7 @@ IN: rosetta-code.n-queens ! solve the puzzle with a board of side NxN. :: safe? ( board q -- ? ) - let[ q board nth :> x + let[ q board nth set: x q iota [ x swap [ board nth ] keep diff --git a/demos/rosetta-code/odd-word/odd-word.factor b/demos/rosetta-code/odd-word/odd-word.factor index 80177d3f7c..0a8c1f943d 100644 --- a/demos/rosetta-code/odd-word/odd-word.factor +++ b/demos/rosetta-code/odd-word/odd-word.factor @@ -50,9 +50,9 @@ PRIVATE< PRIVATE> :: read-odd-word ( -- ) - f :> first-continuation! - f :> last-continuation! - f :> reverse! + f set: first-continuation! + f set: last-continuation! + f set: reverse! ! Read characters. Loop until end of stream. [ read1 dup ] [ dup Letter? [ diff --git a/demos/smalltalk/compiler/compiler.factor b/demos/smalltalk/compiler/compiler.factor index 89d3f75f45..2591ffd7e2 100644 --- a/demos/smalltalk/compiler/compiler.factor +++ b/demos/smalltalk/compiler/compiler.factor @@ -87,7 +87,7 @@ M: ast-return compile-ast [ [ f ] swap suffix ] map [ ] join ; :: compile-sequence ( lexenv block -- vars quot ) - lexenv block block-lexenv lexenv-union :> lexenv + lexenv block block-lexenv lexenv-union set: lexenv block arguments>> lexenv lookup-block-vars lexenv block body>> (compile-sequence) block lexenv make-temporaries prepend ; diff --git a/demos/talks/otug-talk/otug-talk.factor b/demos/talks/otug-talk/otug-talk.factor index e90f27ae25..7bffa5798d 100644 --- a/demos/talks/otug-talk/otug-talk.factor +++ b/demos/talks/otug-talk/otug-talk.factor @@ -129,7 +129,7 @@ CONSTANT: otug-slides "Area of a triangle using Heron's formula" { $code ":: area ( a b c -- x ) - a b c + + 2 / :> p + a b c + + 2 / set: p p p a - * p b - * diff --git a/ffi/cairo-samples/cairo-samples.factor b/ffi/cairo-samples/cairo-samples.factor index e67261a579..7d0a88d9c1 100644 --- a/ffi/cairo-samples/cairo-samples.factor +++ b/ffi/cairo-samples/cairo-samples.factor @@ -12,11 +12,11 @@ IN: cairo-samples TUPLE: arc-gadget < cairo-gadget ; M:: arc-gadget render-cairo* ( gadget -- ) - 128.0 :> xc - 128.0 :> yc - 100.0 :> radius - pi 1/4 * :> angle1 - pi :> angle2 + 128.0 set: xc + 128.0 set: yc + 100.0 set: radius + pi 1/4 * set: angle1 + pi set: angle2 cr 10.0 cairo_set_line_width cr xc yc radius angle1 angle2 cairo_arc cr cairo_stroke @@ -55,9 +55,9 @@ M: clip-gadget render-cairo* ( gadget -- ) TUPLE: clip-image-gadget < cairo-gadget ; M:: clip-image-gadget render-cairo* ( gadget -- ) "resource:misc/icons/Factor_128x128.png" - normalize-path cairo_image_surface_create_from_png :> png - png cairo_image_surface_get_width :> w - png cairo_image_surface_get_height :> h + normalize-path cairo_image_surface_create_from_png set: png + png cairo_image_surface_get_width set: w + png cairo_image_surface_get_height set: h cr 128 128 76.8 0 2 pi * cairo_arc cr cairo_clip cr cairo_new_path @@ -69,8 +69,8 @@ M:: clip-image-gadget render-cairo* ( gadget -- ) TUPLE: dash-gadget < cairo-gadget ; M:: dash-gadget render-cairo* ( gadget -- ) - double-array{ 50 10 10 10 } underlying>> :> dashes - 4 :> ndash + double-array{ 50 10 10 10 } underlying>> set: dashes + 4 set: ndash cr dashes ndash -50 cairo_set_dash cr 10 cairo_set_line_width cr 128.0 25.6 cairo_move_to @@ -81,9 +81,9 @@ M:: dash-gadget render-cairo* ( gadget -- ) TUPLE: gradient-gadget < cairo-gadget ; M:: gradient-gadget render-cairo* ( gadget -- ) - 0 0 0 256 cairo_pattern_create_linear :> pat + 0 0 0 256 cairo_pattern_create_linear set: pat 115.2 102.4 25.6 102.4 102.4 128.0 - cairo_pattern_create_radial :> radial + cairo_pattern_create_radial set: radial pat 1 0 0 0 1 cairo_pattern_add_color_stop_rgba pat 0 1 1 1 1 cairo_pattern_add_color_stop_rgba cr 0 0 256 256 cairo_rectangle diff --git a/ffi/cocoa/enumeration/enumeration.factor b/ffi/cocoa/enumeration/enumeration.factor index db7fdb0e0b..8ee4c8957e 100644 --- a/ffi/cocoa/enumeration/enumeration.factor +++ b/ffi/cocoa/enumeration/enumeration.factor @@ -17,9 +17,9 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16 ; ] with-destructors ; inline :: (NSFastEnumeration-each) ( ... object quot: ( ... elt -- ) state stackbuf count -- ... ) - object state stackbuf count send\ countByEnumeratingWithState:objects:count: :> items-count + object state stackbuf count send\ countByEnumeratingWithState:objects:count: set: items-count items-count 0 = [ - state itemsPtr>> [ items-count id ] [ stackbuf ] if* :> items + state itemsPtr>> [ items-count id ] [ stackbuf ] if* set: items items-count iota [ items nth quot call ] each object quot state stackbuf count (NSFastEnumeration-each) ] unless ; inline recursive diff --git a/ffi/cocoa/subclassing/subclassing.factor b/ffi/cocoa/subclassing/subclassing.factor index b513cba8fa..510bd4a2c4 100644 --- a/ffi/cocoa/subclassing/subclassing.factor +++ b/ffi/cocoa/subclassing/subclassing.factor @@ -49,7 +49,7 @@ IN: cocoa.subclassing ] with-nested-compilation-unit ; :: (redefine-objc-method) ( class method -- ) - method init-method :> ( sel imp types ) + method init-method set: ( sel imp types ) class sel class_getInstanceMethod [ imp method_setImplementation drop @@ -63,7 +63,7 @@ IN: cocoa.subclassing ] [ 2drop ] if ; :: define-objc-class ( name superclass protocols methods -- ) - methods prepare-methods :> methods + methods prepare-methods set: methods name "cocoa.classes" create-word drop methods name redefine-objc-methods name [ methods protocols superclass name (define-objc-class) ] import-objc-class ; diff --git a/ffi/core-text/core-text-tests.factor b/ffi/core-text/core-text-tests.factor index 7a92ae7db3..e02bb0122a 100644 --- a/ffi/core-text/core-text-tests.factor +++ b/ffi/core-text/core-text-tests.factor @@ -20,8 +20,8 @@ IN: core-text.tests :: test-typographic-bounds ( string font -- ? ) [ - font test-font &CFRelease :> ctfont - string ctfont color: white &CFRelease :> ctline + font test-font &CFRelease set: ctfont + string ctfont color: white &CFRelease set: ctline ctfont ctline compute-line-metrics { [ width>> float? ] [ ascent>> float? ] diff --git a/ffi/core-text/core-text.factor b/ffi/core-text/core-text.factor index 64490915d9..36b2b5aad4 100644 --- a/ffi/core-text/core-text.factor +++ b/ffi/core-text/core-text.factor @@ -116,8 +116,8 @@ render-loc render-dim ; :: ( font string -- line ) [ line new-disposable - font retina? get-global [ cache-font@2x ] [ cache-font ] if :> open-font - string open-font font foreground>> |CFRelease :> line + font retina? get-global [ cache-font@2x ] [ cache-font ] if set: open-font + string open-font font foreground>> |CFRelease set: line open-font line compute-line-metrics [ >>metrics ] [ metrics>dim >>dim ] bi font >>font @@ -126,18 +126,18 @@ render-loc render-dim ; ] with-destructors ; :: render ( line -- line image ) - line line>> :> ctline - line string>> :> string - line font>> :> font + line line>> set: ctline + line string>> set: string + line font>> set: font line render-loc>> [ - ctline line-rect :> rect - rect origin>> CGPoint>loc :> (loc) - rect size>> CGSize>dim :> (dim) - (loc) vfloor :> loc - (loc) (dim) v+ vceiling :> ext - ext loc [ - >integer 1 max ] 2map :> dim + ctline line-rect set: rect + rect origin>> CGPoint>loc set: (loc) + rect size>> CGSize>dim set: (dim) + (loc) vfloor set: loc + (loc) (dim) v+ vceiling set: ext + ext loc [ - >integer 1 max ] 2map set: dim loc line render-loc<< dim line render-dim<< @@ -146,8 +146,8 @@ render-loc render-dim ; ] unless - line render-loc>> :> loc - line render-dim>> :> dim + line render-loc>> set: loc + line render-dim>> set: dim line dim [ { diff --git a/ffi/cuda/devices/devices.factor b/ffi/cuda/devices/devices.factor index a759ea9128..e3456516be 100644 --- a/ffi/cuda/devices/devices.factor +++ b/ffi/cuda/devices/devices.factor @@ -75,10 +75,10 @@ IN: cuda.devices :: (distribute-jobs) ( job-count per-job-shared max-shared-size max-block-size -- grid-size block-size per-block-shared ) per-job-shared [ max-block-size ] [ max-shared-size swap /i max-block-size min ] if-zero - job-count min :> job-max-block-size - job-count job-max-block-size up/i :> grid-size - job-count grid-size up/i :> block-size - block-size per-job-shared * :> per-block-shared + job-count min set: job-max-block-size + job-count job-max-block-size up/i set: grid-size + job-count grid-size up/i set: block-size + block-size per-job-shared * set: per-block-shared grid-size block-size per-block-shared ; inline diff --git a/ffi/cuda/nvcc/nvcc.factor b/ffi/cuda/nvcc/nvcc.factor index 989df5b14f..ff6ea8dbb3 100644 --- a/ffi/cuda/nvcc/nvcc.factor +++ b/ffi/cuda/nvcc/nvcc.factor @@ -23,7 +23,7 @@ M: macosx nvcc-path "/usr/local/cuda/bin/nvcc" ; ERROR: nvcc-failed n path ; :: compile-cu ( path -- path' ) - path normalize-path :> path2 + path normalize-path set: path2 path2 parent-directory [ path2 nvcc-command run-process wait-for-process [ path2 nvcc-failed ] unless-zero diff --git a/ffi/curses/curses.factor b/ffi/curses/curses.factor index a5882e115b..fc55b8f2c9 100644 --- a/ffi/curses/curses.factor +++ b/ffi/curses/curses.factor @@ -290,7 +290,7 @@ PRIVATE< :: (wcread) ( n encoding window-ptr -- string ) [ - n 1 + malloc &free :> str + n 1 + malloc &free set: str window-ptr str n ffi:wgetnstr curses-error str encoding alien>string ] with-destructors ; inline diff --git a/ffi/ecdsa/ecdsa.factor b/ffi/ecdsa/ecdsa.factor index f08c505f9c..8ca5116380 100644 --- a/ffi/ecdsa/ecdsa.factor +++ b/ffi/ecdsa/ecdsa.factor @@ -39,11 +39,11 @@ PRIVATE> [ &BN_clear_free EC_KEY_set_private_key ssl-error ] with-destructors ; :: set-public-key ( BIN -- ) - ec-key-handle :> KEY - KEY EC_KEY_get0_group :> GROUP + ec-key-handle set: KEY + KEY EC_KEY_get0_group set: GROUP GROUP EC_POINT_new dup ssl-error [ - &EC_POINT_clear_free :> POINT + &EC_POINT_clear_free set: POINT GROUP POINT BIN dup length f EC_POINT_oct2point ssl-error KEY POINT EC_KEY_set_public_key ssl-error ] with-destructors ; @@ -53,21 +53,21 @@ PRIVATE> dup [ dup BN_num_bits bits>bytes [ BN_bn2bin drop ] keep ] when ; :: get-public-key ( -- bin/f ) - ec-key-handle :> KEY + ec-key-handle set: KEY KEY EC_KEY_get0_public_key dup |[ PUB | - KEY EC_KEY_get0_group :> GROUP - GROUP EC_GROUP_get_degree bits>bytes 1 + :> LEN - LEN :> BIN + KEY EC_KEY_get0_group set: GROUP + GROUP EC_GROUP_get_degree bits>bytes 1 + set: LEN + LEN set: BIN GROUP PUB POINT_CONVERSION_COMPRESSED BIN LEN f EC_POINT_point2oct ssl-error BIN ] when ; :: ecdsa-sign ( DGST -- sig ) - ec-key-handle :> KEY - KEY ECDSA_size dup ssl-error :> SIG - 0 uint :> LEN + ec-key-handle set: KEY + KEY ECDSA_size dup ssl-error set: SIG + 0 uint set: LEN 0 DGST dup length SIG LEN KEY ECDSA_sign ssl-error LEN uint deref SIG resize ; diff --git a/ffi/fftw/fftw.factor b/ffi/fftw/fftw.factor index c0e28623ad..e4d6e9c4a8 100644 --- a/ffi/fftw/fftw.factor +++ b/ffi/fftw/fftw.factor @@ -25,7 +25,7 @@ PRIVATE< [ first2 rect> ] { } map-as ; :: (fft1d) ( seq sign -- seq' ) - seq length :> n + seq length set: n [ n seq >fftw-array diff --git a/ffi/gdbm/gdbm.factor b/ffi/gdbm/gdbm.factor index c093704785..87d8929379 100644 --- a/ffi/gdbm/gdbm.factor +++ b/ffi/gdbm/gdbm.factor @@ -83,7 +83,7 @@ DESTRUCTOR: gdbm-close :: (setopt) ( value option -- ) [ - int heap-size dup malloc &free :> ( size ptr ) + int heap-size dup malloc &free set: ( size ptr ) value ptr 0 int set-alien-value dbf option ptr size gdbm_setopt check-error ] with-destructors ; diff --git a/ffi/gobject-introspection/gobject-introspection.factor b/ffi/gobject-introspection/gobject-introspection.factor index 82629a08da..2ebea5b512 100755 --- a/ffi/gobject-introspection/gobject-introspection.factor +++ b/ffi/gobject-introspection/gobject-introspection.factor @@ -37,7 +37,7 @@ PRIVATE< path exists? [ path ] [ current-vocab-dirs custom-gir-dirs system-gir-dirs - 3append sift :> paths + 3append sift set: paths paths [ path append-path exists? ] find nip [ path append-path ] [ path paths gir-not-found ] if* ] if ; diff --git a/ffi/gtk-samples/hello-world/hello-world.factor b/ffi/gtk-samples/hello-world/hello-world.factor index c5908b0257..1f6c150037 100644 --- a/ffi/gtk-samples/hello-world/hello-world.factor +++ b/ffi/gtk-samples/hello-world/hello-world.factor @@ -8,21 +8,21 @@ IN: gtk-samples.hello-world nip "Hello! :)" utf8 string>alien gtk_label_set_text ; :: hello-world-win ( -- window ) - GTK_WINDOW_TOPLEVEL gtk_window_new :> window + GTK_WINDOW_TOPLEVEL gtk_window_new set: window window [ "Hello world!" utf8 string>alien gtk_window_set_title ] [ 300 200 gtk_window_set_default_size ] [ GTK_WIN_POS_CENTER gtk_window_set_position ] tri - gtk_fixed_new :> frame + gtk_fixed_new set: frame window frame gtk_container_add - "Say 'Hello!'" utf8 string>alien gtk_button_new_with_label :> button + "Say 'Hello!'" utf8 string>alien gtk_button_new_with_label set: button button 140 30 gtk_widget_set_size_request frame button 80 60 gtk_fixed_put - "" utf8 string>alien gtk_label_new :> label + "" utf8 string>alien gtk_label_new set: label frame label 120 110 gtk_fixed_put button "clicked" utf8 string>alien @@ -33,7 +33,7 @@ IN: gtk-samples.hello-world :: hello-world-main ( -- ) f f gtk_init - hello-world-win :> window + hello-world-win set: window window "destroy" utf8 string>alien [ 2drop gtk_main_quit ] GtkObject:destroy f diff --git a/ffi/gtk-samples/opengl/opengl.factor b/ffi/gtk-samples/opengl/opengl.factor index 6e2a090fec..ce141de7e2 100644 --- a/ffi/gtk-samples/opengl/opengl.factor +++ b/ffi/gtk-samples/opengl/opengl.factor @@ -8,8 +8,8 @@ IN: gtk-samples.opengl ! http://code.valaide.org/content/simple-opengl-sample-using-gtkglext :: on-configure ( sender event user-data -- result ) - sender gtk_widget_get_gl_context :> gl-context - sender gtk_widget_get_gl_window :> gl-drawable + sender gtk_widget_get_gl_context set: gl-context + sender gtk_widget_get_gl_window set: gl-drawable gl-drawable gl-context gdk_gl_drawable_gl_begin dup [ @@ -18,8 +18,8 @@ IN: gtk-samples.opengl ] when ; :: on-expose ( sender event user-data -- result ) - sender gtk_widget_get_gl_context :> gl-context - sender gtk_widget_get_gl_window :> gl-drawable + sender gtk_widget_get_gl_context set: gl-context + sender gtk_widget_get_gl_window set: gl-drawable gl-drawable gl-context gdk_gl_drawable_gl_begin dup [ @@ -42,14 +42,14 @@ IN: gtk-samples.opengl ] when ; :: opengl-win ( -- window ) - GTK_WINDOW_TOPLEVEL gtk_window_new :> window + GTK_WINDOW_TOPLEVEL gtk_window_new set: window window [ "OpenGL" utf8 string>alien gtk_window_set_title ] [ 200 200 gtk_window_set_default_size ] [ GTK_WIN_POS_CENTER gtk_window_set_position ] tri - GDK_GL_MODE_RGBA gdk_gl_config_new_by_mode :> gl-config + GDK_GL_MODE_RGBA gdk_gl_config_new_by_mode set: gl-config window gl-config f t GDK_GL_RGBA_TYPE gtk_widget_set_gl_capability drop @@ -67,7 +67,7 @@ IN: gtk-samples.opengl :: opengl-main ( -- ) f f gtk_init f f gtk_gl_init - opengl-win :> window + opengl-win set: window window "destroy" utf8 string>alien [ 2drop gtk_main_quit ] GtkObject:destroy diff --git a/ffi/macho/macho.factor b/ffi/macho/macho.factor index 1281df352f..d139825982 100644 --- a/ffi/macho/macho.factor +++ b/ffi/macho/macho.factor @@ -943,7 +943,7 @@ TYPED: load-commands ( macho: mach_header_32/64 -- load-commands ) : macho-nm ( path -- ) |[ macho | - macho load-commands segment-commands sections-array :> sections + macho load-commands segment-commands sections-array set: sections macho load-commands symtab-commands |[ symtab | macho symtab symbols [ [ drop n_value>> "%016x " printf ] diff --git a/ffi/mongodb/connection/connection.factor b/ffi/mongodb/connection/connection.factor index d063038940..1681684a25 100644 --- a/ffi/mongodb/connection/connection.factor +++ b/ffi/mongodb/connection/connection.factor @@ -132,11 +132,11 @@ PRIVATE> :: verify-nodes ( mdb -- ) [ - V{ } clone :> acc - mdb dup master-node [ check-node ] keep :> node1 + V{ } clone set: acc + mdb dup master-node [ check-node ] keep set: node1 mdb node1 remote>> [ [ check-node ] keep ] - [ drop f ] if* :> node2 + [ drop f ] if* set: node2 node1 [ acc push ] when* node2 [ acc push ] when* mdb acc nodelist>table >>nodes drop diff --git a/ffi/mongodb/driver/driver.factor b/ffi/mongodb/driver/driver.factor index 27c709fb4a..940f9c5eb7 100644 --- a/ffi/mongodb/driver/driver.factor +++ b/ffi/mongodb/driver/driver.factor @@ -164,8 +164,8 @@ PRIVATE< : check-collection ( collection -- fq-collection ) let[ - mdb-instance :> instance - instance name>> :> instance-name + mdb-instance set: instance + instance name>> set: instance-name dup mdb-collection? [ name>> ] when "." split1 over instance-name = [ nip ] [ drop ] if diff --git a/ffi/mongodb/operations/operations.factor b/ffi/mongodb/operations/operations.factor index 31a05bd4ca..d8f3d7e794 100644 --- a/ffi/mongodb/operations/operations.factor +++ b/ffi/mongodb/operations/operations.factor @@ -88,7 +88,7 @@ PRIVATE< ] with-output-stream* write flush ; inline :: build-query-object ( query -- selector ) - H{ } clone :> selector + H{ } clone set: selector query { [ orderby>> [ "$orderby" selector set-at ] when* ] [ explain>> [ "$explain" selector set-at ] when* ] diff --git a/ffi/opencl/ffi/ffi-tests.factor b/ffi/opencl/ffi/ffi-tests.factor index 86ee961b10..542091c655 100644 --- a/ffi/opencl/ffi/ffi-tests.factor +++ b/ffi/opencl/ffi/ffi-tests.factor @@ -24,16 +24,16 @@ ERROR: cl-error err ; dup CL_SUCCESS = [ drop ] [ cl-error ] if ; :: cl-string-array ( str -- alien ) - str ascii encode 0 suffix :> str-buffer - str-buffer length malloc &free :> str-alien + str ascii encode 0 suffix set: str-buffer + str-buffer length malloc &free set: str-alien str-alien str-buffer dup length memcpy str-alien ; :: opencl-square ( in -- out ) 0 f 0 uint [ clGetPlatformIDs cl-success ] keep uint deref dup void* [ f clGetPlatformIDs cl-success ] keep first - CL_DEVICE_TYPE_DEFAULT 1 f void* [ f clGetDeviceIDs cl-success ] keep void* deref :> device-id - f 1 device-id void* f f 0 int [ clCreateContext ] keep int deref cl-success :> context - context device-id 0 0 int [ clCreateCommandQueue ] keep int deref cl-success :> queue + CL_DEVICE_TYPE_DEFAULT 1 f void* [ f clGetDeviceIDs cl-success ] keep void* deref set: device-id + f 1 device-id void* f f 0 int [ clCreateContext ] keep int deref cl-success set: context + context device-id 0 0 int [ clCreateCommandQueue ] keep int deref cl-success set: queue [ context 1 kernel-source cl-string-array void* @@ -41,13 +41,13 @@ ERROR: cl-error err ; [ 0 f f f f clBuildProgram cl-success ] [ "square" cl-string-array 0 int [ clCreateKernel ] keep int deref cl-success ] [ ] tri - ] with-destructors :> ( kernel program ) + ] with-destructors set: ( kernel program ) context CL_MEM_READ_ONLY in byte-length f - 0 int [ clCreateBuffer ] keep int deref cl-success :> input + 0 int [ clCreateBuffer ] keep int deref cl-success set: input context CL_MEM_WRITE_ONLY in byte-length f - 0 int [ clCreateBuffer ] keep int deref cl-success :> output + 0 int [ clCreateBuffer ] keep int deref cl-success set: output queue input CL_TRUE 0 in byte-length in 0 f f clEnqueueWriteBuffer cl-success diff --git a/ffi/opencl/opencl-tests.factor b/ffi/opencl/opencl-tests.factor index a582c93632..928c1c2a30 100644 --- a/ffi/opencl/opencl-tests.factor +++ b/ffi/opencl/opencl-tests.factor @@ -21,16 +21,16 @@ __kernel void square( :: opencl-square ( in -- out ) [ - in byte-length :> num-bytes - in length :> num-floats - cl-platforms first devices>> first :> device - device 1array &dispose :> context - context device f f &dispose :> queue + in byte-length set: num-bytes + in length set: num-floats + cl-platforms first devices>> first set: device + device 1array &dispose set: context + context device f f &dispose set: queue context device queue [ - "" kernel-source 1array &dispose "square" &dispose :> kernel - cl-read-access num-bytes in &dispose :> in-buffer - cl-write-access num-bytes f &dispose :> out-buffer + "" kernel-source 1array &dispose "square" &dispose set: kernel + cl-read-access num-bytes in &dispose set: in-buffer + cl-write-access num-bytes f &dispose set: out-buffer kernel in-buffer out-buffer num-floats uint 3array { num-floats } [ ] cl-queue-kernel &dispose drop diff --git a/ffi/opengl/opengl.factor b/ffi/opengl/opengl.factor index 0c977d8816..9bf7cf974e 100644 --- a/ffi/opengl/opengl.factor +++ b/ffi/opengl/opengl.factor @@ -119,8 +119,8 @@ MACRO: all-enabled-client-state ( seq quot -- quot ) ! We use GL_LINE_STRIP with a duplicated first vertex ! instead of GL_LINE_LOOP to work around a bug in Apple's ! X3100 driver. - loc first2 [ 0.3 + ] bi@ :> ( x y ) - dim first2 [ 0.6 - ] bi@ :> ( w h ) + loc first2 [ 0.3 + ] bi@ set: ( x y ) + dim first2 [ 0.6 - ] bi@ set: ( w h ) [ x y x w + y @@ -139,8 +139,8 @@ MACRO: all-enabled-client-state ( seq quot -- quot ) rect-vertices (gl-rect) ; :: (fill-rect-vertices) ( loc dim -- vertices ) - loc first2 :> ( x y ) - dim first2 :> ( w h ) + loc first2 set: ( x y ) + dim first2 set: ( w h ) [ x y x w + y diff --git a/ffi/opengl/textures/textures.factor b/ffi/opengl/textures/textures.factor index d773a9a824..e9dc5761bd 100644 --- a/ffi/opengl/textures/textures.factor +++ b/ffi/opengl/textures/textures.factor @@ -282,7 +282,7 @@ TUPLE: single-texture < disposable image dim loc texture-coords texture display- ] unless ; :: tex-image ( image bitmap -- ) - image image-format :> ( internal-format format type ) + image image-format set: ( internal-format format type ) GL_TEXTURE_2D 0 internal-format image dim>> adjust-texture-dim first2 0 format type bitmap glTexImage2D ; diff --git a/ffi/python/syntax/syntax.factor b/ffi/python/syntax/syntax.factor index af52100937..5291618ddb 100644 --- a/ffi/python/syntax/syntax.factor +++ b/ffi/python/syntax/syntax.factor @@ -41,7 +41,7 @@ SYMBOL: current-context [ py-import ] dip getattr ; :: add-function ( name effect module prefix? -- ) - module name prefix? make-factor-words :> ( call-word obj-word ) + module name prefix? make-factor-words set: ( call-word obj-word ) obj-word module name $[ _ _ import-getattr ] ( -- o ) define-inline call-word obj-word def>> effect make-function-quot effect define-inline ; diff --git a/ffi/unix/unix.factor b/ffi/unix/unix.factor index f7e884bcea..07028e8154 100644 --- a/ffi/unix/unix.factor +++ b/ffi/unix/unix.factor @@ -16,10 +16,10 @@ ERROR: unix-system-call-error args errno message word ; } 1|| ; MACRO:: unix-system-call ( quot -- quot ) - quot inputs :> n - quot first :> word - 0 :> ret! - f :> failed! + quot inputs set: n + quot first set: word + 0 set: ret! + f set: failed! [ [ n ndup quot call ret! @@ -39,9 +39,9 @@ MACRO:: unix-system-call ( quot -- quot ) ] ; MACRO:: unix-system-call-allow-eintr ( quot -- quot ) - quot inputs :> n - quot first :> word - 0 :> ret! + quot inputs set: n + quot first set: word + 0 set: ret! [ n ndup quot call ret! ret unix-call-failed? [ diff --git a/ffi/windows/registry/registry.factor b/ffi/windows/registry/registry.factor index e42fc11493..d7955194a2 100644 --- a/ffi/windows/registry/registry.factor +++ b/ffi/windows/registry/registry.factor @@ -24,7 +24,7 @@ CONSTANT: registry-value-max-length 16384 ; ] keep HKEY deref ; :: create-key* ( hKey lpSubKey lpClass dwOptions samDesired lpSecurityAttributes -- hkey new? ) - f :> ret! + f set: ret! hKey lpSubKey 0 lpClass dwOptions samDesired lpSecurityAttributes 0 HKEY 0 DWORD @@ -50,13 +50,13 @@ CONSTANT: registry-value-max-length 16384 ; ] if ; :: with-open-registry-key ( key subkey mode quot -- ) - key subkey mode open-key :> hkey + key subkey mode open-key set: hkey [ hkey quot call ] [ hkey close-key ] [ ] cleanup ; inline :: with-create-registry-key ( key subkey quot -- ) - key subkey create-key :> hkey + key subkey create-key set: hkey [ hkey quot call ] [ hkey close-key ] [ ] cleanup ; inline @@ -67,9 +67,9 @@ PRIVATE< length 2 * ; :: reg-query-value-ex ( key subkey ptr1 ptr2 buffer -- buffer ) - buffer length uint :> pdword + buffer length uint set: pdword key subkey ptr1 ptr2 buffer pdword [ RegQueryValueEx ] 2keep - rot :> ret + rot set: ret ret ERROR_SUCCESS = [ uint deref head ] [ @@ -100,12 +100,12 @@ TUPLE: registry-enum-key ; :: reg-enum-keys ( registry-info -- seq ) registry-info sub-keys>> iota [ [ registry-info key>> ] dip - registry-value-max-length TCHAR dup :> registry-value - registry-value length dup :> registry-value-length + registry-value-max-length TCHAR dup set: registry-value + registry-value length dup set: registry-value-length f - 0 DWORD dup :> type - f ! 0 BYTE dup :> data - f ! 0 BYTE dup :> buffer + 0 DWORD dup set: type + f ! 0 BYTE dup set: data + f ! 0 BYTE dup set: buffer RegEnumKeyEx dup ERROR_SUCCESS = [ ] [ @@ -115,18 +115,18 @@ TUPLE: registry-enum-key ; :: reg-query-info-key ( key -- n ) key MAX_PATH - dup TCHAR dup :> class-buffer - swap int dup :> class-buffer-length + dup TCHAR dup set: class-buffer + swap int dup set: class-buffer-length f - 0 DWORD dup :> sub-keys - 0 DWORD dup :> longest-subkey - 0 DWORD dup :> longest-class-string - 0 DWORD dup :> #values - 0 DWORD dup :> max-value - 0 DWORD dup :> max-value-data - 0 DWORD dup :> security-descriptor - FILETIME dup :> last-write-time - RegQueryInfoKey :> ret + 0 DWORD dup set: sub-keys + 0 DWORD dup set: longest-subkey + 0 DWORD dup set: longest-class-string + 0 DWORD dup set: #values + 0 DWORD dup set: max-value + 0 DWORD dup set: max-value-data + 0 DWORD dup set: security-descriptor + FILETIME dup set: last-write-time + RegQueryInfoKey set: ret ret ERROR_SUCCESS = [ key class-buffer diff --git a/ffi/windows/streams/streams.factor b/ffi/windows/streams/streams.factor index 416e0e00bd..34088f0e03 100644 --- a/ffi/windows/streams/streams.factor +++ b/ffi/windows/streams/streams.factor @@ -14,8 +14,8 @@ PRIVATE< :: IStream-read ( stream pv cb out-read -- hresult ) [ - cb stream stream-read :> buf - buf length :> bytes + cb stream stream-read set: buf + buf length set: bytes pv buf bytes memcpy out-read [ bytes out-read 0 ULONG set-alien-value ] when @@ -50,8 +50,8 @@ PRIVATE< :: IStream-copy-to ( stream other-stream cb out-read out-written -- hresult ) [ - cb stream stream-read :> buf - buf length :> bytes + cb stream stream-read set: buf + buf length set: bytes out-read [ bytes out-read 0 ULONG set-alien-value ] when other-stream buf bytes out-written IStream::Write @@ -70,9 +70,9 @@ PRIVATE< STG_E_INVALIDFUNCTION ; :: stream-size ( stream -- size ) - stream stream-tell :> old-pos + stream stream-tell set: old-pos 0 seek-end stream stream-seek - stream stream-tell :> size + stream stream-tell set: size old-pos seek-absolute stream stream-seek size ; diff --git a/ffi/windows/uniscribe/uniscribe.factor b/ffi/windows/uniscribe/uniscribe.factor index b4ad5248c4..be39edfeb7 100755 --- a/ffi/windows/uniscribe/uniscribe.factor +++ b/ffi/windows/uniscribe/uniscribe.factor @@ -68,7 +68,7 @@ CONSTANT: ssa-dwFlags flags{ SSA_GLYPHS SSA_FALLBACK SSA_TAB } ; ScriptStringOut check-ole32-error ; :: render-image ( dc ssa script-string -- image ) - script-string size>> :> size + script-string size>> set: size size dc [ ssa size script-string draw-script-string ] make-bitmap-image ; diff --git a/ffi/x11/xinput2/ffi/ffi.factor b/ffi/x11/xinput2/ffi/ffi.factor index ceaa89856d..85cae2925f 100644 --- a/ffi/x11/xinput2/ffi/ffi.factor +++ b/ffi/x11/xinput2/ffi/ffi.factor @@ -19,17 +19,17 @@ PRIVATE< PRIVATE> :: XISetMask ( mask event -- ) - event mask-index :> index + event mask-index set: index event bitmask index mask nth bitor index mask set-nth ; inline :: XIClearMask ( mask event -- ) - event mask-index :> index + event mask-index set: index event bitmask bitnot index mask nth bitand index mask set-nth ; inline :: XIMaskIsSet ( mask event -- n ) - event mask-index :> index + event mask-index set: index event bitmask index mask nth bitand ; : XIMaskLen ( event -- n ) 7 + -3 shift ; diff --git a/frameworks/db/sqlite/sqlite.factor b/frameworks/db/sqlite/sqlite.factor index 28c9c32436..46f072331e 100644 --- a/frameworks/db/sqlite/sqlite.factor +++ b/frameworks/db/sqlite/sqlite.factor @@ -83,8 +83,8 @@ M: literal-bind sqlite-bind-conversion ( tuple literal-bind -- array ) ; M:: generator-bind sqlite-bind-conversion ( tuple generate-bind -- array ) - generate-bind generator-singleton>> eval-generator :> obj - generate-bind slot-name>> :> name + generate-bind generator-singleton>> eval-generator set: obj + generate-bind slot-name>> set: name obj name tuple set-slot-named generate-bind key>> obj generate-bind type>> ; diff --git a/frameworks/furnace/auth/providers/providers.factor b/frameworks/furnace/auth/providers/providers.factor index eaf16b660a..312abe966b 100644 --- a/frameworks/furnace/auth/providers/providers.factor +++ b/frameworks/furnace/auth/providers/providers.factor @@ -23,7 +23,7 @@ GENERIC: new-user ( user provider -- user/f ) ; ! Password recovery support :: issue-ticket ( email username provider -- user/f ) - username provider get-user :> user + username provider get-user set: user user [ user email>> length 0 > [ user email>> email = [ @@ -35,7 +35,7 @@ GENERIC: new-user ( user provider -- user/f ) ; ] [ f ] if ; :: claim-ticket ( ticket username provider -- user/f ) - username provider get-user :> user + username provider get-user set: user user [ user ticket>> ticket = [ user f >>ticket dup provider update-user diff --git a/frameworks/furnace/recaptcha/recaptcha.factor b/frameworks/furnace/recaptcha/recaptcha.factor index cfe1f0103c..801ca0251f 100644 --- a/frameworks/furnace/recaptcha/recaptcha.factor +++ b/frameworks/furnace/recaptcha/recaptcha.factor @@ -50,8 +50,8 @@ PRIVATE< "\n" split first2 [ "true" = ] dip ; :: (validate-recaptcha) ( challenge response recaptcha -- valid? error ) - recaptcha private-key>> :> private-key - remote-address get host>> :> remote-ip + recaptcha private-key>> set: private-key + remote-address get host>> set: remote-ip H{ { "challenge" challenge } { "response" response } diff --git a/frameworks/game/debug/debug.factor b/frameworks/game/debug/debug.factor index d320d23a73..766fc3e246 100644 --- a/frameworks/game/debug/debug.factor +++ b/frameworks/game/debug/debug.factor @@ -105,7 +105,7 @@ CONSTANT: debug-text-texture-parameters :: screen-quad ( image pt dim -- float-array ) pt dim v/ 2.0 v*n 1.0 v-n dup image dim>> dim v/ 2.0 v*n v+ - [ first2 ] bi@ :> ( x0 y0 x1 y1 ) + [ first2 ] bi@ set: ( x0 y0 x1 y1 ) image upside-down?>> [ { x0 y0 0 0 x1 y0 1 0 x1 y1 1 1 x0 y1 0 1 } ] [ { x0 y0 0 1 x1 y0 1 1 x1 y1 1 0 x0 y1 0 0 } ] diff --git a/frameworks/game/debug/tests/tests.factor b/frameworks/game/debug/tests/tests.factor index 1404eadffc..8fba735fb4 100644 --- a/frameworks/game/debug/tests/tests.factor +++ b/frameworks/game/debug/tests/tests.factor @@ -17,7 +17,7 @@ IN: game.debug.tests 180 / pi * ; :: draw-debug-tests ( world -- ) - world [ wasd-p-matrix ] [ wasd-mv-matrix ] bi m. :> mvp-matrix + world [ wasd-p-matrix ] [ wasd-mv-matrix ] bi m. set: mvp-matrix { 0 0 0 } clear-screen [ diff --git a/frameworks/game/input/demos/joysticks/joysticks.factor b/frameworks/game/input/demos/joysticks/joysticks.factor index 7a66975d94..33889c4c82 100644 --- a/frameworks/game/input/demos/joysticks/joysticks.factor +++ b/frameworks/game/input/demos/joysticks/joysticks.factor @@ -51,7 +51,7 @@ CONSTANT: pov-polygons [ (xy>loc) ] dip (z>loc) ; :: move-axis ( gadget x y z -- ) - x y z (xyz>loc) :> ( xy z ) + x y z (xyz>loc) set: ( xy z ) xy gadget indicator>> loc<< z gadget z-indicator>> loc<< ; diff --git a/frameworks/game/input/iokit/iokit.factor b/frameworks/game/input/iokit/iokit.factor index b6a08f6442..965a3534ac 100644 --- a/frameworks/game/input/iokit/iokit.factor +++ b/frameworks/game/input/iokit/iokit.factor @@ -281,7 +281,7 @@ M: iokit-game-input-backend reset-mouse } cond ; :: (device-input-callback) ( context result sender value -- ) - sender get-input-device :> device + sender get-input-device set: device { { [ device mouse-device? ] [ +mouse-state+ get-global value record-mouse ] } { [ device controller-device? ] [ diff --git a/frameworks/game/models/util/util.factor b/frameworks/game/models/util/util.factor index c13c7a5d8a..ca5e4bcce5 100644 --- a/frameworks/game/models/util/util.factor +++ b/frameworks/game/models/util/util.factor @@ -13,9 +13,9 @@ M: indexed-seq nth [ iseq>> nth ] keep dseq>> nth ; inline M:: indexed-seq set-nth ( elt n seq -- ) - seq dseq>> :> dseq - seq iseq>> :> iseq - seq rassoc>> :> rassoc + seq dseq>> set: dseq + seq iseq>> set: iseq + seq rassoc>> set: rassoc seq length n = not [ elt n seq immutable ] when elt rassoc at [ diff --git a/frameworks/gpu/buffers/buffers.factor b/frameworks/gpu/buffers/buffers.factor index e006d0be73..883bd2418e 100644 --- a/frameworks/gpu/buffers/buffers.factor +++ b/frameworks/gpu/buffers/buffers.factor @@ -87,7 +87,7 @@ TYPED: buffer-size ( buffer: buffer -- size: integer ) buffer-range boa ; inline :: allocate-buffer ( buffer size initial-data -- ) - buffer bind-buffer :> target + buffer bind-buffer set: target target size initial-data buffer gl-buffer-usage glBufferData ; inline : allocate-byte-array ( buffer byte-array -- ) @@ -113,14 +113,14 @@ TYPED: byte-array>buffer ( byte-array [ byte-length ] [ ] bi ; TYPED:: update-buffer ( buffer-ptr: buffer-ptr size: integer data -- ) - buffer-ptr buffer>> :> buffer - buffer bind-buffer :> target + buffer-ptr buffer>> set: buffer + buffer bind-buffer set: target target buffer-ptr offset>> size data glBufferSubData ; TYPED:: read-buffer ( buffer-ptr: buffer-ptr size: integer -- data: byte-array ) - buffer-ptr buffer>> :> buffer - buffer bind-buffer :> target - size :> data + buffer-ptr buffer>> set: buffer + buffer bind-buffer set: target + size set: data target buffer-ptr offset>> size data glGetBufferSubData data ; @@ -140,7 +140,7 @@ TYPED: grow-buffer ( buffer: buffer target-size: integer -- ) [ (grow-buffer-size) f allocate-buffer ] [ 3drop ] if ; inline :: with-mapped-buffer ( ..a buffer access quot: ( ..a alien -- ..b ) -- ..b ) - buffer bind-buffer :> target + buffer bind-buffer set: target target access gl-access glMapBuffer quot call @@ -148,7 +148,7 @@ TYPED: grow-buffer ( buffer: buffer target-size: integer -- ) target glUnmapBuffer drop ; inline :: with-mapped-buffer-array ( ..a buffer access c-type quot: ( ..a array -- ..b ) -- ..b ) - buffer buffer-size c-type heap-size /i :> len + buffer buffer-size c-type heap-size /i set: len buffer access [ len c-type quot call ] with-mapped-buffer ; inline :: with-bound-buffer ( ..a buffer target quot: ( ..a -- ..b ) -- ..b ) diff --git a/frameworks/gpu/demos/bunny/bunny.factor b/frameworks/gpu/demos/bunny/bunny.factor index 115fc64117..a50e866637 100644 --- a/frameworks/gpu/demos/bunny/bunny.factor +++ b/frameworks/gpu/demos/bunny/bunny.factor @@ -120,7 +120,7 @@ UNIFORM-TUPLE: loading-uniforms (parse-bunny-model) ; inline :: calc-bunny-normal ( a b c vertexes -- ) - a b c [ vertexes nth vertex>> ] tri@ normal :> n + a b c [ vertexes nth vertex>> ] tri@ normal set: n a b c [ vertexes nth [ n v+ ] change-normal drop ] tri@ ; inline : calc-bunny-normals ( vertexes indexes -- ) diff --git a/frameworks/gpu/demos/raytrace/raytrace.factor b/frameworks/gpu/demos/raytrace/raytrace.factor index ed3090418d..0e7001b2c0 100644 --- a/frameworks/gpu/demos/raytrace/raytrace.factor +++ b/frameworks/gpu/demos/raytrace/raytrace.factor @@ -74,8 +74,8 @@ CONSTANT: initial-spheres { } ; :: set-up-audio ( world -- ) - world audio-engine>> :> audio-engine - world spheres>> :> spheres + world audio-engine>> set: audio-engine + world spheres>> set: spheres audio-engine world >>listener update-audio diff --git a/frameworks/gpu/effects/blur/blur.factor b/frameworks/gpu/effects/blur/blur.factor index 8e8451a313..acb23edd77 100644 --- a/frameworks/gpu/effects/blur/blur.factor +++ b/frameworks/gpu/effects/blur/blur.factor @@ -65,8 +65,8 @@ GLSL-PROGRAM: blur-program window-vertex-shader blur-fragment-shader window-vert } 2 render ; :: blur ( texture horizontal? -- texture ) - texture 0 texture-dim :> dim - dim RGB float-components <2d-render-texture> :> ( target-framebuffer target-texture ) + texture 0 texture-dim set: dim + dim RGB float-components <2d-render-texture> set: ( target-framebuffer target-texture ) texture horizontal? target-framebuffer dim (blur) target-framebuffer dispose target-texture ; diff --git a/frameworks/gpu/effects/step/step.factor b/frameworks/gpu/effects/step/step.factor index 911175b7b0..2acf26447c 100644 --- a/frameworks/gpu/effects/step/step.factor +++ b/frameworks/gpu/effects/step/step.factor @@ -34,7 +34,7 @@ GLSL-PROGRAM: step-program window-vertex-shader step-fragment-shader window-vert } 2 render ; :: step-texture ( texture ramp dim -- texture ) - dim RGB float-components <2d-render-texture> :> ( target-framebuffer target-texture ) + dim RGB float-components <2d-render-texture> set: ( target-framebuffer target-texture ) texture ramp target-framebuffer dim (step-texture) target-framebuffer dispose target-texture ; diff --git a/frameworks/gpu/framebuffers/framebuffers.factor b/frameworks/gpu/framebuffers/framebuffers.factor index 22e8c10320..3c699ae5aa 100644 --- a/frameworks/gpu/framebuffers/framebuffers.factor +++ b/frameworks/gpu/framebuffers/framebuffers.factor @@ -382,7 +382,7 @@ TYPED:: copy-framebuffer ( to-fb-rect: framebuffer-rect from-fb-rect [ framebuffer>> ] [ attachment>> ] bi gl-attachment glReadBuffer to-fb-rect attachment>> [ GL_COLOR_BUFFER_BIT ] [ 0 ] if depth? [ GL_DEPTH_BUFFER_BIT ] [ 0 ] if bitor - stencil? [ GL_STENCIL_BUFFER_BIT ] [ 0 ] if bitor :> mask + stencil? [ GL_STENCIL_BUFFER_BIT ] [ 0 ] if bitor set: mask from-fb-rect rect>> rect-extent [ first2 ] bi@ to-fb-rect rect>> rect-extent [ first2 ] bi@ diff --git a/frameworks/gpu/render/render.factor b/frameworks/gpu/render/render.factor index 3d100172f0..48361b5023 100755 --- a/frameworks/gpu/render/render.factor +++ b/frameworks/gpu/render/render.factor @@ -362,8 +362,8 @@ M: binary-data bind-uniform-vec4 ( index sequence -- ) 1 swap glUniform4fv ; inl DEFER: [bind-uniform-tuple] :: [bind-uniform-array] ( value>>-quot type texture-unit name dim -- texture-unit' quot ) - { name uniform-index } >quotation :> index-quot - { index-quot value>>-quot bi* } >quotation :> pre-quot + { name uniform-index } >quotation set: index-quot + { index-quot value>>-quot bi* } >quotation set: pre-quot type H{ { bool-uniform { dim swap >uniform-bool-array glUniform1iv } } @@ -399,14 +399,14 @@ DEFER: [bind-uniform-tuple] { mat4-uniform { [ dim 0 ] dip 4 4 >uniform-matrix-array glUniformMatrix4fv } } { texture-uniform { drop dim dup iota [ texture-unit + ] int-array{ } map-as glUniform1iv } } - } at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot + } at [ uniform invalid-uniform-type ] unless* >quotation set: value-quot type uniform-type-texture-units dim * texture-unit + pre-quot value-quot append ; :: [bind-uniform-value] ( value>>-quot type texture-unit name -- texture-unit' quot ) - { name uniform-index } >quotation :> index-quot - { index-quot value>>-quot bi* } >quotation :> pre-quot + { name uniform-index } >quotation set: index-quot + { index-quot value>>-quot bi* } >quotation set: pre-quot type H{ { bool-uniform [ >c-bool glUniform1i ] } @@ -442,7 +442,7 @@ DEFER: [bind-uniform-tuple] { mat4-uniform [ [ 1 0 ] dip 4 4 >uniform-matrix glUniformMatrix4fv ] } { texture-uniform { drop texture-unit glUniform1i } } - } at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot + } at [ uniform invalid-uniform-type ] unless* >quotation set: value-quot type uniform-type-texture-units texture-unit + pre-quot value-quot append ; @@ -456,22 +456,22 @@ DEFER: [bind-uniform-tuple] ] [ { [ ] } name "." append 1array - ] if* :> ( quot-prefixes name-prefixes ) - type all-uniform-tuple-slots :> uniforms + ] if* set: ( quot-prefixes name-prefixes ) + type all-uniform-tuple-slots set: uniforms texture-unit quot-prefixes name-prefixes |[ quot-prefix name-prefix | uniforms name-prefix [bind-uniform-tuple] quot-prefix prepend - ] 2map :> ( texture-unit' value-cleave ) + ] 2map set: ( texture-unit' value-cleave ) texture-unit' value>>-quot { value-cleave 2cleave } append ; :: [bind-uniform] ( texture-unit uniform prefix -- texture-unit' quot ) - prefix uniform name>> append hyphens>underscores :> name - uniform uniform-type>> :> type - uniform dim>> :> dim - uniform name>> reader-word 1quotation :> value>>-quot + prefix uniform name>> append hyphens>underscores set: name + uniform uniform-type>> set: type + uniform dim>> set: dim + uniform name>> reader-word 1quotation set: value>>-quot value>>-quot type texture-unit name { { [ type uniform-type? dim and ] [ dim [bind-uniform-array] ] } @@ -480,15 +480,15 @@ DEFER: [bind-uniform-tuple] } cond ; :: [bind-uniform-tuple] ( texture-unit uniforms prefix -- texture-unit' quot ) - texture-unit uniforms [ prefix [bind-uniform] ] map :> ( texture-unit' uniforms-cleave ) + texture-unit uniforms [ prefix [bind-uniform] ] map set: ( texture-unit' uniforms-cleave ) texture-unit' { uniforms-cleave 2cleave } >quotation ; :: [bind-uniforms] ( superclass uniforms -- quot ) - superclass "uniform-tuple-texture-units" word-prop 0 or :> first-texture-unit - superclass \ (bind-uniforms) lookup-method :> next-method - first-texture-unit uniforms "" [bind-uniform-tuple] nip :> bind-quot + superclass "uniform-tuple-texture-units" word-prop 0 or set: first-texture-unit + superclass \ (bind-uniforms) lookup-method set: next-method + first-texture-unit uniforms "" [bind-uniform-tuple] nip set: bind-quot { 2dup next-method } bind-quot [ ] append-as ; diff --git a/frameworks/gpu/shaders/shaders.factor b/frameworks/gpu/shaders/shaders.factor index 90a531f117..a6b4bc7d3d 100755 --- a/frameworks/gpu/shaders/shaders.factor +++ b/frameworks/gpu/shaders/shaders.factor @@ -142,26 +142,26 @@ TR: hyphens>underscores "-" "_" ; } 0&& [ vertex-attribute inaccurate-feedback-attribute-error ] unless ; :: (bind-float-vertex-attribute) ( program-instance ptr name dim gl-type normalize? stride offset -- ) - program-instance name attribute-index :> idx + program-instance name attribute-index set: idx idx 0 >= [ idx glEnableVertexAttribArray idx dim gl-type normalize? stride offset ptr glVertexAttribPointer ] when ; inline :: (bind-int-vertex-attribute) ( program-instance ptr name dim gl-type stride offset -- ) - program-instance name attribute-index :> idx + program-instance name attribute-index set: idx idx 0 >= [ idx glEnableVertexAttribArray idx dim gl-type stride offset ptr glVertexAttribIPointer ] when ; inline :: [bind-vertex-attribute] ( stride offset vertex-attribute -- stride offset' quot ) - vertex-attribute name>> hyphens>underscores :> name - vertex-attribute component-type>> :> type - type gl-vertex-type :> gl-type - vertex-attribute dim>> :> dim - vertex-attribute normalize?>> >c-bool :> normalize? - vertex-attribute vertex-attribute-size :> size + vertex-attribute name>> hyphens>underscores set: name + vertex-attribute component-type>> set: type + type gl-vertex-type set: gl-type + vertex-attribute dim>> set: dim + vertex-attribute normalize?>> >c-bool set: normalize? + vertex-attribute vertex-attribute-size set: size stride offset size + { @@ -174,9 +174,9 @@ TR: hyphens>underscores "-" "_" ; } cond ; :: [bind-vertex-format] ( vertex-attributes -- quot ) - vertex-attributes vertex-attributes-size :> stride - stride 0 vertex-attributes [ [bind-vertex-attribute] ] { } map-as 2nip :> attributes-cleave - { attributes-cleave 2cleave } >quotation :> with-block + vertex-attributes vertex-attributes-size set: stride + stride 0 vertex-attributes [ [bind-vertex-attribute] ] { } map-as 2nip set: attributes-cleave + { attributes-cleave 2cleave } >quotation set: with-block { drop vertex-buffer with-block with-buffer-ptr } >quotation ; @@ -185,15 +185,15 @@ TR: hyphens>underscores "-" "_" ; [ [ nip invalid-link-feedback-format-error ] ] [ vertex-attributes [ name>> ascii malloc-string ] - void*-array{ } map-as :> varying-names - vertex-attributes length :> varying-count + void*-array{ } map-as set: varying-names + vertex-attributes length set: varying-count { drop varying-count varying-names GL_INTERLEAVED_ATTRIBS glTransformFeedbackVaryings } >quotation ] if ; :: [verify-feedback-attribute] ( vertex-attribute index -- quot ) - vertex-attribute name>> :> name - name length 1 + :> name-buffer-length + vertex-attribute name>> set: name + name length 1 + set: name-buffer-length { index name-buffer-length dup [ f 0 int 0 int ] dip @@ -203,7 +203,7 @@ TR: hyphens>underscores "-" "_" ; } >quotation ; :: [verify-feedback-format] ( vertex-attributes -- quot ) - vertex-attributes [ [verify-feedback-attribute] ] map-index :> verify-cleave + vertex-attributes [ [verify-feedback-attribute] ] map-index set: verify-cleave { drop verify-cleave cleave } >quotation ; : gl-geometry-shader-input ( input -- input ) @@ -395,7 +395,7 @@ PRIVATE< GL_MAX_VERTEX_ATTRIBS get-gl-int iota [ glDisableVertexAttribArray ] each ; inline :: ( vertex-formats program-instance -- vertex-array ) - gen-vertex-array :> handle + gen-vertex-array set: handle handle glBindVertexArray vertex-formats normalize-vertex-formats program-instance (bind-vertex-array) @@ -407,7 +407,7 @@ PRIVATE< [ normalize-vertex-formats ] dip vertex-array-collection boa ; inline :: ( vertex-buffer program-instance format -- vertex-array ) - gen-vertex-array :> handle + gen-vertex-array set: handle handle glBindVertexArray program-instance vertex-buffer ?>buffer-ptr format bind-vertex-format handle program-instance vertex-buffer ?>buffer 1array @@ -555,8 +555,8 @@ TYPED:: refresh-program ( program: program -- ) old-instance valid-handle? [ world [ [ - program shaders>> [ compile-shader |dispose ] map :> new-shader-instances - program new-shader-instances (link-program) |dispose :> new-program-instance + program shaders>> [ compile-shader |dispose ] map set: new-shader-instances + program new-shader-instances (link-program) |dispose set: new-program-instance old-instance new-program-instance become-program-instance new-shader-instances |[ new-shader-instance | diff --git a/frameworks/gpu/textures/textures.factor b/frameworks/gpu/textures/textures.factor index 6b6eb6ed8a..14a01449ff 100644 --- a/frameworks/gpu/textures/textures.factor +++ b/frameworks/gpu/textures/textures.factor @@ -168,7 +168,7 @@ M: cube-map-face texture-data-gl-target ] if* ; inline :: bind-tdt ( tdt -- texture ) - tdt texture-object :> texture + tdt texture-object set: texture texture [ texture-gl-target ] [ handle>> ] bi glBindTexture texture ; inline @@ -176,26 +176,26 @@ M: cube-map-face texture-data-gl-target dup number? [ product ] unless ; inline :: (allocate-texture) ( tdt level dim data dim-quot teximage-quot -- ) - tdt bind-tdt :> texture + tdt bind-tdt set: texture tdt texture-data-gl-target level texture texture-gl-internal-format dim dim-quot call 0 texture data texture-data-gl-args pixel-unpack-buffer teximage-quot with-gpu-data-ptr ; inline :: (allocate-compressed-texture) ( tdt level dim compressed-data dim-quot teximage-quot -- ) - tdt bind-tdt :> texture + tdt bind-tdt set: texture tdt texture-data-gl-target level compressed-data format>> gl-compressed-texture-format dim dim-quot call 0 compressed-data [ length>> ] [ ptr>> ] bi pixel-unpack-buffer teximage-quot with-gpu-data-ptr ; inline :: (update-texture) ( tdt level loc dim data dim-quot texsubimage-quot -- ) - tdt bind-tdt :> texture + tdt bind-tdt set: texture tdt texture-data-gl-target level loc dim dim-quot bi@ texture data texture-data-gl-args pixel-unpack-buffer texsubimage-quot with-gpu-data-ptr ; inline :: (update-compressed-texture) ( tdt level loc dim compressed-data dim-quot texsubimage-quot -- ) - tdt bind-tdt :> texture + tdt bind-tdt set: texture tdt texture-data-gl-target level loc dim dim-quot bi@ compressed-data [ format>> gl-compressed-texture-format ] [ length>> ] [ ptr>> ] tri @@ -254,17 +254,17 @@ M: texture-3d-data-target update-compressed-texture ( tdt level loc dim compress GENERIC#: texture-dim 1 ( tdt level -- dim ) ; M:: texture-1d-data-target texture-dim ( tdt level -- dim ) - tdt bind-tdt :> texture + tdt bind-tdt set: texture tdt texture-data-gl-target level GL_TEXTURE_WIDTH get-texture-int ; inline M:: texture-2d-data-target texture-dim ( tdt level -- dim ) - tdt bind-tdt :> texture + tdt bind-tdt set: texture tdt texture-data-gl-target level [ GL_TEXTURE_WIDTH get-texture-int ] [ GL_TEXTURE_HEIGHT get-texture-int ] 2bi 2array ; inline M:: texture-3d-data-target texture-dim ( tdt level -- dim ) - tdt bind-tdt :> texture + tdt bind-tdt set: texture tdt texture-data-gl-target level [ GL_TEXTURE_WIDTH get-texture-int ] [ GL_TEXTURE_HEIGHT get-texture-int ] @@ -279,7 +279,7 @@ M:: texture-3d-data-target texture-dim ( tdt level -- dim ) [ texture-dim ?product ] [ drop texture-object bytes-per-pixel ] 2bi * ; inline TYPED:: read-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -- ) - tdt bind-tdt :> texture + tdt bind-tdt set: texture tdt texture-data-gl-target level texture [ component-order>> ] [ component-type>> ] bi image-data-format gpu-data-ptr pixel-pack-buffer [ glGetTexImage ] with-gpu-data-ptr ; @@ -289,7 +289,7 @@ TYPED: read-texture ( tdt: texture-data-target level: integer -- byte-array: byt [ read-texture-to ] keep ; TYPED:: read-compressed-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -- ) - tdt bind-tdt :> texture + tdt bind-tdt set: texture tdt texture-data-gl-target level gpu-data-ptr pixel-pack-buffer [ glGetCompressedTexImage ] with-gpu-data-ptr ; diff --git a/frameworks/gpu/util/util.factor b/frameworks/gpu/util/util.factor index 970687ce6b..9a4b3e54c0 100644 --- a/frameworks/gpu/util/util.factor +++ b/frameworks/gpu/util/util.factor @@ -152,7 +152,7 @@ CONSTANT: window-vertexes } 3 render ; :: blended-point-sprite-batch ( verts texture point-size dim -- texture ) - dim RGB float-components <2d-render-texture> :> ( target-framebuffer target-texture ) + dim RGB float-components <2d-render-texture> set: ( target-framebuffer target-texture ) verts target-framebuffer texture point-size dim (blended-point-sprite-batch) target-framebuffer dispose target-texture ; diff --git a/frameworks/gpu/util/wasd/wasd.factor b/frameworks/gpu/util/wasd/wasd.factor index df4a3e2ee4..34fe7c9160 100644 --- a/frameworks/gpu/util/wasd/wasd.factor +++ b/frameworks/gpu/util/wasd/wasd.factor @@ -58,8 +58,8 @@ CONSTANT: fov 0.7 ; dim>> dup first2 min >float v/n fov v*n ; inline :: generate-p-matrix ( world -- matrix ) - world wasd-near-plane :> near-plane - world wasd-far-plane :> far-plane + world wasd-near-plane set: near-plane + world wasd-far-plane set: far-plane world wasd-fov-vector near-plane v*n near-plane far-plane frustum-matrix4 ; @@ -74,12 +74,12 @@ CONSTANT: fov 0.7 ; [ >>location ] [ >>yaw ] [ >>pitch ] tri* ; :: eye-rotate ( yaw pitch v -- v' ) - yaw neg :> y - pitch neg :> p - y cos :> cosy - y sin :> siny - p cos :> cosp - p sin :> sinp + yaw neg set: y + pitch neg set: p + y cos set: cosy + y sin set: siny + p cos set: cosp + p sin set: sinp cosy 0.0 siny neg 3array siny sinp * cosp cosy sinp * 3array @@ -122,7 +122,7 @@ M: wasd-world audio-orientation drop ; :: wasd-keyboard-input ( world -- ) - read-keyboard keys>> :> keys + read-keyboard keys>> set: keys key-w keys nth [ world walk-forward ] when key-s keys nth [ world walk-backward ] when key-a keys nth [ world walk-leftward ] when diff --git a/frameworks/ui/backend/cocoa/cocoa.factor b/frameworks/ui/backend/cocoa/cocoa.factor index 6c094f1132..9fdeedb516 100644 --- a/frameworks/ui/backend/cocoa/cocoa.factor +++ b/frameworks/ui/backend/cocoa/cocoa.factor @@ -132,10 +132,10 @@ CONSTANT: window-control>styleMask M:: cocoa-ui-backend (open-window) ( world -- ) world [ [ dim>> ] dip ] - with-world-pixel-format :> view + with-world-pixel-format set: view world window-controls>> textured-background swap member-eq? [ view make-context-transparent ] when - view world [ world>NSRect ] [ world>styleMask ] bi :> window + view world [ world>NSRect ] [ world>styleMask ] bi set: window view send\ release world view register-window window world window-loc>> auto-position diff --git a/frameworks/ui/backend/cocoa/views/views.factor b/frameworks/ui/backend/cocoa/views/views.factor index e260d695c6..6c4ffb6d34 100644 --- a/frameworks/ui/backend/cocoa/views/views.factor +++ b/frameworks/ui/backend/cocoa/views/views.factor @@ -304,7 +304,7 @@ CLASS< FactorView < NSOpenGLView METHOD: char readSelectionFromPasteboard: id pboard [ - self window :> window + self window set: window window [ pboard pasteboard-string [ window user-input 1 ] [ 0 ] if* @@ -314,7 +314,7 @@ CLASS< FactorView < NSOpenGLView ! Text input METHOD: void insertText: id text [ - self window :> window + self window set: window window [ text CF>string window user-input ] when @@ -343,7 +343,7 @@ CLASS< FactorView < NSOpenGLView ! Initialization METHOD: void updateFactorGadgetSize: id notification [ - self window :> window + self window set: window window [ self view-dim window dim<< yield ] when @@ -394,8 +394,8 @@ CLASS< FactorWindowDelegate < NSObject METHOD: void windowDidResignKey: id notification [ forget-rollover - notification send\ object send\ contentView :> view - view window :> window + notification send\ object send\ contentView set: view + view window set: window window [ view send\ isInFullScreenMode 0 = [ window unfocus-world ] when diff --git a/frameworks/ui/backend/gtk/gtk.factor b/frameworks/ui/backend/gtk/gtk.factor index 1866af8427..021353a7a8 100644 --- a/frameworks/ui/backend/gtk/gtk.factor +++ b/frameworks/ui/backend/gtk/gtk.factor @@ -78,7 +78,7 @@ M: gtk-clipboard set-clipboard-contents :: with-timer ( quot -- ) &free - GSource heap-size g_source_new &g_source_unref :> source + GSource heap-size g_source_new &g_source_unref set: source source f g_source_attach drop [ quot call( -- ) ] [ source g_source_destroy ] [ ] cleanup ; @@ -163,7 +163,7 @@ CONSTANT: action-key-codes 3drop forget-rollover t ; :: on-button-press ( win event user-data -- ? ) - win window :> world + win window set: world event type>> GDK_BUTTON_PRESS = [ event button>> { { 8 [ ] } @@ -178,7 +178,7 @@ CONSTANT: action-key-codes ] when t ; :: on-button-release ( win event user-data -- ? ) - win window :> world + win window set: world event type>> GDK_BUTTON_RELEASE = [ event button>> { { 8 [ world left-action send-action ] } @@ -303,7 +303,7 @@ CONSTANT: action-key-codes ! has to be called before the window signal handler :: im-on-key-event ( win event im-context -- ? ) - win window world-focus :> gadget + win window world-focus set: gadget gadget support-input-methods? [ im-context gadget update-cursor-location im-context event gtk_im_context_filter_keypress @@ -453,8 +453,8 @@ M: window-handle flush-gl-context ( handle -- ) ] [ first2 gtk_window_move ] if ; M:: gtk-ui-backend (open-window) ( world -- ) - GTK_WINDOW_TOPLEVEL gtk_window_new :> win - gtk_im_multicontext_new :> im + GTK_WINDOW_TOPLEVEL gtk_window_new set: win + gtk_im_multicontext_new set: im win im world handle<< diff --git a/frameworks/ui/backend/gtk/io/unix/unix.factor b/frameworks/ui/backend/gtk/io/unix/unix.factor index 4616c9ffdc..a7afce0b1f 100644 --- a/frameworks/ui/backend/gtk/io/unix/unix.factor +++ b/frameworks/ui/backend/gtk/io/unix/unix.factor @@ -41,7 +41,7 @@ CONSTANT: poll-fd-events M:: unix with-event-loop ( quot -- ) stop-io-thread &free - GSource heap-size g_source_new &g_source_unref :> source + GSource heap-size g_source_new &g_source_unref set: source source g_source_add_poll source f g_source_attach drop [ quot call( -- ) ] diff --git a/frameworks/ui/backend/x11/x11.factor b/frameworks/ui/backend/x11/x11.factor index ed2437d881..c4ec43a72f 100644 --- a/frameworks/ui/backend/x11/x11.factor +++ b/frameworks/ui/backend/x11/x11.factor @@ -394,10 +394,10 @@ M: x11-ui-backend system-alert : black ( -- xcolor ) 0 0 0 0 0 0 XColor ; inline M:: x11-ui-backend (grab-input) ( handle -- ) - handle window>> :> wnd - dpy get :> dpy - dpy wnd uchar-array{ 0 0 0 0 0 0 0 0 } 8 8 XCreateBitmapFromData :> pixmap - dpy pixmap dup black dup 0 0 XCreatePixmapCursor :> cursor + handle window>> set: wnd + dpy get set: dpy + dpy wnd uchar-array{ 0 0 0 0 0 0 0 0 } 8 8 XCreateBitmapFromData set: pixmap + dpy pixmap dup black dup 0 0 XCreatePixmapCursor set: cursor dpy wnd 1 NoEventMask GrabModeAsync dup wnd cursor CurrentTime XGrabPointer drop diff --git a/frameworks/ui/baseline-alignment/baseline-alignment.factor b/frameworks/ui/baseline-alignment/baseline-alignment.factor index 1551360268..829a290712 100644 --- a/frameworks/ui/baseline-alignment/baseline-alignment.factor +++ b/frameworks/ui/baseline-alignment/baseline-alignment.factor @@ -61,7 +61,7 @@ TUPLE: gadget-metrics height ascent descent cap-height ; :: combine-metrics ( graphics-height ascent descent cap-height -- ascent' descent' ) ascent [ - cap-height 0 or 2 / :> mid-line + cap-height 0 or 2 / set: mid-line graphics-height 2 / [ ascent mid-line - max mid-line + floor >integer ] [ descent mid-line + max mid-line - ceiling >integer ] bi @@ -80,13 +80,13 @@ PRIVATE> :: align-baselines ( gadgets -- ys ) gadgets [ dup pref-dim ] map - dup max-ascent 0 or :> max-ascent - dup max-cap-height 0 or :> max-cap-height - dup max-graphics-height :> max-graphics-height + dup max-ascent 0 or set: max-ascent + dup max-cap-height 0 or set: max-cap-height + dup max-graphics-height set: max-graphics-height - max-cap-height max-graphics-height + 2 /i :> critical-line - critical-line max-ascent [-] :> text-leading - max-ascent critical-line [-] :> graphics-leading + max-cap-height max-graphics-height + 2 /i set: critical-line + critical-line max-ascent [-] set: text-leading + max-ascent critical-line [-] set: graphics-leading [ dup ascent>> diff --git a/frameworks/ui/gadgets/editors/editors.factor b/frameworks/ui/gadgets/editors/editors.factor index 75b0cffb88..30eaaf04ad 100644 --- a/frameworks/ui/gadgets/editors/editors.factor +++ b/frameworks/ui/gadgets/editors/editors.factor @@ -182,7 +182,7 @@ TUPLE: selected-line start end first? last? ; ] [ drop f ] if ; :: draw-selection ( line pair editor -- ) - pair [ editor font>> line offset>x ] map :> pair + pair [ editor font>> line offset>x ] map set: pair editor selection-color>> gl-color pair first 0 2array pair second pair first - round 1 max editor line-height 2array diff --git a/frameworks/ui/gadgets/grid-lines/grid-lines.factor b/frameworks/ui/gadgets/grid-lines/grid-lines.factor index 2e6a2f599f..fe8641d526 100644 --- a/frameworks/ui/gadgets/grid-lines/grid-lines.factor +++ b/frameworks/ui/gadgets/grid-lines/grid-lines.factor @@ -11,7 +11,7 @@ C: grid-lines ; PRIVATE< :: (compute-grid-lines) ( grid n ns orientation -- seq ) - grid gap>> :> gap + grid gap>> set: gap ns n suffix gap orientation v. $[ _ - orientation n*v ] map dup grid dim>> gap v- orientation reverse v* $[ _ v+ ] map gap [ 2 /f ] map $[ [ _ v+ ] map ] bi@ zip ; diff --git a/frameworks/ui/gadgets/search-tables/search-tables.factor b/frameworks/ui/gadgets/search-tables/search-tables.factor index 960d0e727c..b902cb2e29 100644 --- a/frameworks/ui/gadgets/search-tables/search-tables.factor +++ b/frameworks/ui/gadgets/search-tables/search-tables.factor @@ -67,7 +67,7 @@ max-cols ; CONSULT: table-protocol search-table table>> ; :: ( values renderer quot -- gadget ) - f :> search + f set: search vertical search-table new-track values >>model search >>field diff --git a/frameworks/ui/gadgets/tables/tables.factor b/frameworks/ui/gadgets/tables/tables.factor index 3fb944ee28..b68d3637eb 100644 --- a/frameworks/ui/gadgets/tables/tables.factor +++ b/frameworks/ui/gadgets/tables/tables.factor @@ -160,7 +160,7 @@ M: table layout* ] bi ; :: column-loc ( font column width align -- loc ) - font column cell-dim :> ( cell-width cell-height cell-padding ) + font column cell-dim set: ( cell-width cell-height cell-padding ) cell-width width swap - align * cell-padding 2 / 1 align - * + cell-height \ line-height get swap - 2 / diff --git a/frameworks/ui/tools/error-list/error-list.factor b/frameworks/ui/tools/error-list/error-list.factor index 829c25c60c..2e4d4206ff 100644 --- a/frameworks/ui/tools/error-list/error-list.factor +++ b/frameworks/ui/tools/error-list/error-list.factor @@ -164,7 +164,7 @@ error-display "toolbar" f { dup >>source-file-table dup >>error-table dup >>error-display - :> error-list + set: error-list error-list vertical with-lines error-list f track-add error-list source-file-table>> margins white-interior diff --git a/frameworks/ui/tools/listener/listener.factor b/frameworks/ui/tools/listener/listener.factor index a39818268f..429d243547 100644 --- a/frameworks/ui/tools/listener/listener.factor +++ b/frameworks/ui/tools/listener/listener.factor @@ -482,9 +482,9 @@ PRIVATE< PRIVATE> :: set-listener-font ( family size -- ) - get-listener input>> :> inter + get-listener input>> set: inter family size make-font-style - inter output>> make-span-stream :> ostream + inter output>> make-span-stream set: ostream ostream inter output<< inter font>> clone family >>name diff --git a/games/fluids/fluids.factor b/games/fluids/fluids.factor index 7a97a1e48c..57e798fe47 100644 --- a/games/fluids/fluids.factor +++ b/games/fluids/fluids.factor @@ -21,8 +21,8 @@ CONSTANT: gravity { 0.0 -0.1 } ; :: verlet-integrate-particle ( particle dt -- particle' ) particle [ p>> ] [ v>> ] bi dt v*n v+ - gravity dt dt * particle m>> 2 * / v*n v+ :> p' - p' particle p>> v- dt v/n :> v' + gravity dt dt * particle m>> 2 * / v*n v+ set: p' + p' particle p>> v- dt v/n set: v' p' v' particle m>> particle_t ; inline CONSTANT: initial-particles @@ -91,7 +91,7 @@ M: fluids-world tick-game-world M:: fluids-world draw-world* ( world -- ) world particles>> [ [ p>> [ first , ] [ second , ] bi ] each - ] curry float-array{ } make :> verts + ] curry float-array{ } make set: verts [ verts world texture>> 30.0 world dim>> { 4 4 } v/ diff --git a/games/jamshred/player/player.factor b/games/jamshred/player/player.factor index ffd37860cd..438b2dae1b 100644 --- a/games/jamshred/player/player.factor +++ b/games/jamshred/player/player.factor @@ -98,8 +98,8 @@ CONSTANT: max-speed 30.0 ; ] if ; :: move-player-on-heading ( d-left player distance heading -- d-left' player ) - d-left distance min :> d-to-move - d-to-move heading n*v :> move-v + d-left distance min set: d-to-move + d-to-move heading n*v set: move-v move-v player location+ heading player update-nearest-segment2 diff --git a/games/jamshred/tunnel/tunnel.factor b/games/jamshred/tunnel/tunnel.factor index 52f8429cda..833eec80d9 100644 --- a/games/jamshred/tunnel/tunnel.factor +++ b/games/jamshred/tunnel/tunnel.factor @@ -79,12 +79,12 @@ CONSTANT: default-segment-radius 1 ; } case ; :: distance-to-next-segment ( current next location heading -- distance ) - current forward>> :> cf + current forward>> set: cf cf next location>> v. cf location v. - cf heading v. / ; :: distance-to-next-segment-area ( current next location heading -- distance ) - current forward>> :> cf - next current half-way-between-oints :> h + current forward>> set: cf + next current half-way-between-oints set: h cf h v. cf location v. - cf heading v. / ; : vector-to-centre ( seg loc -- v ) @@ -110,9 +110,9 @@ CONSTANT: distant 1000 ; v norm 0 = [ distant ] [ - v dup v. :> a - v w v. 2 * :> b - w dup v. r sq - :> c + v dup v. set: a + v w v. 2 * set: b + w dup v. r sq - set: c c b a quadratic max-real ] if ; diff --git a/games/snake-game/sprites/sprites.factor b/games/snake-game/sprites/sprites.factor index 63f2b25680..9373c1f7ab 100644 --- a/games/snake-game/sprites/sprites.factor +++ b/games/snake-game/sprites/sprites.factor @@ -12,7 +12,7 @@ IN: snake-game.sprites over bytes-per-pixel * >>bitmap ; :: image-part ( image x y w h -- image ) - image w h new-image-like :> new-image + image w h new-image-like set: new-image h iota |[ i | new-image bitmap>> x y i + w image pixel-row-slice-at @@ -20,10 +20,10 @@ IN: snake-game.sprites ] each new-image ; :: generate-sprite-sheet ( image rows cols -- seq ) - cols rows 2array :> split-dims - image dim>> split-dims [ / ] 2map first2 :> ( sw sh ) - rows iota sh v*n :> ys - cols iota sh v*n :> xs + cols rows 2array set: split-dims + image dim>> split-dims [ / ] 2map first2 set: ( sw sh ) + rows iota sh v*n set: ys + cols iota sh v*n set: xs ys xs [ swap [ image ] 2dip sw sh image-part ] cartesian-map f join ; @@ -44,7 +44,7 @@ IN: snake-game.sprites [ swap 2array ] 2map ; :: assoc-with-value-like ( assoc key seq -- ) - key assoc at :> value + key assoc at set: value seq [ [ value ] dip assoc set-at ] each ; : snake-body-textures ( -- assoc ) diff --git a/games/space-invaders/space-invaders.factor b/games/space-invaders/space-invaders.factor index 6f6a3df3d7..4f7abcc90a 100755 --- a/games/space-invaders/space-invaders.factor +++ b/games/space-invaders/space-invaders.factor @@ -26,7 +26,7 @@ CONSTANT: game-height 256 ; first2 game-width 3 * * swap 3 * + ; :: set-bitmap-pixel ( bitmap point color -- ) - point bitmap-index :> index + point bitmap-index set: index color first index bitmap set-nth color second index 1 + bitmap set-nth color third index 2 + bitmap set-nth ; diff --git a/games/terrain/terrain.factor b/games/terrain/terrain.factor index 8141dae1bc..c28285ed1a 100644 --- a/games/terrain/terrain.factor +++ b/games/terrain/terrain.factor @@ -116,8 +116,8 @@ terrain-world H{ } set-gestures :: handle-input ( world -- ) - world player>> :> player - read-keyboard keys>> :> keys + world player>> set: player + read-keyboard keys>> set: keys key-left-shift keys nth VELOCITY-MODIFIER-FAST VELOCITY-MODIFIER-NORMAL ? player velocity-modifier<< @@ -155,9 +155,9 @@ terrain-world H{ [ { 0 0 } vmax ] dip { 2 2 } v- vmin ; :: pixel-indices ( coords dim -- indices ) - coords vfloor v>integer dim clamp-coords :> floor-coords - floor-coords first2 dim first * + :> base-index - base-index dim first + :> next-row-index + coords vfloor v>integer dim clamp-coords set: floor-coords + floor-coords first2 dim first * + set: base-index + base-index dim first + set: next-row-index base-index base-index 1 + @@ -165,11 +165,11 @@ terrain-world H{ next-row-index 1 + 4array ; :: terrain-height-at ( segment point -- height ) - segment dim>> :> dim - dim point v* :> pixel - pixel dup vfloor v- :> pixel-mantissa - segment bitmap>> 4 :> pixels - pixel dim pixel-indices :> indices + segment dim>> set: dim + dim point v* set: pixel + pixel dup vfloor v- set: pixel-mantissa + segment bitmap>> 4 set: pixels + pixel dim pixel-indices set: indices indices [ pixels nth COMPONENT-SCALE v. 255.0 / ] map first4 pixel-mantissa bilerp ; @@ -181,9 +181,9 @@ terrain-world H{ ] keep vmax ; inline TYPED:: collide ( world: terrain-world player: player -- ) - world terrain-segment>> :> segment - player location>> :> location - segment location (collide) :> location' + world terrain-segment>> set: segment + player location>> set: location + segment location (collide) set: location' location location' = not [ player @@ -199,8 +199,8 @@ TYPED:: collide ( world: terrain-world player: player -- ) clone swap history>> push ; :: tick-player-reverse ( world player -- ) - player reverse-time>> :> reverse-time - world history>> :> history + player reverse-time>> set: reverse-time + world history>> set: history history length 0 > [ history length reverse-time 1 - - 1 max history set-length history pop world player<< diff --git a/language/alien/cxx/demangle/libstdcxx/libstdcxx.factor b/language/alien/cxx/demangle/libstdcxx/libstdcxx.factor index e1c47801f0..db61235264 100644 --- a/language/alien/cxx/demangle/libstdcxx/libstdcxx.factor +++ b/language/alien/cxx/demangle/libstdcxx/libstdcxx.factor @@ -24,9 +24,9 @@ ERROR: invalid-demangle-args name ; DESTRUCTOR: (free) :: demangle ( mangled-name -- c++-name ) - 0 ulong :> length - 0 int :> status [ - mangled-name ascii string>alien f length status __cxa_demangle &(free) :> demangled-buf + 0 ulong set: length + 0 int set: status [ + mangled-name ascii string>alien f length status __cxa_demangle &(free) set: demangled-buf mangled-name status int deref demangle-error demangled-buf ascii alien>string ] with-destructors ; diff --git a/language/alien/data/data.factor b/language/alien/data/data.factor index 66f1ec38d9..252118f486 100644 --- a/language/alien/data/data.factor +++ b/language/alien/data/data.factor @@ -96,7 +96,7 @@ M: bad-byte-array-length summary string>alien malloc-byte-array ; M:: memory-stream stream-read-unsafe ( n buf stream -- count ) - stream alien>> :> src + stream alien>> set: src buf src n memcpy n src stream alien<< n ; inline diff --git a/language/alien/data/map/map.factor b/language/alien/data/map/map.factor index 7625ef1d64..a5f671f442 100644 --- a/language/alien/data/map/map.factor +++ b/language/alien/data/map/map.factor @@ -88,9 +88,9 @@ MACRO: pack-params ( outs -- quot ) fry [ call ] compose ; :: [data-map] ( ins outs param-quot -- quot ) - ins length :> #ins - outs length :> #outs - #ins #outs + :> #params + ins length set: #ins + outs length set: #outs + #ins #outs + set: #params [ param-quot % diff --git a/language/alien/fortran/fortran.factor b/language/alien/fortran/fortran.factor index 7e9d15d05b..afc3922dc0 100755 --- a/language/alien/fortran/fortran.factor +++ b/language/alien/fortran/fortran.factor @@ -326,8 +326,8 @@ M: character-type () ] if-empty ; :: [fortran-invoke] ( [args>args] return library function parameters -- [args>args] quot ) - return parameters fortran-sig>c-sig :> ( c-return c-parameters ) - function fortran-name>symbol-name :> c-function + return parameters fortran-sig>c-sig set: ( c-return c-parameters ) + function fortran-name>symbol-name set: c-function [args>args] c-return library c-function c-parameters \ alien-invoke 5 [ ] nsequence diff --git a/language/alien/libraries/finder/macosx/macosx.factor b/language/alien/libraries/finder/macosx/macosx.factor index ff910e2cbf..a349144c1c 100644 --- a/language/alien/libraries/finder/macosx/macosx.factor +++ b/language/alien/libraries/finder/macosx/macosx.factor @@ -70,10 +70,10 @@ SYMBOL: dyld-executable-path ] if ; :: dyld-default-search ( name -- seq ) - name make-framework-info :> framework - name file-name :> basename - "DYLD_FALLBACK_FRAMEWORK_PATH" dyld-paths :> fallback-framework-path - "DYLD_FALLBACK_LIBRARY_PATH" dyld-paths :> fallback-library-path + name make-framework-info set: framework + name file-name set: basename + "DYLD_FALLBACK_FRAMEWORK_PATH" dyld-paths set: fallback-framework-path + "DYLD_FALLBACK_LIBRARY_PATH" dyld-paths set: fallback-library-path [ name , diff --git a/language/alien/parser/parser.factor b/language/alien/parser/parser.factor index 234176bc71..829e5de1ea 100755 --- a/language/alien/parser/parser.factor +++ b/language/alien/parser/parser.factor @@ -114,8 +114,8 @@ PRIVATE> scan-c-type scan-token parse-pointers ; :: scan-c-args ( -- types names ) - V{ } clone :> types - V{ } clone :> names + V{ } clone set: types + V{ } clone set: names "(" expect scan-token [ dup ")" = ] [ parse-c-type scan-token "," ?tail drop @@ -147,7 +147,7 @@ PRIVATE> $[ [ _ _ _ ] dip alien-callback ] ; :: make-callback-type ( return function library types names -- word quot effect ) - function create-function :> type-word + function create-function set: type-word void* type-word typedef type-word names return function-effect "callback-effect" set-word-prop type-word library "callback-library" set-word-prop diff --git a/language/alien/remote-control/remote-control-tests.factor b/language/alien/remote-control/remote-control-tests.factor index 8139555a48..66b5c19eaa 100644 --- a/language/alien/remote-control/remote-control-tests.factor +++ b/language/alien/remote-control/remote-control-tests.factor @@ -13,7 +13,7 @@ IN: alien.remote-control.tests ascii [ readln ] with-process-reader ; :: test-embedding ( code -- line ) - image-path :> image + image-path set: image [ I[[ diff --git a/language/bootstrap/image/image.factor b/language/bootstrap/image/image.factor index c980cb3dc7..feee5db819 100755 --- a/language/bootstrap/image/image.factor +++ b/language/bootstrap/image/image.factor @@ -102,7 +102,7 @@ SYMBOL: sub-primitives SYMBOL: special-objects :: jit-conditional ( test-quot false-quot -- ) - [ 0 test-quot call ] B{ } make length :> len + [ 0 test-quot call ] B{ } make length set: len building get length extra-offset get + len + [ extra-offset set false-quot call ] B{ } make [ length test-quot call ] [ % ] bi ; inline diff --git a/language/bootstrap/image/primitives/primitives.factor b/language/bootstrap/image/primitives/primitives.factor index 43e772d930..0537cad9f3 100644 --- a/language/bootstrap/image/primitives/primitives.factor +++ b/language/bootstrap/image/primitives/primitives.factor @@ -817,8 +817,8 @@ CONSTANT: all-primitives { [ rot set-word-prop ] with assoc-each ; :: create-primitive ( vocab word effect vm-func inputs outputs extra-word -- ) - word vocab primitive-word :> word - word vm-func primitive-quot :> quot + word vocab primitive-word set: word + word vm-func primitive-quot set: quot word quot effect define-declared word inputs "input-classes" set-word-prop word outputs "default-output-classes" set-word-prop diff --git a/language/channels/examples/examples.factor b/language/channels/examples/examples.factor index b841a10695..8acafd8a0f 100644 --- a/language/channels/examples/examples.factor +++ b/language/channels/examples/examples.factor @@ -25,8 +25,8 @@ IN: channels.examples ] 3keep filter ; :: (sieve) ( prime c -- ) - c from :> p - :> newc + c from set: p + set: newc p prime to [ newc p c filter ] "Filter" spawn drop prime newc (sieve) ; diff --git a/language/classes/struct/bit-accessors/bit-accessors.factor b/language/classes/struct/bit-accessors/bit-accessors.factor index bd6daaf4c1..f5d9d68eff 100644 --- a/language/classes/struct/bit-accessors/bit-accessors.factor +++ b/language/classes/struct/bit-accessors/bit-accessors.factor @@ -11,10 +11,10 @@ IN: classes.struct.bit-accessors [ on-bits ] bi@ swap unmask ; :: manipulate-bits ( offset bits step-quot -- quot shift-amount offset' bits' ) - offset 8 /mod :> ( i start-bit ) - start-bit bits + 8 min :> end-bit - start-bit end-bit ones-between :> mask - end-bit start-bit - :> used-bits + offset 8 /mod set: ( i start-bit ) + start-bit bits + 8 min set: end-bit + start-bit end-bit ones-between set: mask + end-bit start-bit - set: used-bits i mask start-bit step-quot call( i mask start-bit -- quot ) used-bits diff --git a/language/classes/struct/struct.factor b/language/classes/struct/struct.factor index fc148c6a02..6e446ab3ce 100644 --- a/language/classes/struct/struct.factor +++ b/language/classes/struct/struct.factor @@ -281,11 +281,11 @@ PRIVATE< slot-specs check-struct-slots slot-specs empty? [ struct-must-have-slots ] when class redefine-struct-tuple-class - slot-specs offsets-quot call :> unaligned-size - slot-specs alignment-quot call :> alignment - unaligned-size alignment align :> size + slot-specs offsets-quot call set: unaligned-size + slot-specs alignment-quot call set: alignment + unaligned-size alignment align set: size - class slot-specs size alignment c-type-for-class :> c-type + class slot-specs size alignment c-type-for-class set: c-type c-type class typedef class slot-specs define-accessors diff --git a/language/combinators/tuple/tuple.factor b/language/combinators/tuple/tuple.factor index 915a24e10d..1e49deece7 100644 --- a/language/combinators/tuple/tuple.factor +++ b/language/combinators/tuple/tuple.factor @@ -7,15 +7,15 @@ PRIVATE< :: (tuple-slot-quot) ( slot assoc n -- quot ) slot name>> assoc at [ - slot initial>> :> initial + slot initial>> set: initial { n ndrop initial } >quotation ] unless* ; PRIVATE> MACRO:: nmake-tuple ( class assoc n -- quot ) - class all-slots [ assoc n (tuple-slot-quot) ] map :> quots - class :> \class + class all-slots [ assoc n (tuple-slot-quot) ] map set: quots + class set: \class { quots n ncleave \class boa } >quotation ; : make-tuple ( x class assoc -- tuple ) diff --git a/language/compiler/cfg/alias-analysis/alias-analysis.factor b/language/compiler/cfg/alias-analysis/alias-analysis.factor index 63981405d4..ded77ac02f 100644 --- a/language/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/language/compiler/cfg/alias-analysis/alias-analysis.factor @@ -111,7 +111,7 @@ SYMBOL: ac-counter recent-stores get [ drop H{ } clone ] cache ; :: record-constant-set-slot ( insn# slot# vreg -- ) - vreg recent-stores-of :> recent-stores + vreg recent-stores-of set: recent-stores slot# recent-stores at [ dead-store ] when* insn# slot# recent-stores set-at ; @@ -193,10 +193,10 @@ M: read-insn analyze-aliases live-slot = ; M:: write-insn analyze-aliases ( insn -- insn ) - insn src>> resolve :> src - insn insn-slot# :> slot# - insn insn-object :> vreg - insn insn#>> :> insn# + insn src>> resolve set: src + insn insn-slot# set: slot# + insn insn-object set: vreg + insn insn#>> set: insn# src slot# vreg idempotent? [ insn# dead-store ] [ src heap-ac get merge-acs diff --git a/language/compiler/cfg/branch-splitting/branch-splitting.factor b/language/compiler/cfg/branch-splitting/branch-splitting.factor index f64eb8c42d..77d5e5d8a9 100644 --- a/language/compiler/cfg/branch-splitting/branch-splitting.factor +++ b/language/compiler/cfg/branch-splitting/branch-splitting.factor @@ -31,7 +31,7 @@ IN: compiler.cfg.branch-splitting $[ [ _ ] dip update-successors ] 2each ; :: update-successor-predecessor ( copies old-bb succ -- ) - succ predecessors>> dup >array :> ( preds preds' ) + succ predecessors>> dup >array set: ( preds preds' ) preds delete-all preds' [ dup old-bb eq? diff --git a/language/compiler/cfg/build-stack-frame/build-stack-frame.factor b/language/compiler/cfg/build-stack-frame/build-stack-frame.factor index 139df2466a..f0cf52dac6 100644 --- a/language/compiler/cfg/build-stack-frame/build-stack-frame.factor +++ b/language/compiler/cfg/build-stack-frame/build-stack-frame.factor @@ -10,8 +10,8 @@ SYMBOLS: param-area-size allot-area-size allot-area-align ; GENERIC: compute-stack-frame* ( insn -- ? ) ; M:: ##local-allot compute-stack-frame* ( insn -- ? ) - insn size>> :> s - insn align>> :> a + insn size>> set: s + insn align>> set: a allot-area-align [ a max ] change allot-area-size [ a align [ insn offset<< ] [ s + ] bi ] change t ; diff --git a/language/compiler/cfg/builder/alien/boxing/boxing.factor b/language/compiler/cfg/builder/alien/boxing/boxing.factor index 222320b83d..8b63f1d96f 100644 --- a/language/compiler/cfg/builder/alien/boxing/boxing.factor +++ b/language/compiler/cfg/builder/alien/boxing/boxing.factor @@ -38,13 +38,13 @@ M: object flatten-struct-type-return 0 [ rep-size + ] accumulate nip ; :: explode-struct ( src c-type -- vregs reps ) - c-type flatten-struct-type :> reps + c-type flatten-struct-type set: reps reps keys dup component-offsets |[ rep offset | src offset rep f ^^load-memory-imm ] 2map reps ; :: explode-struct-return ( src c-type -- vregs reps ) - c-type flatten-struct-type-return :> reps + c-type flatten-struct-type-return set: reps reps keys dup component-offsets |[ rep offset | src offset rep f ^^load-memory-imm ] 2map reps ; diff --git a/language/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/language/compiler/cfg/dataflow-analysis/dataflow-analysis.factor index 753078e97b..36066395b4 100644 --- a/language/compiler/cfg/dataflow-analysis/dataflow-analysis.factor +++ b/language/compiler/cfg/dataflow-analysis/dataflow-analysis.factor @@ -46,8 +46,8 @@ MIXIN: dataflow-analysis bb in-sets out-sets dfa update-in/out-set bb dfa successors { } ? ; :: run-dataflow-analysis ( cfg dfa -- in-sets out-sets ) - H{ } clone :> in-sets - H{ } clone :> out-sets + H{ } clone set: in-sets + H{ } clone set: out-sets cfg needs-predecessors cfg dfa [ in-sets out-sets dfa dfa-step ] slurp/replenish-deque diff --git a/language/compiler/cfg/dominance/dominance.factor b/language/compiler/cfg/dominance/dominance.factor index 0c9d68ad91..9ac9d94a61 100644 --- a/language/compiler/cfg/dominance/dominance.factor +++ b/language/compiler/cfg/dominance/dominance.factor @@ -90,8 +90,8 @@ PRIVATE> swap [ pre-of ] [ [ pre-of ] [ maxpre-of ] bi ] bi* between? ; :: breadth-first-order ( cfg -- bfo ) - :> work-list - cfg post-order length :> accum + set: work-list + cfg post-order length set: accum cfg entry>> work-list push-front work-list [ [ accum push ] diff --git a/language/compiler/cfg/gc-checks/gc-checks.factor b/language/compiler/cfg/gc-checks/gc-checks.factor index 1eab00252c..5be2a87b93 100644 --- a/language/compiler/cfg/gc-checks/gc-checks.factor +++ b/language/compiler/cfg/gc-checks/gc-checks.factor @@ -77,12 +77,12 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ; ! the next block, and a GC call. ! Every basic block but the first has two predecessors: ! the previous block, and the previous block's GC call. - bbs length 1 - :> len - len [ ] replicate :> gc-calls + bbs length 1 - set: len + len [ ] replicate set: gc-calls len |[ n | - n bbs nth :> bb - n 1 + bbs nth :> next-bb - n gc-calls nth :> gc-call + n bbs nth set: bb + n 1 + bbs nth set: next-bb + n gc-calls nth set: gc-call V{ next-bb gc-call } bb successors<< V{ next-bb } gc-call successors<< V{ bb } gc-call predecessors<< diff --git a/language/compiler/cfg/gvn/gvn.factor b/language/compiler/cfg/gvn/gvn.factor index 2ff7811b28..2b14e40d16 100644 --- a/language/compiler/cfg/gvn/gvn.factor +++ b/language/compiler/cfg/gvn/gvn.factor @@ -45,7 +45,7 @@ M: ##copy value-number [ src>> vreg>vn ] [ dst>> ] bi set-vn ; swap dst>> set-vn ; :: useful-instruction ( insn expr -- ) - insn dst>> :> vn + insn dst>> set: vn vn vn set-vn vn expr exprs>vns get set-at insn vn vns>insns get set-at ; diff --git a/language/compiler/cfg/intrinsics/alien/alien.factor b/language/compiler/cfg/intrinsics/alien/alien.factor index 1f57d77cda..bc3dcc0464 100644 --- a/language/compiler/cfg/intrinsics/alien/alien.factor +++ b/language/compiler/cfg/intrinsics/alien/alien.factor @@ -22,7 +22,7 @@ IN: compiler.cfg.intrinsics.alien ] [ emit-primitive ] if ; :: inline-accessor ( block #call quot test -- block' ) - #call node-input-infos :> infos + #call node-input-infos set: infos infos test call [ infos quot call block ] [ block #call emit-primitive ] if ; inline diff --git a/language/compiler/cfg/intrinsics/allot/allot.factor b/language/compiler/cfg/intrinsics/allot/allot.factor index 6309fb5ba4..260d0bdd3d 100644 --- a/language/compiler/cfg/intrinsics/allot/allot.factor +++ b/language/compiler/cfg/intrinsics/allot/allot.factor @@ -43,10 +43,10 @@ IN: compiler.cfg.intrinsics.allot 2 + cells array ^^allot ; :: emit- ( block node -- block' ) - node node-input-infos first literal>> :> len + node node-input-infos first literal>> set: len len expand-? [ - ds-pop :> elt - len ^^allot-array :> reg + ds-pop set: elt + len ^^allot-array set: reg ds-drop len reg array store-length len reg elt array store-initial-element @@ -73,15 +73,15 @@ IN: compiler.cfg.intrinsics.allot ] [ drop emit-primitive ] if ; :: zero-byte-array ( len reg -- ) - 0 ^^load-literal :> elt - reg ^^tagged>integer :> reg + 0 ^^load-literal set: elt + reg ^^tagged>integer set: reg len cell align cell /i iota [ [ elt reg ] dip cells byte-array-offset + int-rep f ##store-memory-imm, ] each ; :: emit- ( block #call -- block' ) #call node-input-infos first literal>> dup expand-? [ - :> len - len emit-allot-byte-array :> reg + set: len + len emit-allot-byte-array set: reg len reg zero-byte-array block ] [ drop block #call emit-primitive ] if ; diff --git a/language/compiler/cfg/intrinsics/simd/backend/backend.factor b/language/compiler/cfg/intrinsics/simd/backend/backend.factor index 58e41e307b..e3171a1b07 100644 --- a/language/compiler/cfg/intrinsics/simd/backend/backend.factor +++ b/language/compiler/cfg/intrinsics/simd/backend/backend.factor @@ -78,7 +78,7 @@ M:: callable >vector-op-cond ( quot #pick #dup -- quotpair ) 2array ; M:: pair >vector-op-cond ( pair #pick #dup -- quotpair ) - pair first2 :> ( class quot ) + pair first2 set: ( class quot ) #pick class #dup quot [vector-op-checked] $[ 2drop _ npick _ instance? _ [ f f f ] if ] #dup $[ % _ nnip ] diff --git a/language/compiler/cfg/intrinsics/simd/simd-tests.factor b/language/compiler/cfg/intrinsics/simd/simd-tests.factor index 212a8eef81..7d4ff565aa 100644 --- a/language/compiler/cfg/intrinsics/simd/simd-tests.factor +++ b/language/compiler/cfg/intrinsics/simd/simd-tests.factor @@ -21,7 +21,7 @@ IN: compiler.cfg.intrinsics.simd.tests } ; :: test-node-literal ( lit rep -- node ) - lit class-of :> lit-class + lit class-of set: lit-class T{ #call { in-d { 1 2 3 4 } } { out-d { 5 } } diff --git a/language/compiler/cfg/intrinsics/simd/simd.factor b/language/compiler/cfg/intrinsics/simd/simd.factor index 757440d9d5..8744ffa43d 100644 --- a/language/compiler/cfg/intrinsics/simd/simd.factor +++ b/language/compiler/cfg/intrinsics/simd/simd.factor @@ -94,19 +94,19 @@ CONSTANT: rep>half { } v-vector-op ; :: ^swap-compare-vector ( src1 src2 rep {cc,swap} -- dst ) - {cc,swap} first2 :> ( cc swap? ) + {cc,swap} first2 set: ( cc swap? ) swap? [ src2 src1 rep cc ^^compare-vector ] [ src1 src2 rep cc ^^compare-vector ] if ; :: ^(compare-vector) ( src1 src2 rep orig-cc -- dst ) - rep orig-cc %compare-vector-ccs :> ( ccs not? ) + rep orig-cc %compare-vector-ccs set: ( ccs not? ) ccs empty? [ rep not? [ ^^fill-vector ] [ ^^zero-vector ] if ] [ - ccs unclip :> ( rest-ccs first-cc ) - src1 src2 rep first-cc ^swap-compare-vector :> first-dst + ccs unclip set: ( rest-ccs first-cc ) + src1 src2 rep first-cc ^swap-compare-vector set: first-dst rest-ccs first-dst [ [ src1 src2 rep ] dip ^swap-compare-vector rep ^^or-vector ] @@ -128,7 +128,7 @@ CONSTANT: rep>half { [ ^(compare-vector) ] [ ^minmax-compare-vector ] { unsigned-int-vector-rep |[ src1 src2 rep cc | - rep sign-bit-mask ^^load-literal :> sign-bits + rep sign-bit-mask ^^load-literal set: sign-bits src1 sign-bits rep ^^xor-vector src2 sign-bits rep ^^xor-vector rep signed-rep cc ^(compare-vector) @@ -140,13 +140,13 @@ CONSTANT: rep>half { [ ^^unpack-vector-head ] { unsigned-int-vector-rep [ [ ^^zero-vector ] [ ^^merge-vector-head ] bi ] } { signed-int-vector-rep |[ src rep | - src src rep ^^merge-vector-head :> merged - rep rep-component-type heap-size 8 * :> bits + src src rep ^^merge-vector-head set: merged + rep rep-component-type heap-size 8 * set: bits merged bits rep widen-vector-rep ^^shr-vector-imm ] } { signed-int-vector-rep |[ src rep | - rep ^^zero-vector :> zero - zero src rep cc> ^compare-vector :> sign + rep ^^zero-vector set: zero + zero src rep cc> ^compare-vector set: sign src sign rep ^^merge-vector-head ] } } v-vector-op ; @@ -157,13 +157,13 @@ CONSTANT: rep>half { [ [ ^^tail>head-vector ] [ ^^unpack-vector-head ] bi ] { unsigned-int-vector-rep [ [ ^^zero-vector ] [ ^^merge-vector-tail ] bi ] } { signed-int-vector-rep |[ src rep | - src src rep ^^merge-vector-tail :> merged - rep rep-component-type heap-size 8 * :> bits + src src rep ^^merge-vector-tail set: merged + rep rep-component-type heap-size 8 * set: bits merged bits rep widen-vector-rep ^^shr-vector-imm ] } { signed-int-vector-rep |[ src rep | - rep ^^zero-vector :> zero - zero src rep cc> ^compare-vector :> sign + rep ^^zero-vector set: zero + zero src rep cc> ^compare-vector set: sign src sign rep ^^merge-vector-tail ] } } v-vector-op ; @@ -175,8 +175,8 @@ PREDICATE: fixnum-vector-rep < int-vector-rep { [ dupd ^^horizontal-add-vector ] |[ src rep | - src src rep ^^merge-vector-head :> head - src src rep ^^merge-vector-tail :> tail + src src rep ^^merge-vector-head set: head + src src rep ^^merge-vector-tail set: tail head tail rep ^^add-vector ] } v-vector-op ; @@ -188,13 +188,13 @@ PREDICATE: fixnum-vector-rep < int-vector-rep [ dupd ^^horizontal-add-vector ] bi ] |[ src rep | - src src rep ^^merge-vector-head :> head - src src rep ^^merge-vector-tail :> tail - head tail rep ^^add-vector :> src' + src src rep ^^merge-vector-head set: head + src src rep ^^merge-vector-tail set: tail + head tail rep ^^add-vector set: src' - rep widen-vector-rep :> rep' - src' src' rep' ^^merge-vector-head :> head' - src' src' rep' ^^merge-vector-tail :> tail' + rep widen-vector-rep set: rep' + src' src' rep' ^^merge-vector-head set: head' + src' src' rep' ^^merge-vector-tail set: tail' head' tail' rep ^^add-vector ] } v-vector-op ; @@ -207,18 +207,18 @@ PREDICATE: fixnum-vector-rep < int-vector-rep [ dupd ^^horizontal-add-vector ] tri ] |[ src rep | - src src rep ^^merge-vector-head :> head - src src rep ^^merge-vector-tail :> tail - head tail rep ^^add-vector :> src' + src src rep ^^merge-vector-head set: head + src src rep ^^merge-vector-tail set: tail + head tail rep ^^add-vector set: src' - rep widen-vector-rep :> rep' - src' src' rep' ^^merge-vector-head :> head' - src' src' rep' ^^merge-vector-tail :> tail' - head' tail' rep ^^add-vector :> src'' + rep widen-vector-rep set: rep' + src' src' rep' ^^merge-vector-head set: head' + src' src' rep' ^^merge-vector-tail set: tail' + head' tail' rep ^^add-vector set: src'' - rep' widen-vector-rep :> rep'' - src'' src'' rep'' ^^merge-vector-head :> head'' - src'' src'' rep'' ^^merge-vector-tail :> tail'' + rep' widen-vector-rep set: rep'' + src'' src'' rep'' ^^merge-vector-head set: head'' + src'' src'' rep'' ^^merge-vector-tail set: tail'' head'' tail'' rep ^^add-vector ] } v-vector-op ; @@ -234,23 +234,23 @@ PREDICATE: fixnum-vector-rep < int-vector-rep } cleave ] |[ src rep | - src src rep ^^merge-vector-head :> head - src src rep ^^merge-vector-tail :> tail - head tail rep ^^add-vector :> src' + src src rep ^^merge-vector-head set: head + src src rep ^^merge-vector-tail set: tail + head tail rep ^^add-vector set: src' - rep widen-vector-rep :> rep' - src' src' rep' ^^merge-vector-head :> head' - src' src' rep' ^^merge-vector-tail :> tail' - head' tail' rep ^^add-vector :> src'' + rep widen-vector-rep set: rep' + src' src' rep' ^^merge-vector-head set: head' + src' src' rep' ^^merge-vector-tail set: tail' + head' tail' rep ^^add-vector set: src'' - rep' widen-vector-rep :> rep'' - src'' src'' rep'' ^^merge-vector-head :> head'' - src'' src'' rep'' ^^merge-vector-tail :> tail'' - head'' tail'' rep ^^add-vector :> src''' + rep' widen-vector-rep set: rep'' + src'' src'' rep'' ^^merge-vector-head set: head'' + src'' src'' rep'' ^^merge-vector-tail set: tail'' + head'' tail'' rep ^^add-vector set: src''' - rep'' widen-vector-rep :> rep''' - src''' src''' rep''' ^^merge-vector-head :> head''' - src''' src''' rep''' ^^merge-vector-tail :> tail''' + rep'' widen-vector-rep set: rep''' + src''' src''' rep''' ^^merge-vector-head set: head''' + src''' src''' rep''' ^^merge-vector-tail set: tail''' head''' tail''' rep ^^add-vector ] } v-vector-op ; @@ -269,9 +269,9 @@ PREDICATE: fixnum-vector-rep < int-vector-rep { { float-vector-rep [ ^(sum-vector) ] } { fixnum-vector-rep |[ src rep | - src rep ^unpack-vector-head :> head - src rep ^unpack-vector-tail :> tail - rep widen-vector-rep :> wide-rep + src rep ^unpack-vector-head set: head + src rep ^unpack-vector-tail set: tail + rep widen-vector-rep set: wide-rep head tail wide-rep ^^add-vector wide-rep ^(sum-vector) ] } @@ -288,7 +288,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep : ^shuffle-2-vectors-imm ( src1 src2 shuffle rep -- dst ) [ rep-length 0 pad-tail ] keep { { double-2-rep |[ src1 src2 shuffle rep | - shuffle first2 [ 4 mod ] bi@ :> ( i j ) + shuffle first2 [ 4 mod ] bi@ set: ( i j ) { { [ i j [ 2 < ] both? ] [ src1 shuffle rep ^shuffle-vector-imm @@ -340,14 +340,14 @@ PREDICATE: fixnum-vector-rep < int-vector-rep { [ ^^add-sub-vector ] { float-vector-rep |[ src1 src2 rep | - rep ^load-add-sub-vector :> signs - src2 signs rep ^^xor-vector :> src2' + rep ^load-add-sub-vector set: signs + src2 signs rep ^^xor-vector set: src2' src1 src2' rep ^^add-vector ] } { int-vector-rep |[ src1 src2 rep | - rep ^load-add-sub-vector :> signs - src2 signs rep ^^xor-vector :> src2' - src2' signs rep ^^sub-vector :> src2'' + rep ^load-add-sub-vector set: signs + src2 signs rep ^^xor-vector set: src2' + src2' signs rep ^^sub-vector set: src2'' src1 src2'' rep ^^add-vector ] } } emit-vv-vector-op ; @@ -447,9 +447,9 @@ PREDICATE: fixnum-vector-rep < int-vector-rep [ ^^abs-vector ] { float-vector-rep [ [ ^load-neg-zero-vector ] [ swapd ^^andn-vector ] bi ] } { int-vector-rep |[ src rep | - rep ^^zero-vector :> zero - zero src rep ^^sub-vector :> -src - zero src rep cc> ^compare-vector :> sign + rep ^^zero-vector set: zero + zero src rep ^^sub-vector set: -src + zero src rep cc> ^compare-vector set: sign sign -src src rep ^blend-vector ] } } emit-v-vector-op ; @@ -585,8 +585,8 @@ PREDICATE: fixnum-vector-rep < int-vector-rep : emit-simd-vpack-signed ( node -- ) { { double-2-rep |[ src1 src2 rep | - src1 double-2-rep ^^float-pack-vector :> dst-head - src2 double-2-rep ^^float-pack-vector :> dst-tail + src1 double-2-rep ^^float-pack-vector set: dst-head + src2 double-2-rep ^^float-pack-vector set: dst-tail dst-head dst-tail { 0 1 0 1 } float-4-rep ^^shuffle-vector-halves-imm ] } { int-vector-rep [ ^^signed-pack-vector ] } diff --git a/language/compiler/cfg/intrinsics/slots/slots.factor b/language/compiler/cfg/intrinsics/slots/slots.factor index 35f76e7656..792ac59c79 100644 --- a/language/compiler/cfg/intrinsics/slots/slots.factor +++ b/language/compiler/cfg/intrinsics/slots/slots.factor @@ -42,7 +42,7 @@ IN: compiler.cfg.intrinsics.slots :: (emit-set-slot-imm) ( write-barrier? tag slot -- ) ds-drop - 2inputs :> ( src obj ) + 2inputs set: ( src obj ) src obj slot tag ##set-slot-imm, @@ -50,9 +50,9 @@ IN: compiler.cfg.intrinsics.slots [ obj slot tag next-vreg next-vreg ##write-barrier-imm, ] when ; :: (emit-set-slot) ( write-barrier? tag -- ) - 3inputs :> ( src obj slot ) + 3inputs set: ( src obj slot ) - slot tag slot-indexing :> ( slot scale tag ) + slot tag slot-indexing set: ( slot scale tag ) src obj slot scale tag ##set-slot, diff --git a/language/compiler/cfg/linear-scan/allocation/splitting/splitting.factor b/language/compiler/cfg/linear-scan/allocation/splitting/splitting.factor index 14a68469ab..c2fdaeed61 100644 --- a/language/compiler/cfg/linear-scan/allocation/splitting/splitting.factor +++ b/language/compiler/cfg/linear-scan/allocation/splitting/splitting.factor @@ -34,8 +34,8 @@ ERROR: splitting-atomic-interval ; :: split-interval ( live-interval n -- before after ) live-interval n check-split - live-interval clone :> before - live-interval clone :> after + live-interval clone set: before + live-interval clone set: after live-interval uses>> n split-uses before after [ uses<< ] bi-curry@ bi* live-interval ranges>> n split-ranges before after [ ranges<< ] bi-curry@ bi* before split-before diff --git a/language/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/language/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index 7fa7b0736b..48f3962044 100644 --- a/language/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/language/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -28,7 +28,7 @@ TUPLE: live-interval-state [ drop f ] [ last [ n>> = ] keep and ] if-empty ; :: (add-use) ( insn# live-interval spill-slot? -- use ) - live-interval uses>> :> uses + live-interval uses>> set: uses insn# uses last-use? [ insn# uses new-use ] unless* spill-slot? [ t >>spill-slot? ] when ; @@ -64,19 +64,19 @@ GENERIC: compute-live-intervals* ( insn -- ) ; M: insn compute-live-intervals* drop ; :: record-def ( vreg n spill-slot? -- ) - vreg vreg>live-interval :> live-interval + vreg vreg>live-interval set: live-interval n live-interval ranges>> shorten-ranges n live-interval spill-slot? (add-use) vreg rep-of >>def-rep drop ; :: record-use ( vreg n spill-slot? -- ) - vreg vreg>live-interval :> live-interval + vreg vreg>live-interval set: live-interval from get n live-interval ranges>> add-range n live-interval spill-slot? (add-use) vreg rep-of >>use-rep drop ; :: record-temp ( vreg n -- ) - vreg vreg>live-interval :> live-interval + vreg vreg>live-interval set: live-interval n n live-interval ranges>> add-range n live-interval f (add-use) vreg rep-of >>def-rep drop ; diff --git a/language/compiler/cfg/linear-scan/resolve/resolve.factor b/language/compiler/cfg/linear-scan/resolve/resolve.factor index ebe4829f2c..0636e9b8d4 100644 --- a/language/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/language/compiler/cfg/linear-scan/resolve/resolve.factor @@ -50,9 +50,9 @@ SYMBOL: temp-locations 2dup = [ 2drop ] [ vreg rep-of add-mapping ] if ; :: compute-mappings ( bb to -- mappings ) - bb machine-live-out :> live-out - to machine-live-in :> live-in - bb to machine-edge-live-in :> edge-live-in + bb machine-live-out set: live-out + to machine-live-in set: live-in + bb to machine-edge-live-in set: edge-live-in live-out assoc-empty? [ f ] [ [ live-in keys edge-live-in keys append [ diff --git a/language/compiler/cfg/liveness/liveness.factor b/language/compiler/cfg/liveness/liveness.factor index ec193a3eb6..45976feacb 100644 --- a/language/compiler/cfg/liveness/liveness.factor +++ b/language/compiler/cfg/liveness/liveness.factor @@ -78,7 +78,7 @@ M: vreg-insn lookup-base-pointer* 2drop f ; ] unless ; :: visit-derived-root ( vreg derived-roots gc-roots -- ) - vreg lookup-base-pointer :> base + vreg lookup-base-pointer set: base base [ { vreg base } derived-roots push base gc-roots adjoin diff --git a/language/compiler/cfg/parallel-copy/parallel-copy.factor b/language/compiler/cfg/parallel-copy/parallel-copy.factor index 4e340b0654..83deda0b2e 100644 --- a/language/compiler/cfg/parallel-copy/parallel-copy.factor +++ b/language/compiler/cfg/parallel-copy/parallel-copy.factor @@ -24,15 +24,15 @@ SYMBOLS: locs preds to-do ready ; [ keys [ init-to-do ] [ init-ready ] bi ] tri ; :: process-ready ( b quot: ( dst src -- ) -- ) - b preds get at :> a - a locs get at :> c + b preds get at set: a + a locs get at set: c b c quot call b a locs get set-at a c = a preds get at and [ a ready get push-front ] when ; inline :: process-to-do ( b temp: ( src -- dst ) quot: ( dst src -- ) -- ) b locs get at b = [ - b temp call :> temp' + b temp call set: temp' temp' b quot call temp' b locs get set-at b ready get push-front diff --git a/language/compiler/cfg/representations/conversion/conversion.factor b/language/compiler/cfg/representations/conversion/conversion.factor index 387f29a1d2..0aba5676c7 100644 --- a/language/compiler/cfg/representations/conversion/conversion.factor +++ b/language/compiler/cfg/representations/conversion/conversion.factor @@ -17,12 +17,12 @@ M: int-rep tagged>rep ( dst src rep -- ) drop tag-bits get ##sar-imm, ; M:: float-rep rep>tagged ( dst src rep -- ) - double-rep next-vreg-rep :> temp + double-rep next-vreg-rep set: temp temp src ##single>double-float, dst temp double-rep rep>tagged ; M:: float-rep tagged>rep ( dst src rep -- ) - double-rep next-vreg-rep :> temp + double-rep next-vreg-rep set: temp temp src double-rep tagged>rep dst temp ##double>single-float, ; @@ -34,7 +34,7 @@ M: double-rep tagged>rep drop float-offset double-rep f ##load-memory-imm, ; M:: vector-rep rep>tagged ( dst src rep -- ) - tagged-rep next-vreg-rep :> temp + tagged-rep next-vreg-rep set: temp dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot, temp 16 tag-fixnum ##load-tagged, temp dst 1 byte-array type-number ##set-slot-imm, @@ -44,12 +44,12 @@ M: vector-rep tagged>rep [ byte-array-offset ] dip f ##load-memory-imm, ; M:: scalar-rep rep>tagged ( dst src rep -- ) - tagged-rep next-vreg-rep :> temp + tagged-rep next-vreg-rep set: temp temp src rep ##scalar>integer, dst temp int-rep rep>tagged ; M:: scalar-rep tagged>rep ( dst src rep -- ) - tagged-rep next-vreg-rep :> temp + tagged-rep next-vreg-rep set: temp temp src int-rep tagged>rep dst temp rep ##integer>scalar, ; diff --git a/language/compiler/cfg/representations/peephole/peephole.factor b/language/compiler/cfg/representations/peephole/peephole.factor index 1d55145943..447a97c108 100644 --- a/language/compiler/cfg/representations/peephole/peephole.factor +++ b/language/compiler/cfg/representations/peephole/peephole.factor @@ -269,7 +269,7 @@ M: ##neg optimize-insn ! Identity: ! tag(not(untag(x))) = not(x) xor tag-mask :: emit-tagged-not ( insn -- ) - tagged-rep next-vreg-rep :> temp + tagged-rep next-vreg-rep set: temp temp insn src>> ##not, insn dst>> temp tag-mask get ##xor-imm, here ; diff --git a/language/compiler/cfg/representations/rewrite/rewrite.factor b/language/compiler/cfg/representations/rewrite/rewrite.factor index 2e09a9bc50..ea76547deb 100644 --- a/language/compiler/cfg/representations/rewrite/rewrite.factor +++ b/language/compiler/cfg/representations/rewrite/rewrite.factor @@ -27,7 +27,7 @@ SYMBOL: alternatives ! becomes the output of a conversion instruction. preferred required eq? [ src ] [ src required alternatives get [ - required next-vreg-rep :> new-src + required next-vreg-rep set: new-src [ new-src ] 2dip preferred emit-conversion new-src ] 2cache @@ -46,7 +46,7 @@ SYMBOLS: renaming-set needs-renaming? ; 2array renaming-set get push needs-renaming? on ; :: (compute-renaming-set) ( vreg required quot: ( vreg preferred required -- new-vreg ) -- ) - vreg rep-of :> preferred + vreg rep-of set: preferred preferred required eq? [ vreg no-renaming ] [ vreg vreg preferred required quot call record-renaming ] if ; inline diff --git a/language/compiler/cfg/representations/selection/selection.factor b/language/compiler/cfg/representations/selection/selection.factor index 34b8e596ec..29f50c540f 100644 --- a/language/compiler/cfg/representations/selection/selection.factor +++ b/language/compiler/cfg/representations/selection/selection.factor @@ -67,7 +67,7 @@ SYMBOL: costs $[ [ current-loop-nesting 10^ _ * + ] change-at ] [ 2drop ] if ; :: increase-costs ( vreg preferred factor -- ) - vreg vreg>scc :> scc + vreg vreg>scc set: scc scc possibilities get at [ dup preferred eq? [ drop ] [ scc factor increase-cost ] if ] each ; inline diff --git a/language/compiler/cfg/ssa/cssa/cssa.factor b/language/compiler/cfg/ssa/cssa/cssa.factor index 46b6fbd441..e285a1a334 100644 --- a/language/compiler/cfg/ssa/cssa/cssa.factor +++ b/language/compiler/cfg/ssa/cssa/cssa.factor @@ -13,15 +13,15 @@ SYMBOLS: edge-copies phi-copies ; predecessors>> [ V{ } clone ] H{ } map>assoc edge-copies set ; :: convert-operand ( src pred rep -- dst ) - rep next-vreg-rep :> dst + rep next-vreg-rep set: dst { dst src } pred edge-copies get at push dst ; :: convert-phi ( insn preds -- ) - insn dst>> :> dst - dst rep-of :> rep - insn inputs>> :> inputs - rep next-vreg-rep :> dst' + insn dst>> set: dst + dst rep-of set: rep + insn inputs>> set: inputs + rep next-vreg-rep set: dst' { dst dst' } phi-copies get push dst' insn dst<< diff --git a/language/compiler/cfg/ssa/interference/interference.factor b/language/compiler/cfg/ssa/interference/interference.factor index 2aedca3c31..b75abf4640 100644 --- a/language/compiler/cfg/ssa/interference/interference.factor +++ b/language/compiler/cfg/ssa/interference/interference.factor @@ -24,8 +24,8 @@ PRIVATE< [ def-index>> ] bi@ < ; :: vreg-dominates? ( vreg1 vreg2 -- ? ) - vreg1 bb>> :> bb1 - vreg2 bb>> :> bb2 + vreg1 bb>> set: bb1 + vreg2 bb>> set: bb2 bb1 bb2 eq? [ vreg1 vreg2 locally-dominates? ] [ bb1 bb2 dominates? ] if ; @@ -55,8 +55,8 @@ PRIVATE< interferes-first-dominates? ; :: vregs-intersect? ( vreg1 vreg2 -- ? ) - vreg1 bb>> :> bb1 - vreg2 bb>> :> bb2 + vreg1 bb>> set: bb1 + vreg2 bb>> set: bb2 { { [ bb1 bb2 eq? ] [ vreg1 vreg2 interferes-same-block? ] } { [ bb1 bb2 dominates? ] [ vreg1 vreg2 interferes-first-dominates? ] } @@ -140,7 +140,7 @@ TUPLE: iterator seq n ; ] if ; :: linear-interference-test ( seq -- ? ) - V{ } clone :> dom + V{ } clone set: dom seq |[ vreg | dom vreg find-parent { [ ] [ vreg same-sets? not ] [ vreg swap vregs-interfere? ] } 1&& diff --git a/language/compiler/cfg/utilities/utilities.factor b/language/compiler/cfg/utilities/utilities.factor index 8ba1545a67..5c7fd5f29c 100644 --- a/language/compiler/cfg/utilities/utilities.factor +++ b/language/compiler/cfg/utilities/utilities.factor @@ -47,7 +47,7 @@ IN: compiler.cfg.utilities from successors>> [ dup to eq? [ drop bb ] when ] map! drop ; :: insert-basic-block ( from to insns -- ) - insns f insns>block :> bb + insns f insns>block set: bb V{ from } bb predecessors<< V{ to } bb successors<< from to bb update-predecessors diff --git a/language/compiler/cfg/value-numbering/value-numbering.factor b/language/compiler/cfg/value-numbering/value-numbering.factor index e02902c894..e4723d7a21 100644 --- a/language/compiler/cfg/value-numbering/value-numbering.factor +++ b/language/compiler/cfg/value-numbering/value-numbering.factor @@ -23,7 +23,7 @@ GENERIC: process-instruction ( insn -- insn' ) ; [ dst>> ] dip [ swap set-vn ] [ ] 2bi ; :: useful-instruction ( insn expr -- insn' ) - insn dst>> :> vn + insn dst>> set: vn vn vn vregs>vns get set-at vn expr exprs>vns get set-at insn vn vns>insns get set-at diff --git a/language/compiler/codegen/codegen.factor b/language/compiler/codegen/codegen.factor index b092992aa6..9a1225b837 100755 --- a/language/compiler/codegen/codegen.factor +++ b/language/compiler/codegen/codegen.factor @@ -43,8 +43,8 @@ M: ##test-vector-branch negate-insn-cc [ negate-vcc ] change-vcc drop ; M:: conditional-branch-insn generate-insn ( insn -- ) - basic-block get :> bb - bb successors>> first2 :> ( first second ) + basic-block get set: bb + bb successors>> first2 set: ( first second ) bb second useless-branch? [ bb second first ] [ bb first second insn negate-insn-cc ] if diff --git a/language/compiler/tests/curry.factor b/language/compiler/tests/curry.factor index 6a2c9ad1ec..970ad054d5 100644 --- a/language/compiler/tests/curry.factor +++ b/language/compiler/tests/curry.factor @@ -47,7 +47,7 @@ IN: compiler.tests.curry ] { } make ; inline [ t ] |[ | - 1000 iota [ drop 1,000,000 random 1,000,000 random ] H{ } map>assoc :> a-hashtable + 1000 iota [ drop 1,000,000 random 1,000,000 random ] H{ } map>assoc set: a-hashtable a-hashtable [ [ drop , ] funky-assoc>map ] compile-call a-hashtable keys = ] unit-test diff --git a/language/compiler/tree/builder/builder.factor b/language/compiler/tree/builder/builder.factor index e90018ccb0..589f5d6ff7 100644 --- a/language/compiler/tree/builder/builder.factor +++ b/language/compiler/tree/builder/builder.factor @@ -40,7 +40,7 @@ PRIVATE> :: build-sub-tree ( in-d out-d word/quot -- nodes/f ) [ - in-d word/quot build-tree-with unclip-last in-d>> :> in-d' + in-d word/quot build-tree-with unclip-last in-d>> set: in-d' { { [ dup not ] [ ] } { [ dup ends-with-terminate? ] [ out-d [ f swap <#push> ] map append ] } diff --git a/language/compiler/tree/dead-code/recursive/recursive.factor b/language/compiler/tree/dead-code/recursive/recursive.factor index 0e32cd3389..fde5fb9dae 100644 --- a/language/compiler/tree/dead-code/recursive/recursive.factor +++ b/language/compiler/tree/dead-code/recursive/recursive.factor @@ -37,8 +37,8 @@ M: #enter-recursive remove-dead-code* 2bi ; :: (drop-call-recursive-outputs) ( inputs outputs -- #shuffle ) - inputs outputs filter-corresponding length make-values :> new-live-outputs - outputs filter-live :> live-outputs + inputs outputs filter-corresponding length make-values set: new-live-outputs + outputs filter-live set: live-outputs new-live-outputs live-outputs live-outputs @@ -57,16 +57,16 @@ M: #call-recursive remove-dead-code* tri 3array ; :: drop-recursive-inputs ( node -- shuffle ) - node [ in-d>> ] [ label>> enter-out>> ] bi drop-dead-inputs :> shuffle - shuffle out-d>> :> new-outputs + node [ in-d>> ] [ label>> enter-out>> ] bi drop-dead-inputs set: shuffle + shuffle out-d>> set: new-outputs node new-outputs [ [ label>> enter-recursive>> ] dip >>in-d drop ] [ >>in-d drop ] 2bi shuffle ; :: drop-recursive-outputs ( node -- shuffle ) - node label>> return>> :> return - return in-d>> filter-live :> new-inputs - return [ in-d>> ] [ out-d>> ] bi filter-corresponding :> new-outputs + node label>> return>> set: return + return in-d>> filter-live set: new-inputs + return [ in-d>> ] [ out-d>> ] bi filter-corresponding set: new-outputs return [ new-inputs >>in-d new-outputs >>out-d drop ] [ drop-dead-outputs ] diff --git a/language/compiler/tree/dead-code/simple/simple.factor b/language/compiler/tree/dead-code/simple/simple.factor index c50f84cde4..ad71652a5b 100644 --- a/language/compiler/tree/dead-code/simple/simple.factor +++ b/language/compiler/tree/dead-code/simple/simple.factor @@ -55,8 +55,8 @@ M: #alien-node compute-live-values* nip look-at-inputs ; filter-corresponding zip <#data-shuffle> ; inline :: drop-dead-values ( outputs -- #shuffle ) - outputs length make-values :> new-outputs - outputs filter-live :> live-outputs + outputs length make-values set: new-outputs + outputs filter-live set: live-outputs new-outputs live-outputs outputs diff --git a/language/compiler/tree/propagation/known-words/known-words.factor b/language/compiler/tree/propagation/known-words/known-words.factor index 596b2ed0ed..f993d9d7d6 100644 --- a/language/compiler/tree/propagation/known-words/known-words.factor +++ b/language/compiler/tree/propagation/known-words/known-words.factor @@ -180,8 +180,8 @@ $[ _ _ 2bi ] "outputs" set-word-prop \ bitxor [ [ interval-bitxor ] [ integer-valued ] binary-op ] each-derived-op :: (comparison-constraints) ( in1 in2 op -- constraint ) - in1 value-info interval>> :> i1 - in2 value-info interval>> :> i2 + in1 value-info interval>> set: i1 + in2 value-info interval>> set: i2 in1 i1 i2 op assumption is-in-interval in2 i2 i1 op swap-comparison assumption is-in-interval 2array ; diff --git a/language/compiler/tree/propagation/recursive/recursive.factor b/language/compiler/tree/propagation/recursive/recursive.factor index ebc0947e01..bb65564dfc 100644 --- a/language/compiler/tree/propagation/recursive/recursive.factor +++ b/language/compiler/tree/propagation/recursive/recursive.factor @@ -24,7 +24,7 @@ IN: compiler.tree.propagation.recursive [ drop array-capacity ] when ; :: generalize-counter-interval ( interval initial-interval class -- interval' ) - interval class counter-class :> class + interval class counter-class set: class { { [ interval initial-interval interval-subset? ] [ initial-interval ] } { [ interval empty-interval eq? ] [ initial-interval ] } diff --git a/language/compiler/utilities/utilities.factor b/language/compiler/utilities/utilities.factor index 07700ee16a..67331fc566 100644 --- a/language/compiler/utilities/utilities.factor +++ b/language/compiler/utilities/utilities.factor @@ -39,9 +39,9 @@ yield-hook [ [ ] ] initialize : penultimate ( seq -- elt ) [ length 2 - ] keep nth ; :: compress-path ( source assoc -- destination ) - source assoc at :> destination + source assoc at set: destination source destination = [ source ] [ - destination assoc compress-path :> destination' + destination assoc compress-path set: destination' destination' destination = [ destination' source assoc set-at ] unless diff --git a/language/constructors/constructors.factor b/language/constructors/constructors.factor index 6f05a83691..df4037ad84 100644 --- a/language/constructors/constructors.factor +++ b/language/constructors/constructors.factor @@ -12,8 +12,8 @@ IN: constructors ] map concat ; MACRO:: slots>boa ( slots class -- quot ) - class all-slots-assoc slots [ $[ first name>> _ = ] find-last nip ] with map :> slot-assoc - class all-slots-assoc [ [ ] [ first initial>> ] bi ] { } map>assoc :> default-params + class all-slots-assoc slots [ $[ first name>> _ = ] find-last nip ] with map set: slot-assoc + class all-slots-assoc [ [ ] [ first initial>> ] bi ] { } map>assoc set: default-params slots length default-params length $[ diff --git a/language/cpu/ppc/assembler/assembler.factor b/language/cpu/ppc/assembler/assembler.factor index 832fedd393..d96395c91f 100644 --- a/language/cpu/ppc/assembler/assembler.factor +++ b/language/cpu/ppc/assembler/assembler.factor @@ -38,12 +38,12 @@ IN: cpu.ppc.assembler [ { 0 1 6 11 16 21 } bitfield ] dip insn ; :: md-insn ( rs ra sh mb xo sh5 rc opcode -- ) - mb [ 0x1f bitand 1 shift ] [ -5 shift ] bi bitor :> mb + mb [ 0x1f bitand 1 shift ] [ -5 shift ] bi bitor set: mb rs ra sh mb xo sh5 rc opcode [ { 0 1 2 5 11 16 21 } bitfield ] dip insn ; :: mds-insn ( rs ra rb mb xo rc opcode -- ) - mb [ 0x1f bitand 1 shift ] [ -5 shift ] bi bitor :> mb + mb [ 0x1f bitand 1 shift ] [ -5 shift ] bi bitor set: mb rs ra rb mb xo rc opcode [ { 0 1 5 11 16 21 } bitfield ] dip insn ; diff --git a/language/cpu/ppc/ppc.factor b/language/cpu/ppc/ppc.factor index 374ee10322..c562759b0f 100644 --- a/language/cpu/ppc/ppc.factor +++ b/language/cpu/ppc/ppc.factor @@ -170,8 +170,8 @@ M: ppc %replace ( vreg loc -- ) ! Replace value at stack location with an immediate value. M:: ppc %replace-imm ( src loc -- ) - loc loc-reg :> reg - loc n>> cells neg :> offset + loc loc-reg set: reg + loc n>> cells neg set: offset src { { [ dup not ] [ drop scratch-reg \ f type-number LI ] } @@ -524,7 +524,7 @@ M: ppc %unbox-alien ( dst src -- ) ! else // Assume (src & tag_mask) == BYTE_ARRAY_TYPE ! dst = ((byte_array*)src) + 1; M:: ppc %unbox-any-c-ptr ( dst src -- ) -