more minor cleanup.

basis/dlists/dlists.factor

@@ -87,8 +87,9 @@ M: dlist equal?
 PRIVATE>
 
 : unlink-node ( dlist-node -- )
-    dup prev>> over next>> set-prev-when
+    [ prev>> ] [ next>> ] bi
-    dup next>> swap prev>> set-next-when ; inline
+    [ 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

basis/formatting/formatting.factor

@@ -14,16 +14,16 @@ IN: formatting
     [ ] [ compose ] reduce ; inline
 
 : fix-sign ( string -- string )
-    dup CHAR: 0 swap index 0 =
+    dup first CHAR: 0 = [
-      [ dup 0 swap [ [ CHAR: 0 = not ] keep digit? and ] find-from
+        dup [ [ CHAR: 0 = not ] [ digit? ] bi and ] find
-         [ dup 1 - rot dup [ nth ] dip swap
+        [
-            {
+            1 - swap 2dup nth {
-               { CHAR: - [ [ 1 - ] dip remove-nth "-" prepend ] }
+                { CHAR: - [ remove-nth "-" prepend ] }
-               { CHAR: + [ [ 1 - ] dip remove-nth "+" prepend ] }
+                { CHAR: + [ remove-nth "+" prepend ] }
-               [ drop nip ]
+                [ drop nip ]
             } case
-         ] [ drop ] if
+        ] [ drop ] if
-      ] when ;
+    ] when ;
 
 : >digits ( string -- digits )
     [ 0 ] [ string>number ] if-empty ;

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 ;

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

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

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 ;

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

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

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

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
+    "COMMENT1" "COMMENT2" "COMMENT3" "COMMENT4" "DIGIT"
-    dup name>> swap
+    "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
 >>
 

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) ] { } map-as ast-quotation boa ;
-        [ (parse-factor-quotation) , ] each
-    ] { } make ast-quotation boa ;
 
 M: array (parse-factor-quotation) ( object -- ast )
-    [
+    [ (parse-factor-quotation) ] { } map-as ast-array boa ;
-        [ (parse-factor-quotation) , ] each
-    ] { } make ast-array boa ;
 
 M: hashtable (parse-factor-quotation) ( object -- ast )
-    >alist [
+    >alist [ (parse-factor-quotation) ] { } map-as ast-hashtable boa ;
-        [ (parse-factor-quotation) , ] each
-    ] { } make 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) ] { } map-as ast-expression boa ;
-        [ (parse-factor-quotation) , ] each
-    ] { } make 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

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
+! By starting at the top of the triangle below and moving to
-! on the row below, the maximum total from top to bottom is 23.
+! 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
+! NOTE: As there are only 16384 routes, it is possible to solve
-! trying every route. However, Problem 67, is the same challenge with a
+! this problem by trying every route. However, Problem 67, is
-! triangle containing one-hundred rows; it cannot be solved by brute force, and
+! the same challenge with a triangle containing one-hundred
-! requires a clever method! ;o)
+! 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
+! Propagate from bottom to top the longest cumulative path. This
-! efficient and will be reused in problem 67.
+! 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>
 

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
+! Not strictly needed, but it is nice to be able to dump the
-! propagation
+! triangle after the propagation
 : propagate-all ( triangle -- new-triangle )
-    reverse [ first dup ] [ rest ] bi
+    reverse unclip dup rot
-    [ propagate dup ] map nip reverse swap suffix ;
+    [ 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 < ;