From: John Benediktsson Date: Wed, 27 May 2009 05:20:53 +0000 (-0700) Subject: Resolved merge. X-Git-Tag: 0.97~6096^2~25^2~21 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=aa7d24eec68c71b54733cd32193203f11966bd34 Resolved merge. --- diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor index 5e3827efea..0505dcb184 100755 --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -69,7 +69,7 @@ nl "." write flush { - new-sequence nth push pop peek flip + new-sequence nth push pop last flip } compile-unoptimized "." write flush diff --git a/basis/checksums/hmac/hmac-tests.factor b/basis/checksums/hmac/hmac-tests.factor index ffae146614..70451252f7 100755 --- a/basis/checksums/hmac/hmac-tests.factor +++ b/basis/checksums/hmac/hmac-tests.factor @@ -6,43 +6,43 @@ IN: checksums.hmac.tests [ "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d" ] [ - 16 11 "Hi There" md5 hmac-bytes >string ] unit-test + "Hi There" 16 11 md5 hmac-bytes >string ] unit-test [ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ] -[ "Jefe" "what do ya want for nothing?" md5 hmac-bytes >string ] unit-test +[ "what do ya want for nothing?" "Jefe" md5 hmac-bytes >string ] unit-test [ "V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6" ] [ - 16 HEX: aa - 50 HEX: dd md5 hmac-bytes >string + 50 HEX: dd + 16 HEX: aa md5 hmac-bytes >string ] unit-test [ "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" ] [ - 16 11 "Hi There" sha1 hmac-bytes >string + "Hi There" 16 11 sha1 hmac-bytes >string ] unit-test [ "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y" ] [ - "Jefe" "what do ya want for nothing?" sha1 hmac-bytes >string + "what do ya want for nothing?" "Jefe" sha1 hmac-bytes >string ] unit-test [ "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb" ] [ - 16 HEX: aa - 50 HEX: dd sha1 hmac-bytes >string + 50 HEX: dd + 16 HEX: aa sha1 hmac-bytes >string ] unit-test [ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ] -[ 20 HEX: b "Hi There" sha-256 hmac-bytes hex-string ] unit-test +[ "Hi There" 20 HEX: b sha-256 hmac-bytes hex-string ] unit-test [ "167f928588c5cc2eef8e3093caa0e87c9ff566a14794aa61648d81621a2a40c6" ] [ - "JefeJefeJefeJefeJefeJefeJefeJefe" - "what do ya want for nothing?" sha-256 hmac-bytes hex-string + "what do ya want for nothing?" + "JefeJefeJefeJefeJefeJefeJefeJefe" sha-256 hmac-bytes hex-string ] unit-test diff --git a/basis/checksums/hmac/hmac.factor b/basis/checksums/hmac/hmac.factor index b163766016..9ec78248a1 100755 --- a/basis/checksums/hmac/hmac.factor +++ b/basis/checksums/hmac/hmac.factor @@ -13,27 +13,26 @@ IN: checksums.hmac : ipad ( checksum-state -- seq ) block-size>> HEX: 36 ; -:: init-K ( K checksum checksum-state -- o i ) - checksum-state block-size>> K length < - [ K checksum checksum-bytes ] [ K ] if +:: init-key ( checksum key checksum-state -- o i ) + checksum-state block-size>> key length < + [ key checksum checksum-bytes ] [ key ] if checksum-state block-size>> 0 pad-tail [ checksum-state opad seq-bitxor ] [ checksum-state ipad seq-bitxor ] bi ; PRIVATE> -:: hmac-stream ( K stream checksum -- value ) - K checksum dup initialize-checksum-state - dup :> checksum-state - init-K :> Ki :> Ko +:: hmac-stream ( stream key checksum -- value ) + checksum initialize-checksum-state :> checksum-state + checksum key checksum-state init-key :> Ki :> Ko checksum-state Ki add-checksum-bytes stream add-checksum-stream get-checksum checksum initialize-checksum-state Ko add-checksum-bytes swap add-checksum-bytes get-checksum ; -: hmac-file ( K path checksum -- value ) - [ binary ] dip hmac-stream ; +: hmac-file ( path key checksum -- value ) + [ binary ] 2dip hmac-stream ; -: hmac-bytes ( K seq checksum -- value ) - [ binary ] dip hmac-stream ; +: hmac-bytes ( seq key checksum -- value ) + [ binary ] 2dip hmac-stream ; diff --git a/basis/circular/circular.factor b/basis/circular/circular.factor index 909b2ed713..ae79e70d73 100644 --- a/basis/circular/circular.factor +++ b/basis/circular/circular.factor @@ -46,13 +46,13 @@ M: growing-circular length length>> ; : full? ( circular -- ? ) [ length ] [ seq>> length ] bi = ; -: set-peek ( elt seq -- ) +: set-last ( elt seq -- ) [ length 1- ] keep set-nth ; PRIVATE> : push-growing-circular ( elt circular -- ) dup full? [ push-circular ] - [ [ 1+ ] change-length set-peek ] if ; + [ [ 1+ ] change-length set-last ] if ; : ( capacity -- growing-circular ) { } new-sequence 0 0 growing-circular boa ; diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index ec8fe62dfb..2a9d2579e3 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor @@ -165,7 +165,7 @@ SYMBOL: heap-ac : record-constant-set-slot ( slot# vreg -- ) history [ - dup empty? [ dup peek store? [ dup pop* ] when ] unless + dup empty? [ dup last store? [ dup pop* ] when ] unless store new-action swap ?push ] change-at ; diff --git a/basis/compiler/cfg/intrinsics/allot/allot.factor b/basis/compiler/cfg/intrinsics/allot/allot.factor index 938dbbccbf..7b407c3ee4 100644 --- a/basis/compiler/cfg/intrinsics/allot/allot.factor +++ b/basis/compiler/cfg/intrinsics/allot/allot.factor @@ -19,7 +19,7 @@ IN: compiler.cfg.intrinsics.allot [ second ds-load ] [ ^^load-literal ] bi prefix ; : emit- ( node -- ) - dup node-input-infos peek literal>> + dup node-input-infos last literal>> dup array? [ nip ds-drop diff --git a/basis/compiler/cfg/iterator/iterator.factor b/basis/compiler/cfg/iterator/iterator.factor index 3444b517ac..a8958733a7 100644 --- a/basis/compiler/cfg/iterator/iterator.factor +++ b/basis/compiler/cfg/iterator/iterator.factor @@ -7,7 +7,7 @@ SYMBOL: node-stack : >node ( cursor -- ) node-stack get push ; : node> ( -- cursor ) node-stack get pop ; -: node@ ( -- cursor ) node-stack get peek ; +: node@ ( -- cursor ) node-stack get last ; : current-node ( -- node ) node@ first ; : iterate-next ( -- cursor ) node@ rest-slice ; : skip-next ( -- next ) node> rest-slice [ first ] [ >node ] bi ; diff --git a/basis/compiler/cfg/linear-scan/debugger/debugger.factor b/basis/compiler/cfg/linear-scan/debugger/debugger.factor index c6481b305e..dad87b62ae 100644 --- a/basis/compiler/cfg/linear-scan/debugger/debugger.factor +++ b/basis/compiler/cfg/linear-scan/debugger/debugger.factor @@ -23,7 +23,7 @@ IN: compiler.cfg.linear-scan.debugger [ split-children ] map concat check-assigned ; : picture ( uses -- str ) - dup peek 1 + CHAR: space + dup last 1 + CHAR: space [ '[ CHAR: * swap _ set-nth ] each ] keep ; : interval-picture ( interval -- str ) diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 4ddd1fdc0b..65b932c4a2 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -244,7 +244,7 @@ SYMBOL: max-uses swap int-regs swap vreg boa >>vreg max-uses get random 2 max [ not-taken ] replicate natural-sort [ >>uses ] [ first >>start ] bi - dup uses>> peek >>end + dup uses>> last >>end ] map ] with-scope ; diff --git a/basis/compiler/cfg/useless-blocks/useless-blocks.factor b/basis/compiler/cfg/useless-blocks/useless-blocks.factor index f543aa4036..05cb13748b 100644 --- a/basis/compiler/cfg/useless-blocks/useless-blocks.factor +++ b/basis/compiler/cfg/useless-blocks/useless-blocks.factor @@ -37,7 +37,7 @@ IN: compiler.cfg.useless-blocks : delete-conditional? ( bb -- ? ) dup instructions>> [ drop f ] [ - peek class { + last class { ##compare-branch ##compare-imm-branch ##compare-float-branch diff --git a/basis/compiler/tree/dead-code/branches/branches.factor b/basis/compiler/tree/dead-code/branches/branches.factor index eba82384ab..fd1b2d5adb 100644 --- a/basis/compiler/tree/dead-code/branches/branches.factor +++ b/basis/compiler/tree/dead-code/branches/branches.factor @@ -28,7 +28,7 @@ M: #branch remove-dead-code* : remove-phi-inputs ( #phi -- ) if-node get children>> - [ dup ends-with-terminate? [ drop f ] [ peek out-d>> ] if ] map + [ dup ends-with-terminate? [ drop f ] [ last out-d>> ] if ] map pad-with-bottom >>phi-in-d drop ; : live-value-indices ( values -- indices ) diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index d1a9f5215a..4fc4f4814b 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -191,7 +191,7 @@ SYMBOL: node-count propagate compute-def-use dup check-nodes - peek node-input-infos ; + last node-input-infos ; : final-classes ( quot -- seq ) final-info [ class>> ] map ; diff --git a/basis/compiler/tree/propagation/constraints/constraints.factor b/basis/compiler/tree/propagation/constraints/constraints.factor index 2652547aad..31f6cea148 100644 --- a/basis/compiler/tree/propagation/constraints/constraints.factor +++ b/basis/compiler/tree/propagation/constraints/constraints.factor @@ -83,7 +83,7 @@ TUPLE: implication p q ; C: --> implication : assume-implication ( p q -- ) - [ constraints get [ assoc-stack swap suffix ] 2keep peek set-at ] + [ constraints get [ assoc-stack swap suffix ] 2keep last set-at ] [ satisfied? [ assume ] [ drop ] if ] 2bi ; M: implication assume* diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 4d4b22218d..50762c2b66 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -259,12 +259,12 @@ SYMBOL: value-infos resolve-copy value-infos get assoc-stack null-info or ; : set-value-info ( info value -- ) - resolve-copy value-infos get peek set-at ; + resolve-copy value-infos get last set-at ; : refine-value-info ( info value -- ) resolve-copy value-infos get [ assoc-stack value-info-intersect ] 2keep - peek set-at ; + last set-at ; : value-literal ( value -- obj ? ) value-info >literal< ; @@ -294,10 +294,10 @@ SYMBOL: value-infos dup in-d>> first node-value-info literal>> ; : last-literal ( #call -- obj ) - dup out-d>> peek node-value-info literal>> ; + dup out-d>> last node-value-info literal>> ; : immutable-tuple-boa? ( #call -- ? ) dup word>> \ eq? [ - dup in-d>> peek node-value-info + dup in-d>> last node-value-info literal>> first immutable-tuple-class? ] [ drop f ] if ; diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index aba8dc9eda..9cb0e41291 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -197,7 +197,7 @@ IN: compiler.tree.propagation.tests { fixnum byte-array } declare [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe [ [ 298 * ] dip 100 * - ] dip 208 * - 128 + -8 shift - 255 min 0 max + 0 255 clamp ] final-classes ] unit-test @@ -210,7 +210,7 @@ IN: compiler.tree.propagation.tests ] unit-test [ V{ 1.5 } ] [ - [ /f 1.5 min 1.5 max ] final-literals + [ /f 1.5 1.5 clamp ] final-literals ] unit-test [ V{ 1.5 } ] [ @@ -693,4 +693,4 @@ TUPLE: circle me ; [ ] [ circle new dup >>me 1quotation final-info drop ] unit-test ! Joe found an oversight -[ V{ integer } ] [ [ >integer ] final-classes ] unit-test \ No newline at end of file +[ V{ integer } ] [ [ >integer ] final-classes ] unit-test diff --git a/basis/compiler/tree/tree.factor b/basis/compiler/tree/tree.factor index 9f9a43df64..c73f2211f0 100644 --- a/basis/compiler/tree/tree.factor +++ b/basis/compiler/tree/tree.factor @@ -169,7 +169,7 @@ M: #return-recursive inputs/outputs [ in-d>> ] [ out-d>> ] bi ; [ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix ; : ends-with-terminate? ( nodes -- ? ) - [ f ] [ peek #terminate? ] if-empty ; + [ f ] [ last #terminate? ] if-empty ; M: vector child-visitor V{ } clone ; M: vector #introduce, #introduce node, ; diff --git a/basis/core-text/fonts/fonts.factor b/basis/core-text/fonts/fonts.factor index 4525509d44..2656811c1f 100644 --- a/basis/core-text/fonts/fonts.factor +++ b/basis/core-text/fonts/fonts.factor @@ -82,7 +82,7 @@ CONSTANT: font-names } : font-name ( string -- string' ) - font-names at-default ; + font-names ?at drop ; : (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline diff --git a/basis/csv/csv.factor b/basis/csv/csv.factor index 5902999a76..23416d6912 100755 --- a/basis/csv/csv.factor +++ b/basis/csv/csv.factor @@ -63,7 +63,7 @@ PRIVATE> : csv ( stream -- rows ) [ [ (csv) ] { } make ] with-input-stream - dup peek { "" } = [ but-last ] when ; + dup last { "" } = [ but-last ] when ; : file>csv ( path encoding -- csv ) csv ; diff --git a/basis/documents/documents-tests.factor b/basis/documents/documents-tests.factor index b0ff3bc8d8..9f7f25c56e 100644 --- a/basis/documents/documents-tests.factor +++ b/basis/documents/documents-tests.factor @@ -120,7 +120,7 @@ namespaces tools.test make arrays kernel fry ; [ "Goodbye, cruel world." ] [ "d" get doc-string ] unit-test [ "" { 0 9 } { 0 15 } ] [ - "d" get undos>> peek + "d" get undos>> last [ old-string>> ] [ from>> ] [ new-to>> ] tri ] unit-test @@ -150,4 +150,4 @@ namespaces tools.test make arrays kernel fry ; [ ] [ "Hello world" "d" get set-doc-string ] unit-test -[ { "" } ] [ "value" get ] unit-test \ No newline at end of file +[ { "" } ] [ "value" get ] unit-test diff --git a/basis/documents/documents.factor b/basis/documents/documents.factor index 104dea6b98..cc2466053b 100644 --- a/basis/documents/documents.factor +++ b/basis/documents/documents.factor @@ -86,7 +86,7 @@ CONSTANT: doc-start { 0 0 } ] [ first swap length 1- + 0 ] if - ] dip peek length + 2array ; + ] dip last length + 2array ; : prepend-first ( str seq -- ) 0 swap [ append ] change-nth ; @@ -191,4 +191,4 @@ PRIVATE> [ undos>> ] [ redos>> ] [ undo-edit ] undo/redo ; : redo ( document -- ) - [ redos>> ] [ undos>> ] [ redo-edit ] undo/redo ; \ No newline at end of file + [ redos>> ] [ undos>> ] [ redo-edit ] undo/redo ; diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index a008b1d049..4acd1eeab8 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -149,15 +149,15 @@ DEFER: (parse-paragraph) : trim-row ( seq -- seq' ) rest - dup peek empty? [ but-last ] when ; + dup last empty? [ but-last ] when ; -: ?peek ( seq -- elt/f ) - [ f ] [ peek ] if-empty ; +: ?last ( seq -- elt/f ) + [ f ] [ last ] if-empty ; : coalesce ( rows -- rows' ) V{ } clone [ '[ - _ dup ?peek ?peek CHAR: \\ = + _ dup ?last ?last CHAR: \\ = [ [ pop "|" rot 3append ] keep ] when push ] each diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 397166a418..28a1f7dddb 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -76,7 +76,7 @@ MACRO: ncleave ( quots n -- ) MACRO: nspread ( quots n -- ) over empty? [ 2drop [ ] ] [ [ [ but-last ] dip ] - [ [ peek ] dip ] 2bi + [ [ last ] dip ] 2bi swap '[ [ _ _ nspread ] _ ndip @ ] ] if ; diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor index 65cb6541f4..f2ccaad1b4 100644 --- a/basis/heaps/heaps.factor +++ b/basis/heaps/heaps.factor @@ -76,7 +76,7 @@ M: heap heap-size ( heap -- n ) data>> pop* ; inline : data-peek ( heap -- entry ) - data>> peek ; inline + data>> last ; inline : data-first ( heap -- entry ) data>> first ; inline diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index 4a15f864a6..f8a4e6c15d 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -25,7 +25,7 @@ SYMBOL: vocab-articles [ (eval>string) ] call( code -- output ) "\n" ?tail drop ] keep - peek assert= + last assert= ] vocabs-quot get call( quot -- ) ; : check-examples ( element -- ) diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index db04033275..cfd6329b1d 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: parser words definitions kernel sequences assocs arrays -kernel.private fry combinators accessors vectors strings sbufs -byte-arrays byte-vectors io.binary io.streams.string splitting math -math.parser generic generic.single generic.standard classes -hashtables namespaces ; +USING: accessors arrays assocs byte-arrays byte-vectors classes +combinators definitions fry generic generic.single +generic.standard hashtables io.binary io.streams.string kernel +kernel.private math math.parser namespaces parser sbufs +sequences splitting splitting.private strings vectors words ; IN: hints GENERIC: specializer-predicate ( spec -- quot ) @@ -77,7 +77,7 @@ SYNTAX: HINTS: { first first2 first3 first4 } [ { array } "specializer" set-word-prop ] each -{ peek pop* pop } [ +{ last pop* pop } [ { vector } "specializer" set-word-prop ] each diff --git a/basis/http/parsers/parsers.factor b/basis/http/parsers/parsers.factor index 1810617c56..1a80236817 100644 --- a/basis/http/parsers/parsers.factor +++ b/basis/http/parsers/parsers.factor @@ -142,7 +142,7 @@ PEG: parse-header-line ( string -- pair ) 'space' , 'attr' , 'space' , - [ "=" token , 'space' , 'value' , ] seq* [ peek ] action optional , + [ "=" token , 'space' , 'value' , ] seq* [ last ] action optional , 'space' , ] seq* ; diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor index 8cab5b5ad3..82c2487f67 100644 --- a/basis/inspector/inspector.factor +++ b/basis/inspector/inspector.factor @@ -91,7 +91,7 @@ PRIVATE> : &back ( -- ) inspector-stack get - dup length 1 <= [ drop ] [ [ pop* ] [ peek reinspect ] bi ] if ; + dup length 1 <= [ drop ] [ [ pop* ] [ last reinspect ] bi ] if ; : &add ( value key -- ) mirror get set-at &push reinspect ; diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor index 7690b34410..cf97a0b2c8 100755 --- a/basis/inverse/inverse.factor +++ b/basis/inverse/inverse.factor @@ -220,7 +220,7 @@ DEFER: __ \ first4 [ 4array ] define-inverse \ prefix \ unclip define-dual -\ suffix [ dup but-last swap peek ] define-inverse +\ suffix [ dup but-last swap last ] define-inverse \ append 1 [ [ ?tail assure ] curry ] define-pop-inverse \ prepend 1 [ [ ?head assure ] curry ] define-pop-inverse diff --git a/basis/lcs/lcs.factor b/basis/lcs/lcs.factor index d32b199873..ab4fbd60bb 100644 --- a/basis/lcs/lcs.factor +++ b/basis/lcs/lcs.factor @@ -34,7 +34,7 @@ PRIVATE> : levenshtein ( old new -- n ) [ levenshtein-initialize ] [ levenshtein-step ] - run-lcs peek peek ; + run-lcs last last ; TUPLE: retain item ; TUPLE: delete item ; diff --git a/basis/logging/parser/parser.factor b/basis/logging/parser/parser.factor index 5406d8fcd0..dbc26c7efc 100644 --- a/basis/logging/parser/parser.factor +++ b/basis/logging/parser/parser.factor @@ -66,7 +66,7 @@ PEG: parse-log-line ( string -- entry ) 'log-line' ; building get empty? [ "Warning: log begins with multiline entry" print drop ] [ - message>> first building get peek message>> push + message>> first building get last message>> push ] if ; : parse-log ( lines -- entries ) diff --git a/basis/math/bits/bits-tests.factor b/basis/math/bits/bits-tests.factor index ed4e8419c9..b17d9d8b6e 100644 --- a/basis/math/bits/bits-tests.factor +++ b/basis/math/bits/bits-tests.factor @@ -23,9 +23,9 @@ IN: math.bits.tests ] unit-test [ t ] [ - 1067811677921310779 make-bits peek + 1067811677921310779 make-bits last ] unit-test [ t ] [ - 1067811677921310779 >bignum make-bits peek -] unit-test \ No newline at end of file + 1067811677921310779 >bignum make-bits last +] unit-test diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index 48da8aa6ec..41800e46da 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -23,9 +23,10 @@ ARTICLE: "arithmetic-functions" "Arithmetic functions" "Incrementing, decrementing:" { $subsection 1+ } { $subsection 1- } -"Minimum, maximum:" +"Minimum, maximum, clamping:" { $subsection min } { $subsection max } +{ $subsection clamp } "Complex conjugation:" { $subsection conjugate } "Tests:" diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor index fd6eda4a90..0de18b6feb 100644 --- a/basis/math/polynomials/polynomials.factor +++ b/basis/math/polynomials/polynomials.factor @@ -48,7 +48,7 @@ PRIVATE> : /-last ( seq seq -- a ) #! divide the last two numbers in the sequences - [ peek ] bi@ / ; + [ last ] bi@ / ; : (p/mod) ( p p -- p p ) 2dup /-last diff --git a/basis/math/ranges/ranges-docs.factor b/basis/math/ranges/ranges-docs.factor index e35adb10e5..59053a4c02 100644 --- a/basis/math/ranges/ranges-docs.factor +++ b/basis/math/ranges/ranges-docs.factor @@ -1,5 +1,4 @@ USING: help.syntax help.markup arrays sequences ; - IN: math.ranges ARTICLE: "math.ranges" "Numeric ranges" @@ -24,4 +23,4 @@ $nl { $code "100 1 [a,b] product" } "A range can be converted into a concrete sequence using a word such as " { $link >array } ". In most cases this is unnecessary since ranges implement the sequence protocol already. It is necessary if a mutable sequence is needed, for use with words such as " { $link set-nth } " or " { $link change-each } "." ; -ABOUT: "math.ranges" \ No newline at end of file +ABOUT: "math.ranges" diff --git a/basis/math/ranges/ranges-tests.factor b/basis/math/ranges/ranges-tests.factor index aedd2f7933..e314f72c6b 100644 --- a/basis/math/ranges/ranges-tests.factor +++ b/basis/math/ranges/ranges-tests.factor @@ -22,17 +22,6 @@ IN: math.ranges.tests [ { 0 1/3 2/3 1 } ] [ 0 1 1/3 >array ] unit-test [ { 0 1/3 2/3 1 } ] [ 1 0 -1/3 >array reverse ] unit-test -[ t ] [ 5 [0,b] range-increasing? ] unit-test -[ f ] [ 5 [0,b] range-decreasing? ] unit-test -[ f ] [ -5 [0,b] range-increasing? ] unit-test -[ t ] [ -5 [0,b] range-decreasing? ] unit-test -[ 0 ] [ 5 [0,b] range-min ] unit-test -[ 5 ] [ 5 [0,b] range-max ] unit-test -[ 3 ] [ 3 5 [0,b] clamp-to-range ] unit-test -[ 0 ] [ -1 5 [0,b] clamp-to-range ] unit-test -[ 5 ] [ 6 5 [0,b] clamp-to-range ] unit-test -[ { 0 1 2 3 4 } ] [ 5 sequence-index-range >array ] unit-test - [ 100 ] [ 1 100 [a,b] [ 2^ [1,b] ] map prune length -] unit-test \ No newline at end of file +] unit-test diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index 883be006dc..d28afa1413 100644 --- a/basis/math/ranges/ranges.factor +++ b/basis/math/ranges/ranges.factor @@ -26,12 +26,16 @@ M: range hashcode* tuple-hashcode ; INSTANCE: range immutable-sequence + -1 1 ? ; inline : (a, ( a b step -- a' b' step ) dup [ + ] curry 2dip ; inline : ,b) ( a b step -- a' b' step ) dup [ - ] curry dip ; inline +PRIVATE> + : [a,b] ( a b -- range ) twiddle ; inline : (a,b] ( a b -- range ) twiddle (a, ; inline @@ -45,24 +49,3 @@ INSTANCE: range immutable-sequence : [1,b] ( b -- range ) 1 swap [a,b] ; inline : [0,b) ( b -- range ) 0 swap [a,b) ; inline - -: range-increasing? ( range -- ? ) - step>> 0 > ; - -: range-decreasing? ( range -- ? ) - step>> 0 < ; - -: first-or-peek ( seq head? -- elt ) - [ first ] [ peek ] if ; - -: range-min ( range -- min ) - dup range-increasing? first-or-peek ; - -: range-max ( range -- max ) - dup range-decreasing? first-or-peek ; - -: clamp-to-range ( n range -- n ) - [ range-min max ] [ range-max min ] bi ; - -: sequence-index-range ( seq -- range ) - length [0,b) ; diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor index c160d57db7..32ebcbc6a1 100644 --- a/basis/math/statistics/statistics-tests.factor +++ b/basis/math/statistics/statistics-tests.factor @@ -13,6 +13,9 @@ IN: math.statistics.tests [ 2 ] [ { 1 2 3 } median ] unit-test [ 5/2 ] [ { 1 2 3 4 } median ] unit-test +[ 1 ] [ { 1 } mode ] unit-test +[ 3 ] [ { 1 2 3 3 3 4 5 6 76 7 2 21 1 3 3 3 } mode ] unit-test + [ { } median ] must-fail [ { } upper-median ] must-fail [ { } lower-median ] must-fail diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index 3812e79ec5..a1a214b2c0 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays combinators kernel math math.analysis math.functions math.order sequences sorting locals -sequences.private ; +sequences.private assocs fry ; IN: math.statistics : mean ( seq -- x ) @@ -56,6 +56,13 @@ IN: math.statistics : median ( seq -- x ) dup length odd? [ lower-median ] [ medians + 2 / ] if ; +: frequency ( seq -- hashtable ) + H{ } clone [ '[ _ inc-at ] each ] keep ; + +: mode ( seq -- x ) + frequency >alist + [ ] [ [ [ second ] bi@ > ] 2keep ? ] map-reduce first ; + : minmax ( seq -- min max ) #! find the min and max of a seq in one pass [ 1/0. -1/0. ] dip [ [ min ] [ max ] bi-curry bi* ] each ; diff --git a/basis/models/models.factor b/basis/models/models.factor index 4f7aafe3e3..19b478eaf9 100644 --- a/basis/models/models.factor +++ b/basis/models/models.factor @@ -109,5 +109,4 @@ GENERIC: set-range-min-value ( value model -- ) GENERIC: set-range-max-value ( value model -- ) : clamp-value ( value range -- newvalue ) - [ range-min-value max ] keep - range-max-value* min ; + [ range-min-value ] [ range-max-value* ] bi clamp ; diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index f3d555d5a1..4b2eca69b4 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -370,7 +370,7 @@ SYMBOL: ignore-ws ] bind ; M: ebnf (transform) ( ast -- parser ) - rules>> [ (transform) ] map peek ; + rules>> [ (transform) ] map last ; M: ebnf-tokenizer (transform) ( ast -- parser ) elements>> dup "default" = [ diff --git a/basis/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor index ae33b7c39a..5927171aa3 100644 --- a/basis/persistent/vectors/vectors.factor +++ b/basis/persistent/vectors/vectors.factor @@ -70,7 +70,7 @@ M: persistent-vector nth-unsafe dup level>> 1 = [ new-child ] [ - tuck children>> peek (ppush-new-tail) + tuck children>> last (ppush-new-tail) [ swap new-child ] [ swap node-set-last f ] ?if ] if ; @@ -127,13 +127,13 @@ M: persistent-vector new-nth ( obj i pvec -- pvec' ) : ppop-contraction ( node -- node' tail' ) dup children>> length 1 = - [ children>> peek f swap ] + [ children>> last f swap ] [ (ppop-contraction) ] if ; : (ppop-new-tail) ( root -- root' tail' ) dup level>> 1 > [ - dup children>> peek (ppop-new-tail) [ + dup children>> last (ppop-new-tail) [ dup [ swap node-set-last ] [ drop ppop-contraction drop ] diff --git a/basis/porter-stemmer/porter-stemmer.factor b/basis/porter-stemmer/porter-stemmer.factor index b6eb0ff464..35ed84aaf4 100644 --- a/basis/porter-stemmer/porter-stemmer.factor +++ b/basis/porter-stemmer/porter-stemmer.factor @@ -52,7 +52,7 @@ USING: kernel math parser sequences combinators splitting ; : consonant-end? ( n seq -- ? ) [ length swap - ] keep consonant? ; -: last-is? ( str possibilities -- ? ) [ peek ] dip member? ; +: last-is? ( str possibilities -- ? ) [ last ] dip member? ; : cvc? ( str -- ? ) { @@ -67,7 +67,7 @@ USING: kernel math parser sequences combinators splitting ; pick consonant-seq 0 > [ nip ] [ drop ] if append ; : step1a ( str -- newstr ) - dup peek CHAR: s = [ + dup last CHAR: s = [ { { [ "sses" ?tail ] [ "ss" append ] } { [ "ies" ?tail ] [ "i" append ] } @@ -199,13 +199,13 @@ USING: kernel math parser sequences combinators splitting ; [ 1 = [ but-last-slice cvc? not ] [ drop f ] if ] if ; : remove-e ( str -- newstr ) - dup peek CHAR: e = [ + dup last CHAR: e = [ dup remove-e? [ but-last-slice ] when ] when ; : ll->l ( str -- newstr ) { - { [ dup peek CHAR: l = not ] [ ] } + { [ dup last CHAR: l = not ] [ ] } { [ dup length 1- over double-consonant? not ] [ ] } { [ dup consonant-seq 1 > ] [ but-last-slice ] } [ ] diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor index b4eb40757d..0e0c7afb82 100644 --- a/basis/prettyprint/sections/sections.factor +++ b/basis/prettyprint/sections/sections.factor @@ -153,7 +153,7 @@ TUPLE: block < section sections ; : ( style -- block ) block new-block ; -: pprinter-block ( -- block ) pprinter-stack get peek ; +: pprinter-block ( -- block ) pprinter-stack get last ; : add-section ( section -- ) pprinter-block sections>> push ; @@ -292,7 +292,7 @@ M: colon unindent-first-line? drop t ; ! Long section layout algorithm : chop-break ( seq -- seq ) - dup peek line-break? [ but-last-slice chop-break ] when ; + dup last line-break? [ but-last-slice chop-break ] when ; SYMBOL: prev SYMBOL: next @@ -317,7 +317,7 @@ SYMBOL: next ] { } make { t } split harvest ; : break-group? ( seq -- ? ) - [ first section-fits? ] [ peek section-fits? not ] bi and ; + [ first section-fits? ] [ last section-fits? not ] bi and ; : ?break-group ( seq -- ) dup break-group? [ first latin2 encode >quoted ] unit-test [ 1 ] [ message >quoted string-lines length ] unit-test [ t ] [ message >quoted-lines "=\r\n" swap subseq? ] unit-test [ 4 ] [ message >quoted-lines string-lines length ] unit-test -[ "===o" ] [ message >quoted-lines string-lines [ peek ] "" map-as ] unit-test +[ "===o" ] [ message >quoted-lines string-lines [ last ] "" map-as ] unit-test diff --git a/basis/quoting/quoting.factor b/basis/quoting/quoting.factor index 5b09347c8c..86d8183ac6 100644 --- a/basis/quoting/quoting.factor +++ b/basis/quoting/quoting.factor @@ -9,8 +9,8 @@ IN: quoting { [ length 1 > ] [ first quote? ] - [ [ first ] [ peek ] bi = ] + [ [ first ] [ last ] bi = ] } 1&& ; : unquote ( str -- newstr ) - dup quoted? [ but-last-slice rest-slice >string ] when ; \ No newline at end of file + dup quoted? [ but-last-slice rest-slice >string ] when ; diff --git a/basis/sorting/human/human-tests.factor b/basis/sorting/human/human-tests.factor index 20a607188c..68ddf8c3c9 100644 --- a/basis/sorting/human/human-tests.factor +++ b/basis/sorting/human/human-tests.factor @@ -1,4 +1,14 @@ -USING: sorting.human tools.test sorting.slots ; +USING: sorting.human tools.test sorting.slots sorting ; IN: sorting.human.tests -[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test +[ { "x1y" "x2" "x10y" } ] +[ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test + +[ { "4dup" "nip" } ] +[ { "4dup" "nip" } [ human<=> ] sort ] unit-test + +[ { "4dup" "nip" } ] +[ { "nip" "4dup" } [ human<=> ] sort ] unit-test + +[ { "4dup" "4nip" "5drop" "nip" "nip2" "nipd" } ] +[ { "nip" "4dup" "4nip" "5drop" "nip2" "nipd" } [ human<=> ] sort ] unit-test diff --git a/basis/sorting/human/human.factor b/basis/sorting/human/human.factor index b3dae45a9b..7487f559ed 100644 --- a/basis/sorting/human/human.factor +++ b/basis/sorting/human/human.factor @@ -1,9 +1,21 @@ ! Copyright (C) 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: math.parser peg.ebnf sorting.functor ; +USING: accessors kernel math math.order math.parser peg.ebnf +sequences sorting.functor ; IN: sorting.human : find-numbers ( string -- seq ) [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ; -<< "human" [ find-numbers ] define-sorting >> +! For comparing integers or sequences +TUPLE: hybrid obj ; + +M: hybrid <=> + [ obj>> ] bi@ + 2dup [ integer? ] bi@ xor [ + drop integer? [ +lt+ ] [ +gt+ ] if + ] [ + <=> + ] if ; + +<< "human" [ find-numbers [ hybrid boa ] map ] define-sorting >> diff --git a/basis/sorting/title/title-tests.factor b/basis/sorting/title/title-tests.factor index 65a58e463d..1e978838c5 100644 --- a/basis/sorting/title/title-tests.factor +++ b/basis/sorting/title/title-tests.factor @@ -8,6 +8,9 @@ IN: sorting.title.tests "The Beatles" "A river runs through it" "Another" + "The" + "A" + "Los" "la vida loca" "Basketball" "racquetball" @@ -21,6 +24,7 @@ IN: sorting.title.tests } ; [ { + "A" "Another" "Basketball" "The Beatles" @@ -29,10 +33,12 @@ IN: sorting.title.tests "for the horde" "Los Fujis" "los Fujis" + "Los" "of mice and men" "on belay" "racquetball" "A river runs through it" + "The" "la vida loca" } ] [ diff --git a/basis/sorting/title/title.factor b/basis/sorting/title/title.factor index dbdbf8a8fb..b9a46c41fc 100644 --- a/basis/sorting/title/title.factor +++ b/basis/sorting/title/title.factor @@ -4,4 +4,7 @@ USING: sorting.functor regexp kernel accessors sequences unicode.case ; IN: sorting.title -<< "title" [ >lower dup R/ ^(the|a|an|el|la|los|las|il) / first-match [ to>> tail-slice ] when* ] define-sorting >> +<< "title" [ + >lower dup R/ ^(the|a|an|el|la|los|las|il) / first-match + [ to>> tail-slice ] when* +] define-sorting >> diff --git a/basis/splitting/monotonic/monotonic.factor b/basis/splitting/monotonic/monotonic.factor index 2e2ac74e30..088de52766 100644 --- a/basis/splitting/monotonic/monotonic.factor +++ b/basis/splitting/monotonic/monotonic.factor @@ -6,9 +6,9 @@ IN: splitting.monotonic quot diff --git a/basis/tools/completion/completion.factor b/basis/tools/completion/completion.factor index 00d86a1608..c8fd3a6658 100644 --- a/basis/tools/completion/completion.factor +++ b/basis/tools/completion/completion.factor @@ -24,7 +24,7 @@ IN: tools.completion 2dup number= [ drop ] [ nip V{ } clone pick push ] if 1+ - ] keep pick peek push + ] keep pick last push ] each ; : runs ( seq -- newseq ) @@ -78,4 +78,4 @@ IN: tools.completion all-vocabs-seq name-completions ; : chars-matching ( str -- seq ) - name-map keys dup zip completions ; \ No newline at end of file + name-map keys dup zip completions ; diff --git a/basis/tools/hexdump/hexdump-tests.factor b/basis/tools/hexdump/hexdump-tests.factor index 1a8ed35510..75537b0c11 100644 --- a/basis/tools/hexdump/hexdump-tests.factor +++ b/basis/tools/hexdump/hexdump-tests.factor @@ -4,7 +4,7 @@ IN: tools.hexdump.tests [ t ] [ B{ } hexdump "Length: 0, 0h\n" = ] unit-test [ t ] [ "abcdefghijklmnopqrstuvwxyz" >byte-array hexdump "Length: 26, 1ah\n00000000h: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop\n00000010h: 71 72 73 74 75 76 77 78 79 7a qrstuvwxyz\n" = ] unit-test -[ t ] [ 256 [ ] B{ } map-as hexdump "Length: 256, 100h\n00000000h: 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f ................\n00000010h: 10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f ................\n00000020h: 20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f !\"#$%&'()*+,-./\n00000030h: 30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f 0123456789:;<=>?\n00000040h: 40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f @ABCDEFGHIJKLMNO\n00000050h: 50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f PQRSTUVWXYZ[\\]^_\n00000060h: 60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f `abcdefghijklmno\n00000070h: 70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f pqrstuvwxyz{|}~.\n00000080h: 80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f ................\n00000090h: 90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f ................\n000000a0h: a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af ................\n000000b0h: b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf ................\n000000c0h: c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf ................\n000000d0h: d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df ................\n000000e0h: e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef ................\n000000f0h: f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff ................\n" = ] unit-test +[ t ] [ 256 iota [ ] B{ } map-as hexdump "Length: 256, 100h\n00000000h: 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f ................\n00000010h: 10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f ................\n00000020h: 20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f !\"#$%&'()*+,-./\n00000030h: 30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f 0123456789:;<=>?\n00000040h: 40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f @ABCDEFGHIJKLMNO\n00000050h: 50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f PQRSTUVWXYZ[\\]^_\n00000060h: 60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f `abcdefghijklmno\n00000070h: 70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f pqrstuvwxyz{|}~.\n00000080h: 80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f ................\n00000090h: 90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f ................\n000000a0h: a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af ................\n000000b0h: b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf ................\n000000c0h: c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf ................\n000000d0h: d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df ................\n000000e0h: e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef ................\n000000f0h: f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff ................\n" = ] unit-test [ diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index b6c9b43271..aa84ee43c5 100755 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -83,7 +83,7 @@ M: pasteboard set-clipboard-contents dup { 0 0 } = [ drop windows get length 1 <= [ -> center ] [ - windows get peek second window-loc>> + windows get last second window-loc>> dupd first2 -> cascadeTopLeftFromPoint: -> setFrameTopLeftPoint: ] if diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 1ad3931746..79db087220 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -59,7 +59,7 @@ SYMBOL: locale ! Just casing locale, or overall? : fix-sigma-end ( string -- string ) [ "" ] [ - dup peek CHAR: greek-small-letter-sigma = + dup last CHAR: greek-small-letter-sigma = [ 1 head* CHAR: greek-small-letter-final-sigma suffix ] when ] if-empty ; inline diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index f8beca3c60..5cab884b3c 100755 --- a/basis/unicode/collation/collation.factor +++ b/basis/unicode/collation/collation.factor @@ -63,13 +63,13 @@ ducet insert-helpers [ drop { } ] [ [ AAAA ] [ BBBB ] bi 2array ] if ; -: last ( -- char ) - building get empty? [ 0 ] [ building get peek peek ] if ; +: building-last ( -- char ) + building get empty? [ 0 ] [ building get last last ] if ; : blocked? ( char -- ? ) combining-class dup { 0 f } member? - [ drop last non-starter? ] - [ last combining-class = ] if ; + [ drop building-last non-starter? ] + [ building-last combining-class = ] if ; : possible-bases ( -- slice-of-building ) building get dup [ first non-starter? not ] find-last diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index 318a56627b..1c6c6afdf3 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -33,9 +33,9 @@ VALUE: name-map : name>char ( name -- char ) name-map at ; inline : char>name ( char -- name ) name-map value-at ; inline : property? ( char property -- ? ) properties at interval-key? ; inline -: ch>lower ( ch -- lower ) simple-lower at-default ; inline -: ch>upper ( ch -- upper ) simple-upper at-default ; inline -: ch>title ( ch -- title ) simple-title at-default ; inline +: ch>lower ( ch -- lower ) simple-lower ?at drop ; inline +: ch>upper ( ch -- upper ) simple-upper ?at drop ; inline +: ch>title ( ch -- title ) simple-title ?at drop ; inline : special-case ( ch -- casing-tuple ) special-casing at ; inline ! For non-existent characters, use Cn diff --git a/basis/vlists/vlists-tests.factor b/basis/vlists/vlists-tests.factor index 3546051364..6df942eb84 100644 --- a/basis/vlists/vlists-tests.factor +++ b/basis/vlists/vlists-tests.factor @@ -16,7 +16,7 @@ IN: vlists.tests [ "foo" VL{ "hi" "there" } t ] [ VL{ "hi" "there" "foo" } dup "v" set - [ peek ] [ ppop ] bi + [ last ] [ ppop ] bi dup "v" get [ vector>> ] bi@ eq? ] unit-test diff --git a/basis/windows/fonts/fonts.factor b/basis/windows/fonts/fonts.factor index 1753ff1ce1..269e8f8f48 100755 --- a/basis/windows/fonts/fonts.factor +++ b/basis/windows/fonts/fonts.factor @@ -7,7 +7,7 @@ IN: windows.fonts { "sans-serif" "Tahoma" } { "serif" "Times New Roman" } { "monospace" "Courier New" } - } at-default ; + } ?at drop ; MEMO:: (cache-font) ( font -- HFONT ) font size>> neg ! nHeight diff --git a/basis/xml/xml.factor b/basis/xml/xml.factor index 9df7165e6c..cca1b5e2e0 100755 --- a/basis/xml/xml.factor +++ b/basis/xml/xml.factor @@ -11,7 +11,7 @@ IN: xml assoc } { $subsection assoc>map } { $subsection assoc-map-as } ; @@ -236,6 +238,13 @@ HELP: assoc-filter-as { assoc-filter assoc-filter-as } related-words +HELP: assoc-partition +{ $values + { "assoc" assoc } { "quot" quotation } + { "true-assoc" assoc } { "false-assoc" assoc } +} +{ $description "Calls a predicate quotation on each key of the input assoc. If the test yields true, the key/value pair is added to " { $snippet "true-assoc" } "; if false, it's added to " { $snippet "false-assoc" } "." } ; + HELP: assoc-any? { $values { "assoc" assoc } { "quot" { $quotation "( key value -- ? )" } } { "?" "a boolean" } } { $description "Tests if the assoc contains an entry satisfying a predicate by applying the quotation to each entry in turn. Iteration stops if an entry is found for which the quotation outputs a true value." } ; @@ -331,7 +340,12 @@ HELP: substitute HELP: cache { $values { "key" "a key" } { "assoc" assoc } { "quot" { $quotation "( key -- value )" } } { "value" "a previously-retained or freshly-computed value" } } -{ $description "If the key is present in the assoc, outputs the associated value, otherwise calls the quotation to produce a value and stores the key/value pair into the assoc." } +{ $description "If the key is present in the assoc, outputs the associated value, otherwise calls the quotation to produce a value and stores the key/value pair into the assoc. Returns a value either looked up or newly stored in the assoc." } +{ $side-effects "assoc" } ; + +HELP: 2cache +{ $values { "key1" "a key" } { "key2" "a key" } { "assoc" assoc } { "quot" { $quotation "( key -- value )" } } { "value" "a previously-retained or freshly-computed value" } } +{ $description "If a single key composed of the input keys is present in the assoc, outputs the associated value, otherwise calls the quotation to produce a value and stores the keys/value pair into the assoc. Returns the value stored in the assoc. Returns a value either looked up or newly stored in the assoc." } { $side-effects "assoc" } ; HELP: map>assoc diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor index fc74df6d45..c473ac0dfa 100644 --- a/core/assocs/assocs-tests.factor +++ b/core/assocs/assocs-tests.factor @@ -119,18 +119,6 @@ unit-test } extract-keys ] unit-test -[ f ] [ - "a" H{ { "a" f } } at-default -] unit-test - -[ "b" ] [ - "b" H{ { "a" f } } at-default -] unit-test - -[ "x" ] [ - "a" H{ { "a" "x" } } at-default -] unit-test - [ H{ { "b" [ 2 ] } { "d" [ 4 ] } } H{ { "a" [ 1 ] } { "c" [ 3 ] } } ] [ H{ { "a" [ 1 ] } diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index e783ef81c4..d655b99c30 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -82,9 +82,6 @@ PRIVATE> : at ( key assoc -- value/f ) at* drop ; inline -: at-default ( key assoc -- value/key ) - ?at drop ; inline - M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) [ dup assoc-size ] dip new-assoc [ [ set-at ] with-assoc assoc-each ] keep ; diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index c774ef1c1d..3c39848d02 100755 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -215,7 +215,7 @@ M: anonymous-complement (classes-intersect?) : min-class ( class seq -- class/f ) over [ classes-intersect? ] curry filter [ drop f ] [ - [ nip ] [ [ class<= ] with all? ] 2bi [ peek ] [ drop f ] if + [ nip ] [ [ class<= ] with all? ] 2bi [ last ] [ drop f ] if ] if-empty ; GENERIC: (flatten-class) ( class -- ) diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor index aae6618ee8..b239b1eac9 100755 --- a/core/combinators/combinators-tests.factor +++ b/core/combinators/combinators-tests.factor @@ -1,6 +1,6 @@ USING: alien strings kernel math tools.test io prettyprint namespaces combinators words classes sequences accessors -math.functions arrays ; +math.functions arrays combinators.private ; IN: combinators.tests [ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index 7bf76fea30..f293030f25 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -101,6 +101,8 @@ ERROR: no-case object ; [ \ drop prefix ] bi* ] assoc-map alist>quot ; + + : case>quot ( default assoc -- quot ) dup keys { { [ dup empty? ] [ 2drop ] } @@ -160,7 +164,6 @@ ERROR: no-case object ; [ drop linear-case-quot ] } cond ; -! recursive-hashcode : recursive-hashcode ( n obj quot -- code ) pick 0 <= [ 3drop 0 ] [ [ 1 - ] 2dip call ] if ; inline diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index 7681c2b089..8e14f4a26b 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -152,7 +152,7 @@ ERROR: attempt-all-error ; ] [ [ [ [ , f ] compose [ , drop t ] recover ] curry all? - ] { } make peek swap [ rethrow ] when + ] { } make last swap [ rethrow ] when ] if ; inline TUPLE: condition error restarts continuation ; diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index afc956fae4..9a470d53c1 100644 --- a/core/destructors/destructors.factor +++ b/core/destructors/destructors.factor @@ -21,7 +21,7 @@ M: object dispose : dispose-each ( seq -- ) [ [ [ dispose ] curry [ , ] recover ] each - ] { } make [ peek rethrow ] unless-empty ; + ] { } make [ last rethrow ] unless-empty ; : with-disposal ( object quot -- ) over [ dispose ] curry [ ] cleanup ; inline diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor index c96050ad03..e88c0c02e4 100644 --- a/core/generic/math/math.factor +++ b/core/generic/math/math.factor @@ -15,7 +15,7 @@ PREDICATE: math-class < class quot picker prepend define-predicate-engine ] if-empty ; + [ last ] [ alist>quot picker prepend define-predicate-engine ] if-empty ; M: predicate-engine compile-engine [ compile-predicate-engine ] [ class>> ] bi diff --git a/core/math/order/order-docs.factor b/core/math/order/order-docs.factor index 8b2200aa67..368d060eb9 100644 --- a/core/math/order/order-docs.factor +++ b/core/math/order/order-docs.factor @@ -51,6 +51,10 @@ HELP: min { $values { "x" real } { "y" real } { "z" real } } { $description "Outputs the smallest of two real numbers." } ; +HELP: clamp +{ $values { "x" real } { "min" real } { "max" real } { "y" real } } +{ $description "Outputs " { $snippet "x" } " if contained in the interval " { $snippet "[min,max]" } " or outputs one of the endpoints." } ; + HELP: between? { $values { "x" real } { "y" real } { "z" real } { "?" "a boolean" } } { $description "Tests if " { $snippet "x" } " is in the interval " { $snippet "[y,z]" } "." } @@ -105,6 +109,7 @@ ARTICLE: "math.order" "Linear order protocol" { $subsection "order-specifiers" } "Utilities for comparing objects:" { $subsection after? } +{ $subsection after? } { $subsection before? } { $subsection after=? } { $subsection before=? } diff --git a/core/math/order/order-tests.factor b/core/math/order/order-tests.factor index 665537be5d..edd50d3f55 100644 --- a/core/math/order/order-tests.factor +++ b/core/math/order/order-tests.factor @@ -7,3 +7,6 @@ IN: math.order.tests [ +eq+ ] [ 4 4 <=> ] unit-test [ +gt+ ] [ 4 3 <=> ] unit-test +[ 20 ] [ 20 0 100 clamp ] unit-test +[ 0 ] [ -20 0 100 clamp ] unit-test +[ 100 ] [ 120 0 100 clamp ] unit-test diff --git a/core/math/order/order.factor b/core/math/order/order.factor index a06209bf63..435eec9b96 100644 --- a/core/math/order/order.factor +++ b/core/math/order/order.factor @@ -34,6 +34,7 @@ M: real after=? ( obj1 obj2 -- ? ) >= ; : min ( x y -- z ) [ before? ] most ; inline : max ( x y -- z ) [ after? ] most ; inline +: clamp ( x min max -- y ) [ max ] dip min ; inline : between? ( x y z -- ? ) pick after=? [ after=? ] [ 2drop f ] if ; inline diff --git a/core/namespaces/namespaces.factor b/core/namespaces/namespaces.factor index 64cc328d19..9428445d26 100644 --- a/core/namespaces/namespaces.factor +++ b/core/namespaces/namespaces.factor @@ -12,7 +12,7 @@ IN: namespaces PRIVATE> -: namespace ( -- namespace ) namestack* peek ; inline +: namespace ( -- namespace ) namestack* last ; inline : namestack ( -- namestack ) namestack* clone ; : set-namestack ( namestack -- ) >vector 0 setenv ; : global ( -- g ) 21 getenv { hashtable } declare ; inline diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index b6cfface12..927a404519 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -546,12 +546,12 @@ HELP: join { join concat concat-as } related-words -HELP: peek +HELP: last { $values { "seq" sequence } { "elt" object } } { $description "Outputs the last element of a sequence." } { $errors "Throws an error if the sequence is empty." } ; -{ peek pop pop* } related-words +{ pop pop* } related-words HELP: pop* { $values { "seq" "a resizable mutable sequence" } } @@ -1378,11 +1378,13 @@ ARTICLE: "sequences-access" "Accessing sequence elements" { $subsection second } { $subsection third } { $subsection fourth } +"Extracting the last element:" +{ $subsection last } "Unpacking sequences:" { $subsection first2 } { $subsection first3 } { $subsection first4 } -{ $see-also nth peek } ; +{ $see-also nth } ; ARTICLE: "sequences-add-remove" "Adding and removing sequence elements" "Adding elements:" @@ -1579,7 +1581,6 @@ ARTICLE: "sequences-destructive" "Destructive operations" ARTICLE: "sequences-stacks" "Treating sequences as stacks" "The classical stack operations, modifying a sequence in place:" -{ $subsection peek } { $subsection push } { $subsection pop } { $subsection pop* } diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 9b0f4c1530..36e4c95470 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -626,7 +626,7 @@ PRIVATE> [ 0 swap copy ] keep ] new-like ; -: peek ( seq -- elt ) [ length 1 - ] [ nth ] bi ; +: last ( seq -- elt ) [ length 1 - ] [ nth ] bi ; : pop* ( seq -- ) [ length 1 - ] [ shorten ] bi ; @@ -821,7 +821,7 @@ PRIVATE> [ rest ] [ first-unsafe ] bi ; : unclip-last ( seq -- butlast last ) - [ but-last ] [ peek ] bi ; + [ but-last ] [ last ] bi ; : unclip-slice ( seq -- rest-slice first ) [ rest-slice ] [ first-unsafe ] bi ; inline @@ -852,7 +852,7 @@ PRIVATE> [ find-last ] (map-find) ; inline : unclip-last-slice ( seq -- butlast-slice last ) - [ but-last-slice ] [ peek ] bi ; inline + [ but-last-slice ] [ last ] bi ; inline : ( seq -- slice ) dup slice? [ { } like ] when diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor index c55a75baa6..5ec396e5ba 100644 --- a/core/splitting/splitting.factor +++ b/core/splitting/splitting.factor @@ -53,6 +53,8 @@ PRIVATE> [ ] bi@ split1-slice [ ] bi@ [ f ] [ swap ] if-empty ; + : split, ( seq separators -- ) 0 rot (split) ; +PRIVATE> + : split ( seq separators -- pieces ) [ split, ] { } make ; @@ -71,7 +75,7 @@ M: string string-lines but-last-slice [ "\r" ?tail drop "\r" split ] map - ] keep peek "\r" split suffix concat + ] keep last "\r" split suffix concat ] [ 1array ] if ; diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor index 12e2ea49f7..9052638e7d 100644 --- a/core/vectors/vectors-tests.factor +++ b/core/vectors/vectors-tests.factor @@ -62,7 +62,7 @@ IN: vectors.tests [ ] [ V{ 1 5 } "funny-stack" get push ] unit-test [ ] [ V{ 2 3 } "funny-stack" get push ] unit-test [ V{ 2 3 } ] [ "funny-stack" get pop ] unit-test -[ V{ 1 5 } ] [ "funny-stack" get peek ] unit-test +[ V{ 1 5 } ] [ "funny-stack" get last ] unit-test [ V{ 1 5 } ] [ "funny-stack" get pop ] unit-test [ "funny-stack" get pop ] must-fail [ "funny-stack" get pop ] must-fail @@ -98,4 +98,4 @@ IN: vectors.tests [ fixnum ] [ 1 >bignum [ ] V{ } map-as length class ] unit-test -[ V{ "lulz" } ] [ "lulz" 1vector ] unit-test \ No newline at end of file +[ V{ "lulz" } ] [ "lulz" 1vector ] unit-test diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 6561c55b67..2c0f67641d 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -39,7 +39,7 @@ PRIVATE> : vocab-dir+ ( vocab str/f -- path ) [ vocab-name "." split ] dip - [ [ dup peek ] dip append suffix ] when* + [ [ dup last ] dip append suffix ] when* "/" join ; : find-vocab-root ( vocab -- path/f ) diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index ff55f8e68d..ca783c13e6 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -193,7 +193,7 @@ TUPLE: ambiguous-use-error words ; : qualified-search ( name manifest -- word/f ) qualified-vocabs>> - (vocab-search) 0 = [ drop f ] [ peek ] if ; + (vocab-search) 0 = [ drop f ] [ last ] if ; PRIVATE> diff --git a/extra/24-game/24-game.factor b/extra/24-game/24-game.factor index 19928b2e0b..15c610ce7a 100644 --- a/extra/24-game/24-game.factor +++ b/extra/24-game/24-game.factor @@ -40,7 +40,7 @@ SYMBOL: commands if ; DEFER: check-status : quit-game ( vector -- ) drop "you're a quitter" print ; -: quit? ( vector -- t/f ) peek "quit" = ; +: quit? ( vector -- t/f ) last "quit" = ; : end-game ( vector -- ) dup victory? [ drop "You WON!" ] diff --git a/extra/adsoda/adsoda.factor b/extra/adsoda/adsoda.factor index 4042528eba..c659e109ce 100755 --- a/extra/adsoda/adsoda.factor +++ b/extra/adsoda/adsoda.factor @@ -58,7 +58,6 @@ t to: remove-hidden-solids? : with-pv ( i quot -- ) [ swap >pv call ] with-scope ; inline : dimension ( array -- x ) length 1- ; inline -: last ( seq -- x ) [ dimension ] [ nth ] bi ; inline : change-last ( seq quot -- ) [ [ dimension ] keep ] dip change-nth ; inline diff --git a/extra/animations/animations.factor b/extra/animations/animations.factor index a5c7dbdde4..8f416dc799 100644 --- a/extra/animations/animations.factor +++ b/extra/animations/animations.factor @@ -14,4 +14,4 @@ SYMBOL: sleep-period : set-end ( duration -- end-time ) duration>milliseconds millis + ; : loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ; inline : animate ( quot duration -- ) reset-progress set-end loop ; inline -: sample ( revs quot -- avg ) reset-progress dupd times progress swap / ; inline \ No newline at end of file +: sample ( revs quot -- avg ) reset-progress dupd times progress swap / ; inline diff --git a/extra/bson/reader/reader.factor b/extra/bson/reader/reader.factor index 9f1d8c31d2..6fadcf7679 100644 --- a/extra/bson/reader/reader.factor +++ b/extra/bson/reader/reader.factor @@ -83,7 +83,7 @@ GENERIC: element-binary-read ( length type -- object ) get-state element>> pop ; inline : peek-scope ( -- ht ) - get-state scope>> peek ; inline + get-state scope>> last ; inline : read-elements ( -- ) read-element-type @@ -136,7 +136,7 @@ M: bson-not-eoo element-read ( type -- cont? ) read-int32 drop get-state [scope-changer] change-scope - scope>> peek ; inline + scope>> last ; inline M: bson-object element-data-read ( type -- object ) (object-data-read) ; diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor index 6d81f2a14b..f16664fb02 100644 --- a/extra/dns/dns.factor +++ b/extra/dns/dns.factor @@ -495,7 +495,7 @@ ERROR: name-error name ; : fully-qualified ( name -- name ) { { [ dup empty? ] [ "." append ] } - { [ dup peek CHAR: . = ] [ ] } + { [ dup last CHAR: . = ] [ ] } { [ t ] [ "." append ] } } cond ; diff --git a/extra/html/parser/parser.factor b/extra/html/parser/parser.factor index 948bd0c954..9fcbffd0db 100644 --- a/extra/html/parser/parser.factor +++ b/extra/html/parser/parser.factor @@ -21,7 +21,7 @@ SYMBOL: tagstack : closing-tag? ( string -- ? ) [ f ] - [ { [ first CHAR: / = ] [ peek CHAR: / = ] } 1|| ] if-empty ; + [ { [ first CHAR: / = ] [ last CHAR: / = ] } 1|| ] if-empty ; : ( name attributes closing? -- tag ) tag new diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 2006cc24c3..d53ef6924b 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -65,7 +65,7 @@ IRC: rpl-nick-collision "436" nickname : comment ; PREDICATE: channel-mode < mode name>> first "#&" member? ; PREDICATE: participant-mode < channel-mode parameter>> ; PREDICATE: ctcp < privmsg - trailing>> { [ length 1 > ] [ first 1 = ] [ peek 1 = ] } 1&& ; + trailing>> { [ length 1 > ] [ first 1 = ] [ last 1 = ] } 1&& ; PREDICATE: action < ctcp trailing>> rest "ACTION" head? ; M: rpl-names post-process-irc-message ( rpl-names -- ) diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 5b92b3a434..3364179920 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -45,10 +45,10 @@ CONSTANT: max-speed 30.0 max-speed [0,b] ; : change-player-speed ( inc player -- ) - [ + speed-range clamp-to-range ] change-speed drop ; + [ + 0 max-speed clamp ] change-speed drop ; : multiply-player-speed ( n player -- ) - [ * speed-range clamp-to-range ] change-speed drop ; + [ * 0 max-speed clamp ] change-speed drop ; : distance-to-move ( seconds-passed player -- distance ) speed>> * ; diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 7e124dc713..986574ee91 100644 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -1,6 +1,9 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays colors combinators kernel literals locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ; +USING: accessors arrays colors combinators fry jamshred.oint +kernel literals locals math math.constants math.matrices +math.order math.quadratic math.ranges math.vectors random +sequences specialized-arrays.float vectors ; FROM: jamshred.oint => distance ; IN: jamshred.tunnel @@ -12,6 +15,9 @@ C: segment : segment-number++ ( segment -- ) [ number>> 1+ ] keep (>>number) ; +: clamp-length ( n seq -- n' ) + 0 swap length clamp ; + : random-color ( -- color ) { 100 100 100 } [ random 100 / >float ] map first3 1.0 ; @@ -25,7 +31,7 @@ CONSTANT: random-rotation-angle $[ pi 20 / ] : (random-segments) ( segments n -- segments ) dup 0 > [ - [ dup peek random-segment over push ] dip 1- (random-segments) + [ dup last random-segment over push ] dip 1- (random-segments) ] [ drop ] if ; CONSTANT: default-segment-radius 1 @@ -53,7 +59,7 @@ CONSTANT: default-segment-radius 1 : sub-tunnel ( from to segments -- segments ) #! return segments between from and to, after clamping from and to to #! valid values - [ sequence-index-range [ clamp-to-range ] curry bi@ ] keep ; + [ '[ _ clamp-length ] bi@ ] keep ; : nearer-segment ( segment segment oint -- segment ) #! return whichever of the two segments is nearer to the oint @@ -82,7 +88,7 @@ CONSTANT: default-segment-radius 1 ] dip nearer-segment ; : get-segment ( segments n -- segment ) - over sequence-index-range clamp-to-range swap nth ; + over clamp-length swap nth ; : next-segment ( segments current-segment -- segment ) number>> 1+ get-segment ; diff --git a/extra/mason/notify/server/server.factor b/extra/mason/notify/server/server.factor index 9ed29aef45..5e99b15df5 100644 --- a/extra/mason/notify/server/server.factor +++ b/extra/mason/notify/server/server.factor @@ -45,7 +45,7 @@ builder "BUILDERS" { SYMBOLS: host-name target-os target-cpu message message-arg ; : parse-args ( command-line -- ) - dup peek message-arg set + dup last message-arg set [ { [ host-name set ] diff --git a/extra/math/compare/compare-docs.factor b/extra/math/compare/compare-docs.factor index 4cbe1a1ae0..27e68081a6 100644 --- a/extra/math/compare/compare-docs.factor +++ b/extra/math/compare/compare-docs.factor @@ -16,8 +16,3 @@ HELP: posmax HELP: negmin { $values { "a" number } { "b" number } { "x" number } } { $description "Returns the most-negative value, or zero if both are positive." } ; - -HELP: clamp -{ $values { "value" number } { "a" number } { "b" number } { "x" number } } -{ $description "Returns the value when between " { $snippet "a" } " and " { $snippet "b" } ", " { $snippet "a" } " if <= " { $snippet "a" } ", or " { $snippet "b" } " if >= " { $snippet "b" } "." } ; - diff --git a/extra/math/compare/compare-tests.factor b/extra/math/compare/compare-tests.factor index 9accc8e98b..5b30af0e63 100644 --- a/extra/math/compare/compare-tests.factor +++ b/extra/math/compare/compare-tests.factor @@ -14,8 +14,3 @@ IN: math.compare.tests [ 0 ] [ 1 3 negmin ] unit-test [ -3 ] [ 1 -3 negmin ] unit-test [ -1 ] [ -1 3 negmin ] unit-test - -[ 0 ] [ -1 0 2 clamp ] unit-test -[ 1 ] [ 1 0 2 clamp ] unit-test -[ 2 ] [ 3 0 2 clamp ] unit-test - diff --git a/extra/math/compare/compare.factor b/extra/math/compare/compare.factor index 93a8da7cf3..b48641d723 100644 --- a/extra/math/compare/compare.factor +++ b/extra/math/compare/compare.factor @@ -1,8 +1,6 @@ ! Copyright (C) 2008 John Benediktsson. ! See http://factorcode.org/license.txt for BSD license - USING: math math.order kernel ; - IN: math.compare : absmin ( a b -- x ) @@ -16,6 +14,3 @@ IN: math.compare : negmin ( a b -- x ) 0 min min ; - -: clamp ( value a b -- x ) - [ max ] [ min ] bi* ; diff --git a/extra/math/vectors/homogeneous/homogeneous.factor b/extra/math/vectors/homogeneous/homogeneous.factor index 218e56dfb5..65f57be514 100644 --- a/extra/math/vectors/homogeneous/homogeneous.factor +++ b/extra/math/vectors/homogeneous/homogeneous.factor @@ -5,7 +5,7 @@ IN: math.vectors.homogeneous : (homogeneous-xyz) ( h -- xyz ) 1 head* ; inline : (homogeneous-w) ( h -- w ) - peek ; inline + last ; inline : h+ ( a b -- c ) 2dup [ (homogeneous-w) ] bi@ over = diff --git a/extra/project-euler/049/049.factor b/extra/project-euler/049/049.factor index 15dd7ed6d2..9ecf942ef6 100644 --- a/extra/project-euler/049/049.factor +++ b/extra/project-euler/049/049.factor @@ -50,7 +50,7 @@ HINTS: count-digits fixnum ; : (find-unusual-terms) ( n seq -- seq/f ) [ [ arithmetic-terms ] with map ] keep - '[ _ [ peek ] dip member? ] find nip ; + '[ _ [ last ] dip member? ] find nip ; : find-unusual-terms ( seq -- seq/? ) unclip-slice over (find-unusual-terms) [ diff --git a/extra/project-euler/059/059.factor b/extra/project-euler/059/059.factor index 9a2fb8c868..1fb5c7c8bb 100644 --- a/extra/project-euler/059/059.factor +++ b/extra/project-euler/059/059.factor @@ -75,7 +75,7 @@ INSTANCE: rollover immutable-sequence ] { } make nip ; inline : most-frequent ( seq -- elt ) - frequency-analysis sort-values keys peek ; + frequency-analysis sort-values keys last ; : crack-key ( seq key-length -- key ) [ " " decrypt ] dip group but-last-slice diff --git a/extra/project-euler/116/116.factor b/extra/project-euler/116/116.factor index 174618e147..2766322323 100644 --- a/extra/project-euler/116/116.factor +++ b/extra/project-euler/116/116.factor @@ -41,10 +41,10 @@ IN: project-euler.116 [ length swap - 1- ] keep ?nth 0 or ; : next ( colortile seq -- ) - [ nth* ] [ peek + ] [ push ] tri ; + [ nth* ] [ last + ] [ push ] tri ; : ways ( length colortile -- permutations ) - V{ 1 } clone [ [ next ] 2curry times ] keep peek 1- ; + V{ 1 } clone [ [ next ] 2curry times ] keep last 1- ; : (euler116) ( length -- permutations ) 3 [1,b] [ ways ] with sigma ; diff --git a/extra/project-euler/117/117.factor b/extra/project-euler/117/117.factor index cb485d3ce2..0d4ec78226 100644 --- a/extra/project-euler/117/117.factor +++ b/extra/project-euler/117/117.factor @@ -31,7 +31,7 @@ IN: project-euler.117 [ 4 short tail* sum ] keep push ; : (euler117) ( n -- m ) - V{ 1 } clone tuck [ next ] curry times peek ; + V{ 1 } clone tuck [ next ] curry times last ; PRIVATE> diff --git a/extra/project-euler/164/164.factor b/extra/project-euler/164/164.factor index cea1472c0b..af8b7e49c0 100644 --- a/extra/project-euler/164/164.factor +++ b/extra/project-euler/164/164.factor @@ -18,7 +18,7 @@ IN: project-euler.164 > 0.0 ${ MOVEMENT-SPEED 0.0 0.0 } eye-rotate ; : clamp-pitch ( pitch -- pitch' ) - 90.0 min -90.0 max ; + -90.0 90.0 clamp ; : walk-forward ( player -- ) dup forward-vector [ v+ ] curry change-velocity drop ; diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index 86f4f19147..8da50017c8 100755 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -47,7 +47,7 @@ syn keyword factorBoolean boolean f general-t t syn keyword factorCompileDirective inline foldable parsing syn keyword factorKeyword or tuck 2bi 2tri while wrapper nip 4dip wrapper? bi* callstack>array both? hashcode die dupd callstack callstack? 3dup tri@ pick curry build ?execute 3bi prepose >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep clear 2dup when not tuple? dup 2bi* 2tri* call tri-curry object bi@ do unless* if* loop bi-curry* drop when* assert= retainstack assert? -rot execute 2bi@ 2tri@ boa with either? 3drop bi curry? datastack until 3dip over 3curry roll tri-curry* swap tri-curry@ 2nip and throw set-retainstack bi-curry (clone) hashcode* compose spin 2dip if 3tri unless compose? tuple keep 2curry equal? set-datastack assert tri 2drop most boolean? identity-tuple? null new set-callstack dip bi-curry@ rot -roll xor identity-tuple boolean -syn keyword factorKeyword ?at assoc? assoc-clone-like assoc= delete-at* assoc-partition extract-keys new-assoc value? assoc-size map>assoc push-at assoc-like key? assoc-intersect update assoc-union assoc-combine at* assoc-empty? at+ set-at assoc-all? assoc-subset? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at inc-at enum? at cache assoc>map assoc assoc-map enum value-at* remove-all assoc-map-as >alist assoc-filter-as substitute-here clear-assoc assoc-stack substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? at-default unzip +syn keyword factorKeyword ?at assoc? assoc-clone-like assoc= delete-at* assoc-partition extract-keys new-assoc value? assoc-size map>assoc push-at assoc-like key? assoc-intersect update assoc-union assoc-combine at* assoc-empty? at+ set-at assoc-all? assoc-subset? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at inc-at enum? at cache assoc>map assoc assoc-map enum value-at* remove-all assoc-map-as >alist assoc-filter-as substitute-here clear-assoc assoc-stack substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? unzip syn keyword factorKeyword case execute-effect dispatch-case-quot no-cond no-case? 3cleave>quot contiguous-range? 2cleave cond>quot wrong-values? no-cond? cleave>quot no-case hash-dispatch-quot case>quot 3cleave wrong-values alist>quot hash-case-table hash-case-quot case-find (distribute-buckets) cond cleave distribute-buckets call-effect 2cleave>quot recursive-hashcode linear-case-quot spread spread>quot syn keyword factorKeyword byte-array>bignum sgn >bignum next-float number= each-integer next-power-of-2 ?1+ fp-special? imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? neg fixnum sq bignum fp-snan? fp-infinity? denominator (all-integers?) times find-last-integer (each-integer) bit? * + fp-bitwise= - fp-qnan? / power-of-2? >= bitand find-integer complex < log2 > integer? real number bits>double double>bits bitor 2/ zero? rem fp-nan-payload all-integers? (find-integer) real-part prev-float align bits>float float? shift float 1+ 1- fp-nan? abs bitxor ratio? even? <= /mod odd? >integer ratio rational? bitnot real? >fixnum complex? /i numerator /f syn keyword factorKeyword append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as filter-here last-index-from prepare-index reversed index-from cut* pad-tail (indices) concat-as remq but-last snip trim-tail nths nth 2pusher sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length delq drop-prefix unclip iota unclip-last-slice bounds-error? sequence-hashcode-step map start midpoint@ rest-slice prepend fourth sift delete sigma new-sequence follow like delete-nth first4 1sequence reverse slice unless-empty padding virtual@ repetition? index 4sequence max-length set-second immutable-sequence first2 first3 replicate-as reduce-index unclip-slice supremum insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? 2sequence delete-all start* indices snip-slice check-slice sequence? head map-find reduce append-as reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check harvest immutable find produce remove pad-head replicate set-fourth peek shorten reversed? map-find-last 3map-as 2unclip-slice shorter? 3map find-last head-slice pop* 2map-as tail-slice* but-last-slice 2map-reduce iota? accumulate each pusher cut-slice new-resizable each-index head-slice* 2reverse-each sequence-hashcode memq? pop set-nth ?nth second change-each join when-empty accumulator immutable-sequence? all? 3append-as virtual-sequence subseq? push-either new-like length last-index push-if 2all? lengthen assert-sequence copy map-reduce move third first 3each tail? set-first prefix bounds-error any? trim-slice exchange surround 2reduce cut change-nth min-length set-third produce-as push-all head? delete-slice rest sum-lengths 2each head* infimum glue slice-error subseq replace-slice push repetition map-index trim-head unclip-last mismatch trim