move if-zero etc to math, remove 1-/1+ from math

basis/bootstrap/compiler/compiler.factor

@@ -74,7 +74,7 @@ nl
 "." write flush
 
 {
-    + 1+ 1- 2/ < <= > >= shift
+    + 2/ < <= > >= shift
 } compile-unoptimized
 
 "." write flush

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -115,10 +115,6 @@ M: object xyz ;
     [ { fixnum } declare [ ] times ] \ >= inlined?
 ] unit-test
 
-[ t ] [
-    [ { fixnum } declare [ ] times ] \ 1+ inlined?
-] unit-test
-
 [ t ] [
     [ { fixnum } declare [ ] times ] \ + inlined?
 ] unit-test
@@ -172,19 +168,6 @@ M: object xyz ;
     [ { array-capacity } declare 1 fixnum- ] \ fixnum- inlined?
 ] unit-test
 
-[ t ] [
-    [ 5000 [ 5000 [ ] times ] times ] \ 1+ inlined?
-] unit-test
-
-[ t ] [
-    [ 5000 [ [ ] times ] each ] \ 1+ inlined?
-] unit-test
-
-[ t ] [
-    [ 5000 0 [ dup 2 - swap [ 2drop ] curry each ] reduce ]
-    \ 1+ inlined?
-] unit-test
-
 GENERIC: annotate-entry-test-1 ( x -- )
 
 M: fixnum annotate-entry-test-1 drop ;
@@ -305,10 +288,6 @@ cell-bits 32 = [
     ] \ + inlined?
 ] unit-test
 
-[ t ] [
-    [ 1000 iota [ 1+ ] map ] { 1+ fixnum+ } inlined?
-] unit-test
-
 : rec ( a -- b )
     dup 0 > [ 1 - rec ] when ; inline recursive
 

basis/math/bitwise/bitwise-tests.factor

@@ -17,7 +17,8 @@ IN: math.bitwise.tests
 [ 256 ] [ 1 { 8 } bitfield ] unit-test
 [ 268 ] [ 3 1 { 8 2 } bitfield ] unit-test
 [ 268 ] [ 1 { 8 { 3 2 } } bitfield ] unit-test
-[ 512 ] [ 1 { { 1+ 8 } } bitfield ] unit-test
+: test-1+ ( x -- y ) 1 + ;
+[ 512 ] [ 1 { { test-1+ 8 } } bitfield ] unit-test
 
 CONSTANT: a 1
 CONSTANT: b 2

basis/math/functions/functions-docs.factor

@@ -20,9 +20,6 @@ ARTICLE: "arithmetic-functions" "Arithmetic functions"
 "Computing additive and multiplicative inverses:"
 { $subsection neg }
 { $subsection recip }
-"Incrementing, decrementing:"
-{ $subsection 1+ }
-{ $subsection 1- }
 "Minimum, maximum, clamping:"
 { $subsection min }
 { $subsection max }
@@ -32,6 +29,10 @@ ARTICLE: "arithmetic-functions" "Arithmetic functions"
 "Tests:"
 { $subsection zero? }
 { $subsection between? }
+"Control flow:"
+{ $subsection if-zero }
+{ $subsection when-zero }
+{ $subsection unless-zero }
 "Sign:"
 { $subsection sgn }
 "Rounding:"

basis/math/intervals/intervals-tests.factor

@@ -267,8 +267,6 @@ IN: math.intervals.tests
         { bitnot interval-bitnot }
         { abs interval-abs }
         { 2/ interval-2/ }
