Resolved merge.

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

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 <string> "Hi There" md5 hmac-bytes >string ] unit-test
+    "Hi There" 16 11 <string> 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 <string>
-    50 HEX: dd <repetition> md5 hmac-bytes >string
+    50 HEX: dd <repetition>
+    16 HEX: aa <string> md5 hmac-bytes >string
 ] unit-test
 
 [
     "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9"
 ] [
-    16 11 <string> "Hi There" sha1 hmac-bytes >string
+    "Hi There" 16 11 <string> 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 <string>
-    50 HEX: dd <repetition> sha1 hmac-bytes >string
+    50 HEX: dd <repetition>
+    16 HEX: aa <string> sha1 hmac-bytes >string
 ] unit-test
 
 [ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ]
-[ 20 HEX: b <string> "Hi There" sha-256 hmac-bytes hex-string ] unit-test
+[ "Hi There" 20 HEX: b <string> 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

basis/checksums/hmac/hmac.factor

@@ -13,27 +13,26 @@ IN: checksums.hmac
 
 : ipad ( checksum-state -- seq ) block-size>> HEX: 36 <array> ;
 
-:: 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 <file-reader> ] dip hmac-stream ;
+: hmac-file ( path key checksum -- value )
+    [ binary <file-reader> ] 2dip hmac-stream ;
 
-: hmac-bytes ( K seq checksum -- value )
-    [ binary <byte-reader> ] dip hmac-stream ;
+: hmac-bytes ( seq key checksum -- value )
+    [ binary <byte-reader> ] 2dip hmac-stream ;

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 ;
 
 : <growing-circular> ( capacity -- growing-circular )
     { } new-sequence 0 0 growing-circular boa ;

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 ;
 

basis/compiler/cfg/intrinsics/allot/allot.factor

@@ -19,7 +19,7 @@ IN: compiler.cfg.intrinsics.allot
     [ second ds-load ] [ ^^load-literal ] bi prefix ;
 
 : emit-<tuple-boa> ( node -- )
-    dup node-input-infos peek literal>>
+    dup node-input-infos last literal>>
     dup array? [
         nip
         ds-drop

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 ;

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 <string>
+    dup last 1 + CHAR: space <string>
     [ '[ CHAR: * swap _ set-nth ] each ] keep ;
 
 : interval-picture ( interval -- str )

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 ;
 

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

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 )

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 ;

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*

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>> \ <tuple-boa> eq? [
-        dup in-d>> peek node-value-info
+        dup in-d>> last node-value-info
         literal>> first immutable-tuple-class?
     ] [ drop f ] if ;

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 } ] [

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, ;

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
 

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 )
     <file-reader> csv ;

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
 

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 ;

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

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 ;

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

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 -- )

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
 

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* ;
 

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 ;
 

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

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 ;

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 )

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
+    1067811677921310779 >bignum make-bits last
 ] unit-test

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:"

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

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"

basis/math/ranges/ranges-tests.factor

@@ -22,17 +22,6 @@ IN: math.ranges.tests
 [ { 0 1/3 2/3 1 } ] [ 0 1 1/3 <range> >array ] unit-test
 [ { 0 1/3 2/3 1 } ] [ 1 0 -1/3 <range> >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

basis/math/ranges/ranges.factor

@@ -26,12 +26,16 @@ M: range hashcode* tuple-hashcode ;
 
 INSTANCE: range immutable-sequence
 
+<PRIVATE
+
 : twiddle ( a b -- a b step ) 2dup > -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 <range> ; inline
 
 : (a,b] ( a b -- range ) twiddle (a, <range> ; 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) ;

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

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 ;

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 ;

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" = [

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 ]

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 ] }
         [ ]

basis/prettyprint/sections/sections.factor

@@ -153,7 +153,7 @@ TUPLE: block < section sections ;
 : <block> ( 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 <fresh-line ] [ drop ] if ;

basis/quoted-printable/quoted-printable-tests.factor

@@ -27,4 +27,4 @@ and we didn't know hów tö do thât"> 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

basis/quoting/quoting.factor

