diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index d874243d71..ae99f9e6bf 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -45,7 +45,7 @@ GENERIC: c-type ( name -- type ) foldable : parse-array-type ( name -- array ) "[" split unclip - >r [ "]" ?tail drop string>number ] map r> add* ; + >r [ "]" ?tail drop string>number ] map r> prefix ; M: string c-type ( name -- type ) CHAR: ] over member? [ @@ -162,7 +162,7 @@ DEFER: >c-ushort-array >r >c-ushort-array r> byte-array>memory ; : (define-nth) ( word type quot -- ) - >r heap-size [ rot * ] swap add* r> append define-inline ; + >r heap-size [ rot * ] swap prefix r> append define-inline ; : nth-word ( name vocab -- word ) >r "-nth" append r> create ; @@ -199,12 +199,12 @@ M: long-long-type box-return ( type -- ) f swap box-parameter ; : define-deref ( name vocab -- ) - >r dup CHAR: * add* r> create - swap c-getter 0 add* define-inline ; + >r dup CHAR: * prefix r> create + swap c-getter 0 prefix define-inline ; : define-out ( name vocab -- ) over [ tuck 0 ] over c-setter append swap - >r >r constructor-word r> r> add* define-inline ; + >r >r constructor-word r> r> prefix define-inline ; : c-bool> ( int -- ? ) zero? not ; @@ -257,7 +257,7 @@ M: long-long-type box-return ( type -- ) #! staging violations dup array? [ unclip >r [ dup word? [ word-def call ] when ] map - r> add* + r> prefix ] when ; : malloc-file-contents ( path -- alien len ) diff --git a/core/alien/compiler/compiler.factor b/core/alien/compiler/compiler.factor index 3e0062c85a..1a9d5b5392 100755 --- a/core/alien/compiler/compiler.factor +++ b/core/alien/compiler/compiler.factor @@ -18,7 +18,7 @@ IN: alien.compiler : alien-node-parameters* ( node -- seq ) dup parameters>> - swap return>> large-struct? [ "void*" add* ] when ; + swap return>> large-struct? [ "void*" prefix ] when ; : alien-node-return* ( node -- ctype ) return>> dup large-struct? [ drop "void" ] when ; diff --git a/core/alien/structs/structs-docs.factor b/core/alien/structs/structs-docs.factor index 6c7775de2b..e7e576293f 100755 --- a/core/alien/structs/structs-docs.factor +++ b/core/alien/structs/structs-docs.factor @@ -8,7 +8,7 @@ kernel words slots assocs namespaces ; dup ?word-name swap 2array over slot-spec-name rot slot-spec-type 2array 2array - [ { $instance } swap add ] assoc-map ; + [ { $instance } swap suffix ] assoc-map ; : $spec-reader-values ( slot-spec class -- ) ($spec-reader-values) $values ; @@ -16,9 +16,9 @@ kernel words slots assocs namespaces ; : $spec-reader-description ( slot-spec class -- ) [ "Outputs the value stored in the " , - { $snippet } rot slot-spec-name add , + { $snippet } rot slot-spec-name suffix , " slot of " , - { $instance } swap add , + { $instance } swap suffix , " instance." , ] { } make $description ; @@ -43,9 +43,9 @@ M: word slot-specs "slots" word-prop ; : $spec-writer-description ( slot-spec class -- ) [ "Stores a new value to the " , - { $snippet } rot slot-spec-name add , + { $snippet } rot slot-spec-name suffix , " slot of " , - { $instance } swap add , + { $instance } swap suffix , " instance." , ] { } make $description ; diff --git a/core/alien/structs/structs.factor b/core/alien/structs/structs.factor index e5de8ab83e..491f4351a3 100755 --- a/core/alien/structs/structs.factor +++ b/core/alien/structs/structs.factor @@ -16,7 +16,7 @@ IN: alien.structs ] reduce ; : define-struct-slot-word ( spec word quot -- ) - rot slot-spec-offset add* define-inline ; + rot slot-spec-offset prefix define-inline ; : define-getter ( type spec -- ) [ set-reader-props ] keep diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 5d49203554..fc963683b6 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -305,7 +305,7 @@ M: float-array ' float-array emit-dummy-array ; ! Tuples : (emit-tuple) ( tuple -- pointer ) [ tuple>array 1 tail-slice ] - [ class transfer-word tuple-layout ] bi add* [ ' ] map + [ class transfer-word tuple-layout ] bi prefix [ ' ] map tuple type-number dup [ emit-seq ] emit-object ; : emit-tuple ( tuple -- pointer ) diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 2945bd2546..5d7c114cbc 100755 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -138,10 +138,10 @@ C: anonymous-complement members>> [ class-and ] with map ; : left-anonymous-intersection-and ( first second -- class ) - >r members>> r> add ; + >r members>> r> suffix ; : right-anonymous-intersection-and ( first second -- class ) - members>> swap add ; + members>> swap suffix ; : (class-and) ( first second -- class ) { @@ -158,10 +158,10 @@ C: anonymous-complement } cond ; : left-anonymous-union-or ( first second -- class ) - >r members>> r> add ; + >r members>> r> suffix ; : right-anonymous-union-or ( first second -- class ) - members>> swap add ; + members>> swap suffix ; : (class-or) ( first second -- class ) { diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 435c7413a3..d6d1a72121 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -72,7 +72,7 @@ M: word reset-class drop ; ! update-map : class-uses ( class -- seq ) - dup members swap superclass [ add ] when* ; + dup members swap superclass [ suffix ] when* ; : class-usages ( class -- assoc ) [ update-map get at ] closure ; diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index eb6b3bd6e2..b771aa8920 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -35,7 +35,7 @@ TUPLE: check-mixin-class mixin ; swap redefine-mixin-class ; inline : add-mixin-instance ( class mixin -- ) - [ 2drop ] [ [ add ] change-mixin-class ] if-mixin-member? ; + [ 2drop ] [ [ suffix ] change-mixin-class ] if-mixin-member? ; : remove-mixin-instance ( class mixin -- ) [ [ swap remove ] change-mixin-class ] [ 2drop ] if-mixin-member? ; diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index a3d0238d1c..3cacef25a1 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -40,7 +40,7 @@ PRIVATE> [ drop ] [ no-tuple-class ] if ; : tuple>array ( tuple -- array ) - prepare-tuple>array >r copy-tuple-slots r> layout-class add* ; + prepare-tuple>array >r copy-tuple-slots r> layout-class prefix ; : tuple-slots ( tuple -- array ) prepare-tuple>array drop copy-tuple-slots ; @@ -130,7 +130,7 @@ PRIVATE> ] with each ; : all-slot-names ( class -- slots ) - superclasses [ slot-names ] map concat \ class add* ; + superclasses [ slot-names ] map concat \ class prefix ; : compute-slot-permutation ( class old-slot-names -- permutation ) >r all-slot-names r> [ index ] curry map ; diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index 276e4cb184..f9ed219d7b 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -49,7 +49,7 @@ ERROR: no-case ; : with-datastack ( stack quot -- newstack ) datastack >r >r >array set-datastack r> call - datastack r> swap add set-datastack 2nip ; inline + datastack r> swap suffix set-datastack 2nip ; inline : recursive-hashcode ( n obj quot -- code ) pick 0 <= [ 3drop 0 ] [ rot 1- -rot call ] if ; inline @@ -72,7 +72,7 @@ M: hashtable hashcode* reverse [ no-cond ] swap alist>quot ; : linear-case-quot ( default assoc -- quot ) - [ >r [ dupd = ] curry r> \ drop add* ] assoc-map + [ >r [ dupd = ] curry r> \ drop prefix ] assoc-map alist>quot ; : (distribute-buckets) ( buckets pair keys -- ) diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index 7aa78ce52e..07698eaa92 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -94,14 +94,14 @@ IN: cpu.ppc.intrinsics } define-intrinsics : fixnum-register-op ( op -- pair ) - [ "out" operand "y" operand "x" operand ] swap add H{ + [ "out" operand "y" operand "x" operand ] swap suffix H{ { +input+ { { f "x" } { f "y" } } } { +scratch+ { { f "out" } } } { +output+ { "out" } } } 2array ; : fixnum-value-op ( op -- pair ) - [ "out" operand "x" operand "y" operand ] swap add H{ + [ "out" operand "x" operand "y" operand ] swap suffix H{ { +input+ { { f "x" } { [ small-tagged? ] "y" } } } { +scratch+ { { f "out" } } } { +output+ { "out" } } @@ -205,11 +205,11 @@ IN: cpu.ppc.intrinsics } define-intrinsic : fixnum-register-jump ( op -- pair ) - [ "x" operand 0 "y" operand CMP ] swap add + [ "x" operand 0 "y" operand CMP ] swap suffix { { f "x" } { f "y" } } 2array ; : fixnum-value-jump ( op -- pair ) - [ 0 "x" operand "y" operand CMPI ] swap add + [ 0 "x" operand "y" operand CMPI ] swap suffix { { f "x" } { [ small-tagged? ] "y" } } 2array ; : define-fixnum-jump ( word op -- ) @@ -336,7 +336,7 @@ IN: cpu.ppc.intrinsics } define-intrinsic : define-float-op ( word op -- ) - [ "z" operand "x" operand "y" operand ] swap add H{ + [ "z" operand "x" operand "y" operand ] swap suffix H{ { +input+ { { float "x" } { float "y" } } } { +scratch+ { { float "z" } } } { +output+ { "z" } } @@ -352,7 +352,7 @@ IN: cpu.ppc.intrinsics ] each : define-float-jump ( word op -- ) - [ "x" operand 0 "y" operand FCMPU ] swap add + [ "x" operand 0 "y" operand FCMPU ] swap suffix { { float "x" } { float "y" } } define-if-intrinsic ; { diff --git a/core/cpu/x86/assembler/assembler.factor b/core/cpu/x86/assembler/assembler.factor index 796388ffe1..a3ab256ea1 100755 --- a/core/cpu/x86/assembler/assembler.factor +++ b/core/cpu/x86/assembler/assembler.factor @@ -230,7 +230,7 @@ UNION: operand register indirect ; : opcode-or ( opcode mask -- opcode' ) swap dup array? - [ 1 cut* first rot bitor add ] [ bitor ] if ; + [ 1 cut* first rot bitor suffix ] [ bitor ] if ; : 1-operand ( op reg rex.w opcode -- ) #! The 'reg' is not really a register, but a value for the diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor index f5409a24f5..261ada025b 100755 --- a/core/cpu/x86/intrinsics/intrinsics.factor +++ b/core/cpu/x86/intrinsics/intrinsics.factor @@ -156,7 +156,7 @@ IN: cpu.x86.intrinsics ! Fixnums : fixnum-op ( op hash -- pair ) - >r [ "x" operand "y" operand ] swap add r> 2array ; + >r [ "x" operand "y" operand ] swap suffix r> 2array ; : fixnum-value-op ( op -- pair ) H{ @@ -251,7 +251,7 @@ IN: cpu.x86.intrinsics \ fixnum- \ SUB overflow-template : fixnum-jump ( op inputs -- pair ) - >r [ "x" operand "y" operand CMP ] swap add r> 2array ; + >r [ "x" operand "y" operand CMP ] swap suffix r> 2array ; : fixnum-value-jump ( op -- pair ) { { f "x" } { [ small-tagged? ] "y" } } fixnum-jump ; diff --git a/core/cpu/x86/sse2/sse2.factor b/core/cpu/x86/sse2/sse2.factor index 98e42fa7fe..9c477b4132 100755 --- a/core/cpu/x86/sse2/sse2.factor +++ b/core/cpu/x86/sse2/sse2.factor @@ -8,7 +8,7 @@ math.floats.private layouts quotations ; IN: cpu.x86.sse2 : define-float-op ( word op -- ) - [ "x" operand "y" operand ] swap add H{ + [ "x" operand "y" operand ] swap suffix H{ { +input+ { { float "x" } { float "y" } } } { +output+ { "x" } } } define-intrinsic ; @@ -23,7 +23,7 @@ IN: cpu.x86.sse2 ] each : define-float-jump ( word op -- ) - [ "x" operand "y" operand UCOMISD ] swap add + [ "x" operand "y" operand UCOMISD ] swap suffix { { float "x" } { float "y" } } define-if-intrinsic ; { diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 131b7e57c9..7dba7eb709 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -157,7 +157,7 @@ M: assoc update-methods ( assoc -- ) M: generic subwords dup "methods" word-prop values - swap "default-method" word-prop add ; + swap "default-method" word-prop suffix ; M: generic forget-word dup subwords [ forget ] each (forget-word) ; diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 3898150c3b..4ed883dad5 100755 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -34,8 +34,8 @@ ERROR: no-method object generic ; : empty-method ( word -- quot ) [ picker % [ delegate dup ] % - unpicker over add , - error-method \ drop add* , \ if , + unpicker over suffix , + error-method \ drop prefix , \ if , ] [ ] make ; : class-predicates ( assoc -- assoc ) @@ -135,7 +135,7 @@ ERROR: no-method object generic ; ] if ; : standard-methods ( word -- alist ) - dup methods swap default-method add* + dup methods swap default-method prefix [ 1quotation ] assoc-map ; M: standard-combination make-default-method diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor index 2a2e6995eb..5ca9b1b2e7 100755 --- a/core/inference/backend/backend.factor +++ b/core/inference/backend/backend.factor @@ -92,7 +92,7 @@ M: wrapper apply-object r> recursive-state set ; : infer-quot-recursive ( quot word label -- ) - recursive-state get -rot 2array add* infer-quot ; + recursive-state get -rot 2array prefix infer-quot ; : time-bomb ( error -- ) [ throw ] curry recursive-state get infer-quot ; @@ -109,7 +109,7 @@ TUPLE: recursive-quotation-error quot ; dup value-literal callable? [ dup value-literal over value-recursion - rot f 2array add* infer-quot + rot f 2array prefix infer-quot ] [ drop bad-call ] if @@ -430,7 +430,7 @@ M: #call-label collect-recursion* [ [ swap collect-recursion* ] curry each-node ] { } make ; : join-values ( node -- ) - collect-recursion [ node-in-d ] map meta-d get add + collect-recursion [ node-in-d ] map meta-d get suffix unify-lengths unify-stacks meta-d [ length tail* ] change ; diff --git a/core/inference/class/class.factor b/core/inference/class/class.factor index ed36ca4890..4aac98ce41 100755 --- a/core/inference/class/class.factor +++ b/core/inference/class/class.factor @@ -289,7 +289,7 @@ M: #label infer-classes-around ( #label -- ) dup annotate-node dup infer-classes-before dup infer-children - dup collect-recursion over add + dup collect-recursion over suffix pick annotate-entry node-child (infer-classes) ; diff --git a/core/inference/dataflow/dataflow.factor b/core/inference/dataflow/dataflow.factor index 0b6cf04028..7fa2fbbcd3 100755 --- a/core/inference/dataflow/dataflow.factor +++ b/core/inference/dataflow/dataflow.factor @@ -205,7 +205,7 @@ UNION: #branch #if #dispatch ; 2dup 2slip rot [ 2drop t ] [ - >r dup node-children swap node-successor add r> + >r dup node-children swap node-successor suffix r> [ node-exists? ] curry contains? ] if ] [ diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index 4d636c24f2..06c2a8f476 100755 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -58,7 +58,7 @@ M: pair (bitfield-quot) ( spec -- quot ) [ shift bitor ] append 2curry ; : bitfield-quot ( spec -- quot ) - [ (bitfield-quot) ] map [ 0 ] add* concat ; + [ (bitfield-quot) ] map [ 0 ] prefix concat ; \ bitfield [ bitfield-quot ] 1 define-transform diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 2ef26096e0..398fb6a068 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -59,7 +59,7 @@ M: tuple f decoder construct-boa ; over decoder-cr [ over cr- "\n" ?head [ - over stream-read1 [ add ] when* + over stream-read1 [ suffix ] when* ] when ] when nip ; diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 458a9145a6..099acb157e 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -267,6 +267,7 @@ M: object copy-file DEFER: copy-tree-into : copy-tree ( from to -- ) + normalize-pathname over link-info type>> { { +symbolic-link+ [ copy-link ] } diff --git a/core/math/intervals/intervals-tests.factor b/core/math/intervals/intervals-tests.factor index f6317e7475..5204d7d45a 100755 --- a/core/math/intervals/intervals-tests.factor +++ b/core/math/intervals/intervals-tests.factor @@ -188,7 +188,7 @@ IN: math.intervals.tests { max interval-max } } "math.ratios.private" vocab [ - { / interval/ } add + { / interval/ } suffix ] when random ; diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor index aef48452de..108c715ef0 100755 --- a/core/optimizer/known-words/known-words.factor +++ b/core/optimizer/known-words/known-words.factor @@ -60,7 +60,7 @@ sequences.private combinators ; [ value-literal sequence? ] [ drop f ] if ; : member-quot ( seq -- newquot ) - [ [ t ] ] { } map>assoc [ drop f ] add [ nip case ] curry ; + [ [ t ] ] { } map>assoc [ drop f ] suffix [ nip case ] curry ; : expand-member ( #call -- ) dup node-in-d peek value-literal member-quot f splice-quot ; diff --git a/core/optimizer/specializers/specializers.factor b/core/optimizer/specializers/specializers.factor index 560a174289..cbdb1b9ec4 100755 --- a/core/optimizer/specializers/specializers.factor +++ b/core/optimizer/specializers/specializers.factor @@ -32,7 +32,7 @@ IN: optimizer.specializers : method-declaration ( method -- quot ) dup "method-generic" word-prop dispatch# object - swap "method-class" word-prop add* ; + swap "method-class" word-prop prefix ; : specialize-method ( quot method -- quot' ) method-declaration [ declare ] curry prepend ; diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 36e5decd05..58c68a3614 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -294,7 +294,7 @@ M: no-word-error summary scan { { ";" [ tuple f ] } { "<" [ scan-word ";" parse-tokens ] } - [ >r tuple ";" parse-tokens r> add* ] + [ >r tuple ";" parse-tokens r> prefix ] } case ; ERROR: staging-violation word ; diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor index 35b30ac46f..27b63ec26f 100755 --- a/core/prettyprint/prettyprint-tests.factor +++ b/core/prettyprint/prettyprint-tests.factor @@ -192,7 +192,7 @@ unit-test "IN: prettyprint.tests" ": another-soft-break-layout ( node -- quot )" " parse-error-file" - " [ \"hello world foo\" add ] [ ] make ;" + " [ \"hello world foo\" suffix ] [ ] make ;" } ; [ t ] [ diff --git a/core/quotations/quotations-tests.factor b/core/quotations/quotations-tests.factor index a4c9a619b5..d311dfad71 100755 --- a/core/quotations/quotations-tests.factor +++ b/core/quotations/quotations-tests.factor @@ -10,8 +10,8 @@ IN: quotations.tests ] unit-test [ [ 1 2 3 4 ] ] [ [ 1 2 ] [ 3 4 ] append ] unit-test -[ [ 1 2 3 ] ] [ [ 1 2 ] 3 add ] unit-test -[ [ 3 1 2 ] ] [ [ 1 2 ] 3 add* ] unit-test +[ [ 1 2 3 ] ] [ [ 1 2 ] 3 suffix ] unit-test +[ [ 3 1 2 ] ] [ [ 1 2 ] 3 prefix ] unit-test [ [ "hi" ] ] [ "hi" 1quotation ] unit-test diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 9e8dcd6559..f5e5bfcdb3 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -61,8 +61,8 @@ ARTICLE: "sequences-access" "Accessing sequence elements" ARTICLE: "sequences-add-remove" "Adding and removing sequence elements" "Adding elements:" -{ $subsection add } -{ $subsection add* } +{ $subsection prefix } +{ $subsection suffix } "Removing elements:" { $subsection remove } { $subsection seq-diff } ; @@ -641,22 +641,22 @@ HELP: push-new } { $side-effects "seq" } ; -{ push push-new add add* } related-words +{ push push-new prefix suffix } related-words -HELP: add +HELP: suffix { $values { "seq" sequence } { "elt" object } { "newseq" sequence } } { $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the end of " { $snippet "seq" } "." } { $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." } { $examples - { $example "USING: prettyprint sequences ;" "{ 1 2 3 } 4 add ." "{ 1 2 3 4 }" } + { $example "USING: prettyprint sequences ;" "{ 1 2 3 } 4 suffix ." "{ 1 2 3 4 }" } } ; -HELP: add* +HELP: prefix { $values { "seq" sequence } { "elt" object } { "newseq" sequence } } { $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the beginning of " { $snippet "seq" } "." } { $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." } { $examples -{ $example "USING: prettyprint sequences ;" "{ 1 2 3 } 0 add* ." "{ 0 1 2 3 }" } +{ $example "USING: prettyprint sequences ;" "{ 1 2 3 } 0 prefix ." "{ 0 1 2 3 }" } } ; HELP: seq-diff @@ -940,7 +940,7 @@ HELP: unclip { $values { "seq" sequence } { "rest" sequence } { "first" object } } { $description "Outputs a tail sequence and the first element of " { $snippet "seq" } "; the tail sequence consists of all elements of " { $snippet "seq" } " but the first." } { $examples - { $example "USING: prettyprint sequences ;" "{ 1 2 3 } unclip add ." "{ 2 3 1 }" } + { $example "USING: prettyprint sequences ;" "{ 1 2 3 } unclip suffix ." "{ 2 3 1 }" } } ; HELP: unclip-slice diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 1f2a6c5501..ca46066861 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -478,18 +478,18 @@ M: sequence <=> : push-new ( elt seq -- ) [ delete ] 2keep push ; -: add ( seq elt -- newseq ) - over >r over length 1+ r> [ - [ >r over length r> set-nth-unsafe ] keep - [ 0 swap copy ] keep - ] new-like ; - -: add* ( seq elt -- newseq ) +: prefix ( seq elt -- newseq ) over >r over length 1+ r> [ [ 0 swap set-nth-unsafe ] keep [ 1 swap copy ] keep ] new-like ; +: suffix ( seq elt -- newseq ) + over >r over length 1+ r> [ + [ >r over length r> set-nth-unsafe ] keep + [ 0 swap copy ] keep + ] new-like ; + : seq-diff ( seq1 seq2 -- newseq ) swap [ member? not ] curry subset ; diff --git a/core/slots/slots.factor b/core/slots/slots.factor index b674ec8c2a..e46e507b9d 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -14,7 +14,7 @@ C: slot-spec >r create-method r> define ; : define-slot-word ( class slot word quot -- ) - rot >fixnum add* define-typecheck ; + rot >fixnum prefix define-typecheck ; : reader-quot ( decl -- quot ) [ diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor index 9be1d5fc64..260a08c044 100755 --- a/core/splitting/splitting.factor +++ b/core/splitting/splitting.factor @@ -76,5 +76,5 @@ INSTANCE: groups sequence 1 head-slice* [ "\r" ?tail drop "\r" split ] map - ] keep peek "\r" split add concat + ] keep peek "\r" split suffix concat ] if ; diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 57947eefb0..1489750154 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -20,7 +20,7 @@ V{ : vocab-dir+ ( vocab str/f -- path ) >r vocab-name "." split r> - [ >r dup peek r> append add ] when* + [ >r dup peek r> append suffix ] when* "/" join ; : vocab-dir? ( root name -- ? ) diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index 886417b715..a6a5a014a7 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -82,7 +82,7 @@ SYMBOL: load-vocab-hook ! ( name -- ) : child-vocab? ( prefix name -- ? ) 2dup = pick empty? or - [ 2drop t ] [ swap CHAR: . add head? ] if ; + [ 2drop t ] [ swap CHAR: . suffix head? ] if ; : child-vocabs ( vocab -- seq ) vocab-name vocabs [ child-vocab? ] with subset ; diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 30c3beb1ef..215b677e16 100755 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -49,7 +49,7 @@ HINTS: random fixnum ; : make-cumulative ( freq -- chars floats ) dup keys >byte-array - swap values >float-array unclip [ + ] accumulate swap add ; + swap values >float-array unclip [ + ] accumulate swap suffix ; :: select-random ( seed chars floats -- seed elt ) floats seed random -rot diff --git a/extra/cfdg/cfdg.factor b/extra/cfdg/cfdg.factor index 8a1d93aceb..63fd55a550 100644 --- a/extra/cfdg/cfdg.factor +++ b/extra/cfdg/cfdg.factor @@ -32,7 +32,7 @@ VAR: color ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: hsva>rgba ( hsva -- rgba ) [ 3 head hsv>rgb ] [ peek ] bi add ; +: hsva>rgba ( hsva -- rgba ) [ 3 head hsv>rgb ] [ peek ] bi suffix ; : gl-set-hsba ( hsva -- ) hsva>rgba gl-color ; diff --git a/extra/cocoa/subclassing/subclassing.factor b/extra/cocoa/subclassing/subclassing.factor index 42ddce1206..48f45f21c0 100755 --- a/extra/cocoa/subclassing/subclassing.factor +++ b/extra/cocoa/subclassing/subclassing.factor @@ -76,7 +76,7 @@ IN: cocoa.subclassing r> class_addMethods ; : encode-types ( return types -- encoding ) - swap add* [ + swap prefix [ alien>objc-types get at "0" append ] map concat ; diff --git a/extra/color-picker/color-picker.factor b/extra/color-picker/color-picker.factor index 647c83d667..0480235dfe 100755 --- a/extra/color-picker/color-picker.factor +++ b/extra/color-picker/color-picker.factor @@ -21,7 +21,7 @@ M: color-preview model-changed swap model-value over set-gadget-interior relayout-1 ; : ( model -- model ) - [ [ 256 /f ] map 1 add ] ; + [ [ 256 /f ] map 1 suffix ] ; : ( -- model gadget ) 3 [ drop 0 0 0 255 ] map diff --git a/extra/delegate/delegate.factor b/extra/delegate/delegate.factor index 7f24d6258f..eadd1a03e8 100755 --- a/extra/delegate/delegate.factor +++ b/extra/delegate/delegate.factor @@ -27,7 +27,7 @@ M: tuple-class group-words swap [ slot-spec-writer ] map append ; : define-consult-method ( word class quot -- ) - pick add >r swap create-method r> define ; + pick suffix >r swap create-method r> define ; : define-consult ( class group quot -- ) >r group-words swap r> diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index 85d58e7572..c442dfaa94 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -43,7 +43,7 @@ SYMBOL: edit-hook : fix ( word -- ) "Fixing " write dup pprint " and all usages..." print nl - dup usage swap add* [ + dup usage swap prefix [ "Editing " write dup . "RETURN moves on to the next usage, C+d stops." print flush diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor index c6d9cd04d2..1022a02d7e 100644 --- a/extra/faq/faq.factor +++ b/extra/faq/faq.factor @@ -69,7 +69,7 @@ C: faq : html>faq ( div -- faq ) unclip swap { "h3" "ol" } [ tags-named ] with map - first2 >r f add* r> [ html>question-list ] 2map ; + first2 >r f prefix r> [ html>question-list ] 2map ; : header, ( faq -- ) dup faq-header , diff --git a/extra/fry/fry.factor b/extra/fry/fry.factor index 490ce992ab..d983bd2715 100755 --- a/extra/fry/fry.factor +++ b/extra/fry/fry.factor @@ -28,7 +28,7 @@ DEFER: (fry) ! to avoid confusion, remove if fry goes core { namespaces:, [ [ curry ] ((fry)) ] } - [ swap >r add r> (fry) ] + [ swap >r suffix r> (fry) ] } case ] if ; diff --git a/extra/help/markup/markup.factor b/extra/help/markup/markup.factor index f8d360fd0a..b963a19f29 100755 --- a/extra/help/markup/markup.factor +++ b/extra/help/markup/markup.factor @@ -234,7 +234,7 @@ M: string ($instance) : values-row ( seq -- seq ) unclip \ $snippet swap ?word-name 2array - swap dup first word? [ \ $instance add* ] when 2array ; + swap dup first word? [ \ $instance prefix ] when 2array ; : $values ( element -- ) "Inputs and outputs" $heading diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 1dc7f4883d..e1cc36cd2e 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -6,7 +6,8 @@ IN: io.sockets TUPLE: local path ; -C: local +: ( path -- addrspec ) + normalize-pathname local construct-boa ; TUPLE: inet4 host port ; diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index c7931c6f0c..69ce6a3069 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -7,7 +7,7 @@ USING: alien alien.c-types generic io kernel math namespaces io.nonblocking parser threads unix sequences byte-arrays io.sockets io.binary io.unix.backend io.streams.duplex io.sockets.impl math.parser continuations libc -combinators io.backend ; +combinators io.backend io.files ; IN: io.unix.sockets : pending-init-error ( port -- ) @@ -189,7 +189,7 @@ M: local protocol-family drop PF_UNIX ; M: local sockaddr-type drop "sockaddr-un" c-type ; M: local make-sockaddr - local-path normalize-pathname + local-path cwd prepend-path dup length 1 + max-un-path > [ "Path too long" throw ] when "sockaddr-un" AF_UNIX over set-sockaddr-un-family diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor index f286690d37..add37173b7 100755 --- a/extra/koszul/koszul.factor +++ b/extra/koszul/koszul.factor @@ -184,7 +184,7 @@ DEFER: (d) [ length ] keep [ (graded-ker/im-d) ] curry map ; : graded-betti ( generators -- seq ) - basis graded graded-ker/im-d flip first2 1 head* 0 add* v- ; + basis graded graded-ker/im-d flip first2 1 head* 0 prefix v- ; ! Bi-graded for two-step complexes : (bigraded-ker/im-d) ( u-deg z-deg bigraded-basis -- null/rank ) @@ -203,7 +203,7 @@ DEFER: (d) [ basis graded ] bi@ tensor bigraded-ker/im-d [ [ [ first ] map ] map ] keep [ [ second ] map 2 head* { 0 0 } prepend ] map - 1 tail dup first length 0 add + 1 tail dup first length 0 suffix [ v- ] 2map ; ! Laplacian diff --git a/extra/lazy-lists/lazy-lists.factor b/extra/lazy-lists/lazy-lists.factor index 52cca64b2f..f642d8881c 100644 --- a/extra/lazy-lists/lazy-lists.factor +++ b/extra/lazy-lists/lazy-lists.factor @@ -365,7 +365,7 @@ M: lazy-concat nil? ( lazy-concat -- bool ) drop nil ] [ [ car ] keep cdr [ car lcartesian-product ] keep cdr list>array swap [ - swap [ swap [ add ] lmap-with ] lmap-with lconcat + swap [ swap [ suffix ] lmap-with ] lmap-with lconcat ] reduce ] if ; diff --git a/extra/locals/locals.factor b/extra/locals/locals.factor index 5da0225be9..fe4bd65c14 100755 --- a/extra/locals/locals.factor +++ b/extra/locals/locals.factor @@ -108,7 +108,7 @@ UNION: special local quote local-word local-reader local-writer ; : point-free-end ( quot args -- newquot ) over peek special? [ drop-locals >r >r peek r> localize r> append ] - [ drop-locals nip swap peek add ] + [ drop-locals nip swap peek suffix ] if ; : (point-free) ( quot args -- newquot ) @@ -130,9 +130,9 @@ GENERIC: free-vars ( form -- vars ) : add-if-free ( vars object -- vars ) { - { [ dup local-writer? ] [ "local-reader" word-prop add ] } - { [ dup lexical? ] [ add ] } - { [ dup quote? ] [ quote-local add ] } + { [ dup local-writer? ] [ "local-reader" word-prop suffix ] } + { [ dup lexical? ] [ suffix ] } + { [ dup quote? ] [ quote-local suffix ] } { [ t ] [ free-vars append ] } } cond ; diff --git a/extra/logging/logging.factor b/extra/logging/logging.factor index 42545500a5..664337c3d3 100755 --- a/extra/logging/logging.factor +++ b/extra/logging/logging.factor @@ -17,7 +17,7 @@ SYMBOL: CRITICAL { DEBUG NOTICE NOTICE WARNING ERROR CRITICAL } ; : send-to-log-server ( array string -- ) - add* "log-server" get send ; + prefix "log-server" get send ; SYMBOL: log-service diff --git a/extra/lsys/tortoise/graphics/graphics.factor b/extra/lsys/tortoise/graphics/graphics.factor index d8429e7aaf..87536476ee 100644 --- a/extra/lsys/tortoise/graphics/graphics.factor +++ b/extra/lsys/tortoise/graphics/graphics.factor @@ -77,7 +77,7 @@ VAR: color-table { 0.25 0.25 0.25 } ! dark grey { 0.75 0.75 0.75 } ! medium grey { 1 1 1 } ! white -} [ 1 add ] map >color-table ; +} [ 1 suffix ] map >color-table ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/math/combinatorics/combinatorics.factor b/extra/math/combinatorics/combinatorics.factor index 99a098ca09..487d9828ea 100644 --- a/extra/math/combinatorics/combinatorics.factor +++ b/extra/math/combinatorics/combinatorics.factor @@ -18,7 +18,7 @@ IN: math.combinatorics 0 [ over 0 > ] [ 1+ [ /mod ] keep swap ] [ ] unfold reverse 2nip ; : (>permutation) ( seq n -- seq ) - [ [ dupd >= [ 1+ ] when ] curry map ] keep add* ; + [ [ dupd >= [ 1+ ] when ] curry map ] keep prefix ; : >permutation ( factoradic -- permutation ) reverse 1 cut [ (>permutation) ] each ; diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index ac62fb08f9..5ea19bc957 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -191,14 +191,14 @@ M: hook-combination generic-prologue [ delete-at ] with-methods ; : method>spec ( method -- spec ) - dup method-classes swap method-generic add* ; + dup method-classes swap method-generic prefix ; : parse-method ( -- quot classes generic ) parse-definition dup 2 tail over second rot first ; : METHOD: location - >r parse-method [ define-method ] 2keep add* r> + >r parse-method [ define-method ] 2keep prefix r> remember-definition ; parsing ! For compatibility diff --git a/extra/opengl/gl/extensions/extensions.factor b/extra/opengl/gl/extensions/extensions.factor index 01725ee9a9..fd9be4eb12 100644 --- a/extra/opengl/gl/extensions/extensions.factor +++ b/extra/opengl/gl/extensions/extensions.factor @@ -38,7 +38,7 @@ reset-gl-function-number-counter gl-function-calling-convention scan scan dup - scan drop "}" parse-tokens swap add* + scan drop "}" parse-tokens swap prefix gl-function-number [ gl-function-pointer ] 2curry swap ";" parse-tokens [ "()" subseq? not ] subset diff --git a/extra/openssl/openssl-tests.factor b/extra/openssl/openssl-tests.factor index c689f729d1..c85c0ee218 100755 --- a/extra/openssl/openssl-tests.factor +++ b/extra/openssl/openssl-tests.factor @@ -11,11 +11,12 @@ namespaces math math.parser openssl prettyprint sequences tools.test ; ] [ "Hello world from the openssl binding" >md5 ] unit-test -[ - B{ 63 113 237 255 181 5 152 241 136 181 43 95 160 105 44 87 49 - 82 115 0 } -] -[ "Hello world from the openssl binding" >sha1 ] unit-test +! Not found on netbsd, windows -- why? +! [ + ! B{ 63 113 237 255 181 5 152 241 136 181 43 95 160 105 44 87 49 + ! 82 115 0 } +! ] +! [ "Hello world from the openssl binding" >sha1 ] unit-test ! ========================================================= ! Initialize context diff --git a/extra/oracle/oracle.factor b/extra/oracle/oracle.factor index d725de5994..a30ce64854 100644 --- a/extra/oracle/oracle.factor +++ b/extra/oracle/oracle.factor @@ -236,13 +236,13 @@ C: connection : fetch-each ( object -- object ) fetch-statement [ - buf get alien>char-string res get swap add res set + buf get alien>char-string res get swap suffix res set fetch-each ] [ ] if ; : run-query ( object -- object ) execute-statement [ - buf get alien>char-string res get swap add res set + buf get alien>char-string res get swap suffix res set fetch-each ] [ ] if ; diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor index d6aacf9645..d8fccfb8f9 100755 --- a/extra/parser-combinators/parser-combinators.factor +++ b/extra/parser-combinators/parser-combinators.factor @@ -132,7 +132,7 @@ TUPLE: and-parser parsers ; : <&> ( parser1 parser2 -- parser ) over and-parser? [ - >r and-parser-parsers r> add + >r and-parser-parsers r> suffix ] [ 2array ] if and-parser construct-boa ; @@ -239,11 +239,11 @@ M: some-parser parse ( input parser -- result ) : <:&> ( parser1 parser2 -- result ) #! Same as <&> except flatten the result. - <&> [ first2 add ] <@ ; + <&> [ first2 suffix ] <@ ; : <&:> ( parser1 parser2 -- result ) #! Same as <&> except flatten the result. - <&> [ first2 swap add* ] <@ ; + <&> [ first2 swap prefix ] <@ ; : <:&:> ( parser1 parser2 -- result ) #! Same as <&> except flatten the result. diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 9e35c5b9be..3e0ce815f0 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -104,7 +104,7 @@ C: peg-head :: (setup-lr) ( r l s -- ) s head>> l head>> eq? [ l head>> s (>>head) - l head>> [ s rule>> add ] change-involved-set drop + l head>> [ s rule>> suffix ] change-involved-set drop r l s next>> (setup-lr) ] unless ; @@ -136,7 +136,7 @@ C: peg-head h [ p heads get at ] | h [ - m r h involved-set>> h rule>> add member? not and [ + m r h involved-set>> h rule>> suffix member? not and [ fail p ] [ r h eval-set>> member? [ diff --git a/extra/project-euler/043/043.factor b/extra/project-euler/043/043.factor index ffe3a4bca1..cf09277f31 100644 --- a/extra/project-euler/043/043.factor +++ b/extra/project-euler/043/043.factor @@ -76,10 +76,10 @@ PRIVATE> dup first 2 tail* swap second 2 head = ; : clean ( seq -- seq ) - [ unclip 1 head add* concat ] map [ all-unique? ] subset ; + [ unclip 1 head prefix concat ] map [ all-unique? ] subset ; : add-missing-digit ( seq -- seq ) - dup natural-sort 10 seq-diff first add* ; + dup natural-sort 10 seq-diff first prefix ; : interesting-pandigitals ( -- seq ) 17 candidates { 13 11 7 5 3 2 } [ diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index 087b216b3a..5829f66c01 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -72,7 +72,7 @@ PRIVATE> : max-path ( triangle -- n ) dup length 1 > [ - 2 cut* first2 max-children [ + ] 2map add max-path + 2 cut* first2 max-children [ + ] 2map suffix max-path ] [ first first ] if ; @@ -95,7 +95,7 @@ PRIVATE> ! Not strictly needed, but it is nice to be able to dump the triangle after the ! propagation : propagate-all ( triangle -- newtriangle ) - reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ; + reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap suffix ; : sum-divisors ( n -- sum ) dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ; diff --git a/extra/qualified/qualified.factor b/extra/qualified/qualified.factor index b4eb4558fa..69e4c09b6e 100644 --- a/extra/qualified/qualified.factor +++ b/extra/qualified/qualified.factor @@ -4,7 +4,7 @@ IN: qualified : define-qualified ( vocab-name -- ) dup require - dup vocab-words swap CHAR: : add + dup vocab-words swap CHAR: : suffix [ -rot >r append r> ] curry assoc-map use get push ; diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor index fa36a7c6f8..b0cd61bd8f 100755 --- a/extra/regexp/regexp.factor +++ b/extra/regexp/regexp.factor @@ -21,7 +21,7 @@ SYMBOL: ignore-case? if 2curry ; : or-predicates ( quots -- quot ) - [ \ dup add* ] map [ [ t ] ] f short-circuit \ nip add ; + [ \ dup prefix ] map [ [ t ] ] f short-circuit \ nip suffix ; : <@literal [ nip ] curry <@ ; diff --git a/extra/regexp2/regexp2.factor b/extra/regexp2/regexp2.factor index 1f2bbde171..8c26d880f1 100644 --- a/extra/regexp2/regexp2.factor +++ b/extra/regexp2/regexp2.factor @@ -21,7 +21,7 @@ SYMBOL: ignore-case? if 2curry ; : or-predicates ( quots -- quot ) - [ \ dup add* ] map [ [ t ] ] f short-circuit \ nip add ; + [ \ dup prefix ] map [ [ t ] ] f short-circuit \ nip suffix ; : literal-action [ nip ] curry action ; diff --git a/extra/sequences/deep/deep-tests.factor b/extra/sequences/deep/deep-tests.factor index 541570f3f9..9629d569cb 100755 --- a/extra/sequences/deep/deep-tests.factor +++ b/extra/sequences/deep/deep-tests.factor @@ -11,7 +11,7 @@ IN: sequences.deep.tests [ { { "foo" } "bar" } t ] [ { { "foo" } "bar" } [ array? ] deep-find* ] unit-test : change-something ( seq -- newseq ) - dup array? [ "hi" add ] [ "hello" append ] if ; + dup array? [ "hi" suffix ] [ "hello" append ] if ; [ { { "heyhello" "hihello" } "hihello" } ] [ "hey" 1array 1array [ change-something ] deep-map ] unit-test diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 0b93552e76..d246b16b8d 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -94,7 +94,7 @@ MACRO: firstn ( n -- ) : monotonic-split ( seq quot -- newseq ) [ - >r dup unclip add r> + >r dup unclip suffix r> v, [ pick ,, call [ v, ] unless ] curry 2each ,v ] { } make ; diff --git a/extra/springies/springies.factor b/extra/springies/springies.factor index 3a1af786e2..cd6e1a7cfb 100644 --- a/extra/springies/springies.factor +++ b/extra/springies/springies.factor @@ -235,7 +235,7 @@ C: spring 6 nrot 6 nrot 2array 5 nrot 5 nrot 2array 0 0 2array - nodes> swap add >nodes ; + nodes> swap suffix >nodes ; : spng ( id id-a id-b k damp rest-length -- ) 6 nrot drop @@ -243,4 +243,4 @@ C: spring 5 nrot node-id 5 nrot node-id - springs> swap add >springs ; + springs> swap suffix >springs ; diff --git a/extra/state-machine/state-machine.factor b/extra/state-machine/state-machine.factor index cd3cfc6324..489b7aaeb4 100755 --- a/extra/state-machine/state-machine.factor +++ b/extra/state-machine/state-machine.factor @@ -6,7 +6,7 @@ IN: state-machine ! STATES: set-name state1 state2 ... ; ";" parse-tokens [ length ] keep - unclip add + unclip suffix [ create-in swap 1quotation define ] 2each ; parsing TUPLE: state place data ; diff --git a/extra/tetris/board/board.factor b/extra/tetris/board/board.factor index 13850f6bd7..93bbebf34f 100644 --- a/extra/tetris/board/board.factor +++ b/extra/tetris/board/board.factor @@ -37,7 +37,7 @@ TUPLE: board width height rows ; : add-row ( board -- ) dup board-rows over board-width f - add* swap set-board-rows ; + prefix swap set-board-rows ; : top-up-rows ( board -- ) dup board-height over board-rows length = [ diff --git a/extra/tools/deploy/backend/backend.factor b/extra/tools/deploy/backend/backend.factor index b019326ed5..395c4ff924 100755 --- a/extra/tools/deploy/backend/backend.factor +++ b/extra/tools/deploy/backend/backend.factor @@ -46,7 +46,7 @@ IN: tools.deploy.backend : staging-image-name ( profile -- name ) "staging." - swap strip-word-names? [ "strip" add ] when + swap strip-word-names? [ "strip" suffix ] when "-" join ".image" 3append temp-file ; DEFER: ?make-staging-image @@ -75,7 +75,7 @@ DEFER: ?make-staging-image ] { } make ; : run-factor ( vm flags -- ) - swap add* dup . run-with-output ; inline + swap prefix dup . run-with-output ; inline : make-staging-image ( profile -- ) vm swap staging-command-line run-factor ; diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor index d7610c21c8..2f941ad2ce 100755 --- a/extra/tools/vocabs/vocabs.factor +++ b/extra/tools/vocabs/vocabs.factor @@ -230,7 +230,7 @@ MEMO: all-vocabs-seq ( -- seq ) try-everything load-failures. ; : unrooted-child-vocabs ( prefix -- seq ) - dup empty? [ CHAR: . add ] unless + dup empty? [ CHAR: . suffix ] unless vocabs [ find-vocab-root not ] subset [ @@ -242,7 +242,7 @@ MEMO: all-vocabs-seq ( -- seq ) vocab-roots get [ dup pick (all-child-vocabs) [ >vocab-link ] map ] { } map>assoc - swap unrooted-child-vocabs f swap 2array add ; + swap unrooted-child-vocabs f swap 2array suffix ; : all-child-vocabs-seq ( prefix -- assoc ) vocab-roots get swap [ diff --git a/extra/tools/walker/walker.factor b/extra/tools/walker/walker.factor index 2aed793a59..d548c0a4f5 100755 --- a/extra/tools/walker/walker.factor +++ b/extra/tools/walker/walker.factor @@ -49,10 +49,10 @@ DEFER: start-walker-thread \ break t "break?" set-word-prop : walk ( quot -- quot' ) - \ break add* [ break rethrow ] recover ; + \ break prefix [ break rethrow ] recover ; : add-breakpoint ( quot -- quot' ) - dup [ break ] head? [ \ break add* ] unless ; + dup [ break ] head? [ \ break prefix ] unless ; : (step-into-quot) ( quot -- ) add-breakpoint call ; @@ -114,7 +114,7 @@ SYMBOL: +stopped+ ] change-frame ; : step-out-msg ( continuation -- continuation' ) - [ nip \ break add ] change-frame ; + [ nip \ break suffix ] change-frame ; { { call [ (step-into-quot) ] } diff --git a/extra/ui/commands/commands-docs.factor b/extra/ui/commands/commands-docs.factor index 789d9b9e6a..ed524148e3 100644 --- a/extra/ui/commands/commands-docs.factor +++ b/extra/ui/commands/commands-docs.factor @@ -14,7 +14,7 @@ IN: ui.commands : command-map. ( command-map -- ) [ command-map-row ] map { "Shortcut" "Command" "Word" "Notes" } - [ \ $strong swap ] { } map>assoc add* + [ \ $strong swap ] { } map>assoc prefix $table ; : $command-map ( element -- ) diff --git a/extra/ui/gadgets/grid-lines/grid-lines.factor b/extra/ui/gadgets/grid-lines/grid-lines.factor index fce88c0ebb..533116824b 100755 --- a/extra/ui/gadgets/grid-lines/grid-lines.factor +++ b/extra/ui/gadgets/grid-lines/grid-lines.factor @@ -18,7 +18,7 @@ SYMBOL: grid-dim grid-dim get spin set-axis ; : draw-grid-lines ( gaps orientation -- ) - grid get rot grid-positions grid get rect-dim add [ + grid get rot grid-positions grid get rect-dim suffix [ grid-line-from/to gl-line ] with each ; diff --git a/extra/ui/gadgets/panes/panes.factor b/extra/ui/gadgets/panes/panes.factor index 52c5ca8a02..91b7f0f225 100755 --- a/extra/ui/gadgets/panes/panes.factor +++ b/extra/ui/gadgets/panes/panes.factor @@ -352,7 +352,7 @@ M: f sloppy-pick-up* : sloppy-pick-up ( loc gadget -- path ) 2dup sloppy-pick-up* dup - [ [ wet-and-sloppy sloppy-pick-up ] keep add* ] + [ [ wet-and-sloppy sloppy-pick-up ] keep prefix ] [ 3drop { } ] if ; diff --git a/extra/ui/gadgets/slate/slate.factor b/extra/ui/gadgets/slate/slate.factor index 5ea1ec20fa..ab2abeec5b 100644 --- a/extra/ui/gadgets/slate/slate.factor +++ b/extra/ui/gadgets/slate/slate.factor @@ -3,7 +3,11 @@ USING: kernel namespaces opengl ui.render ui.gadgets ; IN: ui.gadgets.slate -TUPLE: slate action dim graft ungraft ; +TUPLE: slate action dim graft ungraft + button-down + button-up + key-down + key-up ; : ( action -- slate ) slate construct-gadget @@ -19,4 +23,100 @@ M: slate draw-gadget* ( slate -- ) M: slate graft* ( slate -- ) slate-graft call ; -M: slate ungraft* ( slate -- ) slate-ungraft call ; \ No newline at end of file +M: slate ungraft* ( slate -- ) slate-ungraft call ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: key-pressed-value + +: key-pressed? ( -- ? ) key-pressed-value get ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: mouse-pressed-value + +: mouse-pressed? ( -- ? ) mouse-pressed-value get ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: key-value + +: key ( -- key ) key-value get ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: button-value + +: button ( -- val ) button-value get ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USING: combinators ui.gestures accessors ; + +! M: slate handle-gesture* ( gadget gesture delegate -- ? ) +! drop nip +! { +! { +! [ dup key-down? ] +! [ + +! key-down-sym key-value set +! key-pressed-value on +! t +! ] +! } +! { [ dup key-up? ] [ drop key-pressed-value off t ] } +! { +! [ dup button-down? ] +! [ +! button-down-# mouse-button-value set +! mouse-pressed-value on +! t +! ] +! } +! { [ dup button-up? ] [ drop mouse-pressed-value off t ] } +! { [ t ] [ drop t ] } +! } +! cond ; + +M: slate handle-gesture* ( gadget gesture delegate -- ? ) + rot drop swap ! delegate gesture + { + { + [ dup key-down? ] + [ + key-down-sym key-value set + key-pressed-value on + key-down>> dup [ call ] [ drop ] if + t + ] + } + { + [ dup key-up? ] + [ + key-pressed-value off + drop + key-up>> dup [ call ] [ drop ] if + t + ] } + { + [ dup button-down? ] + [ + button-down-# button-value set + mouse-pressed-value on + button-down>> dup [ call ] [ drop ] if + t + ] + } + { + [ dup button-up? ] + [ + mouse-pressed-value off + drop + button-up>> dup [ call ] [ drop ] if + t + ] + } + { [ t ] [ 2drop t ] } + } + cond ; \ No newline at end of file diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index fc8103b656..ba02f15c7a 100755 --- a/extra/unix/process/process.factor +++ b/extra/unix/process/process.factor @@ -9,7 +9,7 @@ IN: unix.process ! io.launcher instead. : >argv ( seq -- alien ) - [ malloc-char-string ] map f add >c-void*-array ; + [ malloc-char-string ] map f suffix >c-void*-array ; : exec ( pathname argv -- int ) [ malloc-char-string ] [ >argv ] bi* execv ; diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor index 238ff18c39..acd3848f10 100755 --- a/extra/windows/com/syntax/syntax.factor +++ b/extra/windows/com/syntax/syntax.factor @@ -40,7 +40,7 @@ unless : (parse-com-function) ( tokens -- definition ) [ second ] [ first ] - [ 3 tail 2 group [ first ] map "void*" add* ] + [ 3 tail 2 group [ first ] map "void*" prefix ] tri ; diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor index 28237a7b2c..8c74d61656 100755 --- a/extra/xmode/rules/rules.factor +++ b/extra/xmode/rules/rules.factor @@ -113,7 +113,7 @@ M: regexp text-hash-char drop f ; : rule-chars* ( rule -- string ) dup rule-chars swap rule-start matcher-text - text-hash-char [ add ] when* ; + text-hash-char [ suffix ] when* ; : add-rule ( rule ruleset -- ) >r dup rule-chars* >upper swap diff --git a/extra/ldap/authors.txt b/unmaintained/ldap/authors.txt similarity index 100% rename from extra/ldap/authors.txt rename to unmaintained/ldap/authors.txt diff --git a/extra/ldap/conf/addentry.ldif b/unmaintained/ldap/conf/addentry.ldif similarity index 100% rename from extra/ldap/conf/addentry.ldif rename to unmaintained/ldap/conf/addentry.ldif diff --git a/extra/ldap/conf/createdit.ldif b/unmaintained/ldap/conf/createdit.ldif similarity index 100% rename from extra/ldap/conf/createdit.ldif rename to unmaintained/ldap/conf/createdit.ldif diff --git a/extra/ldap/conf/slapd.conf b/unmaintained/ldap/conf/slapd.conf similarity index 100% rename from extra/ldap/conf/slapd.conf rename to unmaintained/ldap/conf/slapd.conf diff --git a/extra/ldap/ldap-tests.factor b/unmaintained/ldap/ldap-tests.factor similarity index 100% rename from extra/ldap/ldap-tests.factor rename to unmaintained/ldap/ldap-tests.factor diff --git a/extra/ldap/ldap.factor b/unmaintained/ldap/ldap.factor similarity index 100% rename from extra/ldap/ldap.factor rename to unmaintained/ldap/ldap.factor diff --git a/extra/ldap/libldap/authors.txt b/unmaintained/ldap/libldap/authors.txt similarity index 100% rename from extra/ldap/libldap/authors.txt rename to unmaintained/ldap/libldap/authors.txt diff --git a/extra/ldap/libldap/libldap.factor b/unmaintained/ldap/libldap/libldap.factor similarity index 100% rename from extra/ldap/libldap/libldap.factor rename to unmaintained/ldap/libldap/libldap.factor diff --git a/extra/ldap/libldap/tags.txt b/unmaintained/ldap/libldap/tags.txt similarity index 100% rename from extra/ldap/libldap/tags.txt rename to unmaintained/ldap/libldap/tags.txt diff --git a/extra/ldap/summary.txt b/unmaintained/ldap/summary.txt similarity index 100% rename from extra/ldap/summary.txt rename to unmaintained/ldap/summary.txt diff --git a/extra/ldap/tags.txt b/unmaintained/ldap/tags.txt similarity index 100% rename from extra/ldap/tags.txt rename to unmaintained/ldap/tags.txt