-        { 1+ interval-1+ }
-        { 1- interval-1- }
         { neg interval-neg }
     }
     "math.ratios.private" vocab [

core/math/math-docs.factor

@@ -163,22 +163,6 @@ HELP: log2
 { $description "Outputs the largest integer " { $snippet "n" } " such that " { $snippet "2^n" } " is less than or equal to " { $snippet "x" } "." }
 { $errors "Throws an error if " { $snippet "x" } " is zero or negative." } ;
 
-HELP: 1+
-{ $values { "x" number } { "y" number } }
-{ $description
-    "Increments a number by 1. The following two lines are equivalent:"
-    { $code "1+" "1 +" }
-    "There is no difference in behavior or efficiency."
-} ;
-
-HELP: 1-
-{ $values { "x" number } { "y" number } }
-{ $description
-    "Decrements a number by 1. The following two lines are equivalent:"
-    { $code "1-" "1 -" }
-    "There is no difference in behavior or efficiency."
-} ;
-
 HELP: ?1+
 { $values { "x" { $maybe number } } { "y" number } }
 { $description "If the input is not " { $link f } ", adds one. Otherwise, outputs a " { $snippet "0" } "." } ;
@@ -237,6 +221,49 @@ HELP: zero?
 { $values { "x" number } { "?" "a boolean" } }
 { $description "Tests if the number is equal to zero." } ;
 
+HELP: if-zero
+{ $values { "n" number } { "quot1" quotation } { "quot2" quotation } }
+{ $description "Makes an implicit check if the number is zero. A zero is dropped and " { $snippet "quot1" } " is called. Otherwise, if the number is not zero, " { $snippet "quot2" } " is called on it." }
+{ $example
+    "USING: kernel math prettyprint sequences ;"
+    "3 [ \"zero\" ] [ sq ] if-zero ."
+    "9"
+} ;
+
+HELP: when-zero
+{ $values
+     { "n" number } { "quot" "the first quotation of an " { $link if-zero } } }
+{ $description "Makes an implicit check if the sequence is empty. A zero is dropped and the " { $snippet "quot" } " is called." }
+{ $examples "This word is equivalent to " { $link if-zero } " with an empty second quotation:"
+    { $example
+    "USING: math prettyprint ;"
+    "0 [ 4 ] [ ] if-zero ."
+    "4"
+    }
+    { $example
+    "USING: math prettyprint ;"
+    "0 [ 4 ] when-zero ."
+    "4"
+    }
+} ;
+
+HELP: unless-zero
+{ $values
+     { "n" number } { "quot" "the second quotation of an " { $link if-empty } } }
+{ $description "Makes an implicit check if the number is zero. A zero is dropped. Otherwise, the " { $snippet "quot" } " is called on the number." }
+{ $examples "This word is equivalent to " { $link if-zero } " with an empty first quotation:"
+    { $example
+    "USING: sequences math prettyprint ;"
+    "3 [ ] [ sq ] if-empty ."
+    "9"
+    }
+    { $example
+    "USING: sequences math prettyprint ;"
+    "3 [ sq ] unless-zero ."
+    "9"
+    }
+} ;
+
 HELP: times
 { $values { "n" integer } { "quot" quotation } }
 { $description "Calls the quotation " { $snippet "n" } " times." }

core/math/math.factor

@@ -58,8 +58,6 @@ ERROR: log2-expects-positive x ;
     ] if ; inline
 
 : zero? ( x -- ? ) 0 number= ; inline
-: 1+ ( x -- y ) 1 + ; inline
-: 1- ( x -- y ) 1 - ; inline
 : 2/ ( x -- y ) -1 shift ; inline
 : sq ( x -- y ) dup * ; inline
 : neg ( x -- -x ) -1 * ; inline
@@ -71,6 +69,13 @@ ERROR: log2-expects-positive x ;
 : even? ( n -- ? ) 1 bitand zero? ;
 : odd? ( n -- ? ) 1 bitand 1 number= ;
 
+: if-zero ( n quot1 quot2 -- )
+    [ dup zero? ] [ [ drop ] prepose ] [ ] tri* if ; inline
+
+: when-zero ( n quot -- ) [ ] if-zero ; inline
+
+: unless-zero ( n quot -- ) [ ] swap if-zero ; inline
+
 UNION: integer fixnum bignum ;
 
 TUPLE: ratio { numerator integer read-only } { denominator integer read-only } ;

core/sequences/sequences-docs.factor

@@ -123,49 +123,6 @@ HELP: unless-empty
     }
 } ;
 
