From: John Benediktsson Date: Mon, 1 Dec 2014 03:26:23 +0000 (-0800) Subject: more minor cleanup. X-Git-Tag: unmaintained~3185 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=76761b2e5940576b1b8539f5390aba6e846da8aa more minor cleanup. --- diff --git a/basis/dlists/dlists.factor b/basis/dlists/dlists.factor index 8d1d47f5a4..263dd62cdc 100644 --- a/basis/dlists/dlists.factor +++ b/basis/dlists/dlists.factor @@ -87,8 +87,9 @@ M: dlist equal? PRIVATE> : unlink-node ( dlist-node -- ) - dup prev>> over next>> set-prev-when - dup next>> swap prev>> set-next-when ; inline + [ prev>> ] [ next>> ] bi + [ set-prev-when ] + [ swap set-next-when ] 2bi ; inline M: dlist push-front* ( obj dlist -- dlist-node ) [ front>> f swap dup dup set-next-prev ] keep diff --git a/basis/formatting/formatting.factor b/basis/formatting/formatting.factor index 1aedd07afb..aa7d6c0f80 100644 --- a/basis/formatting/formatting.factor +++ b/basis/formatting/formatting.factor @@ -14,16 +14,16 @@ IN: formatting [ ] [ compose ] reduce ; inline : fix-sign ( string -- string ) - dup CHAR: 0 swap index 0 = - [ dup 0 swap [ [ CHAR: 0 = not ] keep digit? and ] find-from - [ dup 1 - rot dup [ nth ] dip swap - { - { CHAR: - [ [ 1 - ] dip remove-nth "-" prepend ] } - { CHAR: + [ [ 1 - ] dip remove-nth "+" prepend ] } - [ drop nip ] + dup first CHAR: 0 = [ + dup [ [ CHAR: 0 = not ] [ digit? ] bi and ] find + [ + 1 - swap 2dup nth { + { CHAR: - [ remove-nth "-" prepend ] } + { CHAR: + [ remove-nth "+" prepend ] } + [ drop nip ] } case - ] [ drop ] if - ] when ; + ] [ drop ] if + ] when ; : >digits ( string -- digits ) [ 0 ] [ string>number ] if-empty ; diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor index dccf1e5e55..109d96bd51 100644 --- a/basis/heaps/heaps.factor +++ b/basis/heaps/heaps.factor @@ -181,7 +181,7 @@ M: heap heap-pop ( heap -- value key ) : heap-pop-all ( heap -- alist ) [ dup heap-empty? not ] - [ dup heap-pop swap 2array ] + [ [ heap-pop ] keep 2array ] produce nip ; ERROR: not-a-heap obj ; diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index eba7bfed52..70a0c85b43 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -267,7 +267,7 @@ PRIVATE> ] ($subsection) ; : $vocab-link ( element -- ) - check-first dup vocab-name swap ($vocab-link) ; + check-first [ vocab-name ] keep ($vocab-link) ; : $vocabulary ( element -- ) check-first vocabulary>> [ diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor index 35399c0132..3a2465df21 100644 --- a/basis/inverse/inverse.factor +++ b/basis/inverse/inverse.factor @@ -219,7 +219,7 @@ DEFER: __ \ first4 [ 4array ] define-inverse \ prefix \ unclip define-dual -\ suffix [ dup but-last swap last ] define-inverse +\ suffix \ unclip-last define-dual \ append 1 [ [ ?tail assure ] curry ] define-pop-inverse \ prepend 1 [ [ ?head assure ] curry ] define-pop-inverse diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index ac9a87a844..5b8cb401b3 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -59,7 +59,7 @@ SYMBOL: +new-session+ +same-group+ >>group ; : process-started? ( process -- ? ) - dup handle>> swap status>> or ; + [ handle>> ] [ status>> ] bi or ; : process-running? ( process -- ? ) handle>> >boolean ; diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor index 1212f63051..cb0ef80130 100644 --- a/basis/math/polynomials/polynomials.factor +++ b/basis/math/polynomials/polynomials.factor @@ -32,7 +32,7 @@ ALIAS: n*p n*v 2dup [ length ] bi@ + 1 - 2pad-tail ; : p* ( p q -- r ) - 2unempty pextend-conv + 2unempty pextend-conv [ drop length [ iota ] keep ] [ nip ] [ drop ] 2tri diff --git a/basis/xmode/loader/loader.factor b/basis/xmode/loader/loader.factor index 12e992824f..0d9cd03a01 100644 --- a/basis/xmode/loader/loader.factor +++ b/basis/xmode/loader/loader.factor @@ -74,7 +74,7 @@ TAG: KEYWORDS parse-rule-tag ! Top-level entry points : parse-mode-tag ( tag -- rule-sets ) dup "RULES" tags-named [ - parse-rules-tag dup name>> swap + parse-rules-tag [ name>> ] keep ] H{ } map>assoc swap "PROPS" tag-named [ parse-props-tag over values diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor index 3276e6594f..8f8776dc46 100644 --- a/basis/xmode/marker/marker.factor +++ b/basis/xmode/marker/marker.factor @@ -94,7 +94,7 @@ M: regexp text-matches? : rule-end-matches? ( rule -- match-count/f ) dup mark-following-rule? [ - dup start>> swap can-match-here? 0 and + [ start>> ] keep can-match-here? 0 and ] [ [ end>> dup ] keep can-match-here? [ rest-of-line diff --git a/basis/xmode/tokens/tokens.factor b/basis/xmode/tokens/tokens.factor index 945f4bb046..8a5d8afbf6 100644 --- a/basis/xmode/tokens/tokens.factor +++ b/basis/xmode/tokens/tokens.factor @@ -7,9 +7,13 @@ IN: xmode.tokens << SYMBOL: tokens -{ "COMMENT1" "COMMENT2" "COMMENT3" "COMMENT4" "DIGIT" "FUNCTION" "INVALID" "KEYWORD1" "KEYWORD2" "KEYWORD3" "KEYWORD4" "LABEL" "LITERAL1" "LITERAL2" "LITERAL3" "LITERAL4" "MARKUP" "OPERATOR" "END" "NULL" } [ - create-in dup define-symbol - dup name>> swap +{ + "COMMENT1" "COMMENT2" "COMMENT3" "COMMENT4" "DIGIT" + "FUNCTION" "INVALID" "KEYWORD1" "KEYWORD2" "KEYWORD3" + "KEYWORD4" "LABEL" "LITERAL1" "LITERAL2" "LITERAL3" + "LITERAL4" "MARKUP" "OPERATOR" "END" "NULL" +} [ + dup create-in dup define-symbol ] H{ } map>assoc tokens set-global >> diff --git a/extra/fjsc/fjsc.factor b/extra/fjsc/fjsc.factor index 919823cca3..8c2e883c58 100644 --- a/extra/fjsc/fjsc.factor +++ b/extra/fjsc/fjsc.factor @@ -311,31 +311,25 @@ M: number (parse-factor-quotation) ( object -- ast ) ast-number boa ; M: symbol (parse-factor-quotation) ( object -- ast ) - dup >string swap vocabulary>> ast-identifier boa ; + [ >string ] [ vocabulary>> ] bi ast-identifier boa ; M: word (parse-factor-quotation) ( object -- ast ) - dup name>> swap vocabulary>> ast-identifier boa ; + [ name>> ] [ vocabulary>> ] bi ast-identifier boa ; M: string (parse-factor-quotation) ( object -- ast ) ast-string boa ; M: quotation (parse-factor-quotation) ( object -- ast ) - [ - [ (parse-factor-quotation) , ] each - ] { } make ast-quotation boa ; + [ (parse-factor-quotation) ] { } map-as ast-quotation boa ; M: array (parse-factor-quotation) ( object -- ast ) - [ - [ (parse-factor-quotation) , ] each - ] { } make ast-array boa ; + [ (parse-factor-quotation) ] { } map-as ast-array boa ; M: hashtable (parse-factor-quotation) ( object -- ast ) - >alist [ - [ (parse-factor-quotation) , ] each - ] { } make ast-hashtable boa ; + >alist [ (parse-factor-quotation) ] { } map-as ast-hashtable boa ; M: wrapper (parse-factor-quotation) ( object -- ast ) - wrapped>> dup name>> swap vocabulary>> ast-word boa ; + wrapped>> [ name>> ] [ vocabulary>> ] bi ast-word boa ; GENERIC: fjsc-parse ( object -- ast ) @@ -343,9 +337,7 @@ M: string fjsc-parse ( object -- ast ) 'expression' parse ; M: quotation fjsc-parse ( object -- ast ) - [ - [ (parse-factor-quotation) , ] each - ] { } make ast-expression boa ; + [ (parse-factor-quotation) ] { } map-as ast-expression boa ; : fjsc-compile ( ast -- string ) [ @@ -364,7 +356,6 @@ M: quotation fjsc-parse ( object -- ast ) 'statement' parse values>> do-expressions ] { } make [ write ] each ; - : fjsc-literal ( ast -- string ) [ [ (literal) ] { } make [ write ] each diff --git a/extra/project-euler/018/018.factor b/extra/project-euler/018/018.factor index 9189323121..8a384c9d6c 100644 --- a/extra/project-euler/018/018.factor +++ b/extra/project-euler/018/018.factor @@ -8,8 +8,9 @@ IN: project-euler.018 ! DESCRIPTION ! ----------- -! By starting at the top of the triangle below and moving to adjacent numbers -! on the row below, the maximum total from top to bottom is 23. +! By starting at the top of the triangle below and moving to +! adjacent numbers on the row below, the maximum total from top +! to bottom is 23. ! 3 ! 7 5 @@ -18,7 +19,8 @@ IN: project-euler.018 ! That is, 3 + 7 + 4 + 9 = 23. -! Find the maximum total from top to bottom of the triangle below: +! Find the maximum total from top to bottom of the triangle +! below: ! 75 ! 95 64 @@ -36,22 +38,24 @@ IN: project-euler.018 ! 63 66 04 68 89 53 67 30 73 16 69 87 40 31 ! 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23 -! NOTE: As there are only 16384 routes, it is possible to solve this problem by -! trying every route. However, Problem 67, is the same challenge with a -! triangle containing one-hundred rows; it cannot be solved by brute force, and -! requires a clever method! ;o) +! NOTE: As there are only 16384 routes, it is possible to solve +! this problem by trying every route. However, Problem 67, is +! the same challenge with a triangle containing one-hundred +! rows; it cannot be solved by brute force, and requires a +! clever method! ;o) ! SOLUTION ! -------- -! Propagate from bottom to top the longest cumulative path. This is very -! efficient and will be reused in problem 67. +! Propagate from bottom to top the longest cumulative path. This +! is very efficient and will be reused in problem 67. diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index ddadd4079a..3fc7134254 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -111,11 +111,12 @@ PRIVATE> : penultimate ( seq -- elt ) dup length 2 - swap nth ; -! Not strictly needed, but it is nice to be able to dump the triangle after the -! propagation +! Not strictly needed, but it is nice to be able to dump the +! triangle after the propagation : propagate-all ( triangle -- new-triangle ) - reverse [ first dup ] [ rest ] bi - [ propagate dup ] map nip reverse swap suffix ; + reverse unclip dup rot + [ propagate dup ] map nip + reverse swap suffix ; : permutations? ( n m -- ? ) [ count-digits ] same? ; @@ -124,7 +125,7 @@ PRIVATE> dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ; : sum-proper-divisors ( n -- sum ) - dup sum-divisors swap - ; + [ sum-divisors ] keep - ; : abundant? ( n -- ? ) dup sum-proper-divisors < ;