@@ -9,7 +9,7 @@ IN: quoting
     {
         [ length 1 > ]
         [ first quote? ]
-        [ [ first ] [ peek ] bi = ]
+        [ [ first ] [ last ] bi = ]
     } 1&& ;
 
 : unquote ( str -- newstr )

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

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 >>

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"
     }
 ] [

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 >>

basis/splitting/monotonic/monotonic.factor

@@ -6,9 +6,9 @@ IN: splitting.monotonic
 
 <PRIVATE
 
-: ,, ( obj -- ) building get peek push ;
+: ,, ( obj -- ) building get last push ;
 : v, ( -- ) V{ } clone , ;
-: ,v ( -- ) building get dup peek empty? [ dup pop* ] when drop ;
+: ,v ( -- ) building get dup last empty? [ dup pop* ] when drop ;
 
 : (monotonic-split) ( seq quot -- newseq )
     [

basis/stack-checker/transforms/transforms.factor

@@ -57,8 +57,8 @@ IN: stack-checker.transforms
     [
         [ no-case ]
     ] [
-        dup peek callable? [
-            dup peek swap but-last
+        dup last callable? [
+            dup last swap but-last
         ] [
             [ no-case ] swap
         ] if case>quot

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 )

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
 
 
 [

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 <CGPoint> -> cascadeTopLeftFromPoint:
             -> setFrameTopLeftPoint:
         ] if

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
 

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

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

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
 

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

basis/xml/xml.factor

@@ -11,7 +11,7 @@ IN: xml
 <PRIVATE
 
 : add-child ( object -- )
-    xml-stack get peek second push ;
+    xml-stack get last second push ;
 
 : push-xml ( object -- )
     V{ } clone 2array xml-stack get push ;

core/assocs/assocs-docs.factor

@@ -66,7 +66,7 @@ ARTICLE: "assocs-lookup" "Lookup and querying of assocs"
 { $see-also at* assoc-size } ;
 
 ARTICLE: "assocs-values" "Transposed assoc operations"
-"Most assoc words take a key and find the corresponding value. The following words take a value and find the corresponding key:"
+"default Most assoc words take a key and find the corresponding value. The following words take a value and find the corresponding key:"
 { $subsection value-at }
 { $subsection value-at* }
 { $subsection value? }
@@ -119,7 +119,9 @@ $nl
 { $subsection assoc-any? }
 { $subsection assoc-all? }
 "Additional combinators:"
+{ $subsection assoc-partition }
 { $subsection cache }
+{ $subsection 2cache }
 { $subsection map>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

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 ] }

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 ;

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 -- )

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

core/combinators/combinators.factor

@@ -101,6 +101,8 @@ ERROR: no-case object ;
         [ \ drop prefix ] bi*
     ] assoc-map alist>quot ;
 
+<PRIVATE
+
 : (distribute-buckets) ( buckets pair keys -- )
     dup t eq? [
         drop [ swap adjoin ] curry each
@@ -150,6 +152,8 @@ ERROR: no-case object ;
         ] [ ] make , , \ if ,
     ] [ ] make ;
 
+PRIVATE>
+
 : 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
 

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 ;

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

core/generic/math/math.factor

@@ -15,7 +15,7 @@ PREDICATE: math-class < class
 
 <PRIVATE
 
-: last/first ( seq -- pair ) [ peek ] [ first ] bi 2array ;
+: last/first ( seq -- pair ) [ last ] [ first ] bi 2array ;
 
 : bootstrap-words ( classes -- classes' )
     [ bootstrap-word ] map ;

core/generic/single/single.factor

@@ -3,7 +3,8 @@
 USING: accessors arrays assocs classes classes.algebra
 combinators definitions generic hashtables kernel
 kernel.private layouts math namespaces quotations
-sequences words generic.single.private effects make ;
+sequences words generic.single.private effects make
+combinators.private ;
 IN: generic.single
 
 ERROR: no-method object generic ;
@@ -234,7 +235,7 @@ M: predicate-engine-word stack-effect "owner-generic" word-prop stack-effect ;
     quote-methods
     prune-redundant-predicates
     class-predicates
-    [ peek ] [ alist>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

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=? }

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

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

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

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* }

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
 
 : <flat-slice> ( seq -- slice )
     dup slice? [ { } like ] when

core/splitting/splitting.factor

@@ -53,6 +53,8 @@ PRIVATE>
     [ <reversed> ] bi@ split1-slice [ <reversed> ] bi@
     [ f ] [ swap ] if-empty ;
 
+<PRIVATE
+
 : (split) ( separators n seq -- )
     3dup rot [ member? ] curry find-from drop
     [ [ swap subseq , ] 2keep 1 + swap (split) ]
@@ -60,6 +62,8 @@ PRIVATE>
 
 : 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 ;

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

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 )

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>
 

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!" ]

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
 

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) ;

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 ;

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 ;
 
 : <tag> ( name attributes closing? -- tag )
     tag new

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 -- )

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>> * ;

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
 : 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 <rgba> ;
 
@@ -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 <slice> ;
+    [ '[ _ clamp-length ] bi@ ] keep <slice> ;
 
 : 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 ;

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 ]

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" } "." } ;
-

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
-

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* ;

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 =

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) [

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

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 ;

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>
 

extra/project-euler/164/164.factor

@@ -18,7 +18,7 @@ IN: project-euler.164
 <PRIVATE
 
 : next-keys ( key -- keys )
-    [ peek ] [ 10 swap sum - ] bi [ 2array ] with map ;
+    [ last ] [ 10 swap sum - ] bi [ 2array ] with map ;
 
 : next-table ( assoc -- assoc )
     H{ } clone swap

extra/terrain/terrain.factor

@@ -88,7 +88,7 @@ M: terrain-world tick-length
     yaw>> 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 ;

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 <wrapper> 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 <enum> 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 <enum> 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 <buckets> 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 <fp-nan> < 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? <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 <flat-slice> second change-each join when-empty accumulator immutable-sequence? <reversed> 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? <repetition> 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