-HELP: if-zero
-{ $values { "n" number } { "quot1" quotation } { "quot2" quotation } }
-{ $description "Makes an implicit check if the number is zero. A zero is dropped and " { $snippet "quot1" } " is called. Otherwise, if the number is not zero, " { $snippet "quot2" } " is called on it." }
-{ $example
-    "USING: kernel math prettyprint sequences ;"
-    "3 [ \"zero\" ] [ sq ] if-zero ."
-    "9"
-} ;
-
-HELP: when-zero
-{ $values
-     { "n" number } { "quot" "the first quotation of an " { $link if-zero } } }
-{ $description "Makes an implicit check if the sequence is empty. A zero is dropped and the " { $snippet "quot" } " is called." }
-{ $examples "This word is equivalent to " { $link if-zero } " with an empty second quotation:"
-    { $example
-    "USING: sequences prettyprint ;"
-    "0 [ 4 ] [ ] if-zero ."
-    "4"
-    }
-    { $example
-    "USING: sequences prettyprint ;"
-    "0 [ 4 ] when-zero ."
-    "4"
-    }
-} ;
-
-HELP: unless-zero
-{ $values
-     { "n" number } { "quot" "the second quotation of an " { $link if-empty } } }
-{ $description "Makes an implicit check if the number is zero. A zero is dropped. Otherwise, the " { $snippet "quot" } " is called on the number." }
-{ $examples "This word is equivalent to " { $link if-zero } " with an empty first quotation:"
-    { $example
-    "USING: sequences math prettyprint ;"
-    "3 [ ] [ sq ] if-empty ."
-    "9"
-    }
-    { $example
-    "USING: sequences math prettyprint ;"
-    "3 [ sq ] unless-zero ."
-    "9"
-    }
-} ;
-
 HELP: delete-all
 { $values { "seq" "a resizable sequence" } }
 { $description "Resizes the sequence to zero length, removing all elements. Not all sequences are resizable." }
@@ -1440,11 +1397,7 @@ $nl
 "Checking if a sequence is empty:"
 { $subsection if-empty }
 { $subsection when-empty }
-{ $subsection unless-empty }
-"Checking if a number is zero:"
-{ $subsection if-zero }
-{ $subsection when-zero }
-{ $subsection unless-zero } ;
+{ $subsection unless-empty } ;
 
 ARTICLE: "sequences-access" "Accessing sequence elements"
 { $subsection ?nth }

core/sequences/sequences.factor

@@ -29,27 +29,13 @@ M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
 
 : empty? ( seq -- ? ) length 0 = ; inline
 
-<PRIVATE
-
-: (if-empty) ( seq quot1 quot2 quot3 -- )
-    [ [ drop ] prepose ] [ ] tri* if ; inline
-
-PRIVATE>
-
 : if-empty ( seq quot1 quot2 -- )
-    [ dup empty? ] (if-empty) ; inline
+    [ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
 
 : when-empty ( seq quot -- ) [ ] if-empty ; inline
 
 : unless-empty ( seq quot -- ) [ ] swap if-empty ; inline
 
-: if-zero ( n quot1 quot2 -- )
-    [ dup zero? ] (if-empty) ; inline
-
-: when-zero ( n quot -- ) [ ] if-zero ; inline
-
-: unless-zero ( n quot -- ) [ ] swap if-zero ; inline
-
 : delete-all ( seq -- ) 0 swap set-length ;
 
 : first ( seq -- first ) 0 swap nth ; inline

misc/vim/syntax/factor.vim

@@ -50,7 +50,7 @@ syn keyword factorCompileDirective inline foldable recursive
 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 assoc-refine 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 maybe-set-at substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? unzip
 syn keyword factorKeyword case execute-effect no-cond no-case? 3cleave>quot 2cleave cond>quot wrong-values? no-cond? cleave>quot no-case case>quot 3cleave wrong-values to-fixed-point alist>quot case-find cond cleave 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 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 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 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? set-last 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 map-integers 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 last replicate set-fourth 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
 syn keyword factorKeyword global +@ change set-namestack change-global init-namespaces on off set-global namespace set with-scope bind with-variable inc dec counter initialize namestack get get-global make-assoc
 syn keyword factorKeyword <array> 2array 3array pair >array 1array 4array pair? array resize-array array?