]> gitweb.factorcode.org Git - factor.git/commitdiff
more minor cleanup.
authorJohn Benediktsson <mrjbq7@gmail.com>
Mon, 1 Dec 2014 03:26:23 +0000 (19:26 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Mon, 1 Dec 2014 03:26:23 +0000 (19:26 -0800)
13 files changed:
basis/dlists/dlists.factor
basis/formatting/formatting.factor
basis/heaps/heaps.factor
basis/help/markup/markup.factor
basis/inverse/inverse.factor
basis/io/launcher/launcher.factor
basis/math/polynomials/polynomials.factor
basis/xmode/loader/loader.factor
basis/xmode/marker/marker.factor
basis/xmode/tokens/tokens.factor
extra/fjsc/fjsc.factor
extra/project-euler/018/018.factor
extra/project-euler/common/common.factor

index 8d1d47f5a4c83cb88098ef49da8997d7dbaf17d3..263dd62cdcf4fb5c24bb4e0ccff710a4dbf40226 100644 (file)
@@ -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
index 1aedd07afb380b8d6e487169f66a31c102e6bc1a..aa7d6c0f8012c85445cf700c8a9bbe1c1ab7da05 100644 (file)
@@ -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 ;
index dccf1e5e5500542f82130dd3df8a1efed50a0fb2..109d96bd5196732cde6ae1e80b92b9fdd7378535 100644 (file)
@@ -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 ;
index eba7bfed52ca341c465019eec5bf210c66d3e83e..70a0c85b4392ebe4883098850d096d008c70e9f8 100644 (file)
@@ -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>> [
index 35399c0132d80d037abd854bda34b1f4ce0f1607..3a2465df219cd295d618aa7f89e3459a5f54973d 100644 (file)
@@ -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
index ac9a87a84439648bad3e671dcf47acb281811c38..5b8cb401b35ff0bfe06ae145a6aa5dd7577cd347 100755 (executable)
@@ -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 ;
index 1212f630514a764915f35c119c375e109080c525..cb0ef80130a5574b5f4d92e9b543b68829033572 100644 (file)
@@ -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
index 12e992824f107f1a381ac6cde035c6b8e9bbec6a..0d9cd03a01b82ec2f6f447361433426f190dcbbf 100644 (file)
@@ -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
index 3276e6594fba4faa101a0e2a66a1b26d3a670ba5..8f8776dc466e97c68d1d8563dc58541f9a1be323 100644 (file)
@@ -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
index 945f4bb0465a8ebf290ea45f7bd474be93dbff9d..8a5d8afbf639e8861eae14ca7be79ccf3348ec65 100644 (file)
@@ -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
 >>
 
index 919823cca3f245948fefc84b7ef7348b092e1991..8c2e883c58d6f4ed6acbf8f06de7eaa0460b7d4f 100644 (file)
@@ -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
index 9189323121a28479e0e881bb1da28d9ba36a688a..8a384c9d6c4b5ea3c9957d016ba48939cba00717 100644 (file)
@@ -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>
 
index ddadd4079a3a03c2a359a9de943880d0c2666095..3fc7134254b450cdc49fe6aea69e3bceb9d11afc 100644 (file)
@@ -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 < ;