steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

more minor cleanup.

db4
John Benediktsson 2014-11-30 19:26:23 -08:00
parent 1e8dedb808
commit 76761b2e59
13 changed files with 54 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/dlists/dlists.factor
View 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

12
basis/formatting/formatting.factor
View File

@ -14,12 +14,12 @@ 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 ] }
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

2
basis/heaps/heaps.factor
View 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 ;

2
basis/help/markup/markup.factor
View 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>> [

2
basis/inverse/inverse.factor
View 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

2
basis/io/launcher/launcher.factor
View File

@ -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 ;

2
basis/xmode/loader/loader.factor
View 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

2
basis/xmode/marker/marker.factor
View 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

10
basis/xmode/tokens/tokens.factor
View 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
>>

23
extra/fjsc/fjsc.factor
View 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

24
extra/project-euler/018/018.factor
View 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

11
extra/project-euler/common/common.factor
View 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 < ;