more minor cleanup.

mrjbq7 · mrjbq7 · commit 76761b2e5940 · 2014-11-30T19:26:23.000-08:00
diff --git 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 <dlist-node> dup dup set-next-prev ] keep
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 <reversed> ]
     [ drop ] 2tri
diff --git 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
@@ -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
@@ -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
@@ -311,41 +311,33 @@ 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 )
 
 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
@@ -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.
 
 <PRIVATE
 
 : source-018 ( -- triangle )
-    {                              75
+    {
+                                   75
                                  95  64
                                17  47  82
                              18  35  87  10
@@ -66,7 +70,7 @@ IN: project-euler.018
            91  71  52  38  17  14  91  43  58  50  27  29  48
          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
-     } 15 [1,b] [ cut swap ] map nip ;
+    } 15 [1,b] [ cut swap ] map nip ;
 
 PRIVATE>
 
diff --git 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 < ;
