I also removed aliases for start/end from interval-maps and interval-sets and added a comment. I don't think it's any less clear what's going on.
: framework-find ( name -- path )
dup dyld-find [ nip ] [
- ".framework" over start [
+ ".framework" over subseq-start [
dupd head
] [
[ ".framework" append ] keep
+controller-states+ get-global keys [ controller boa ] map ;
: ?join ( pre post sep -- string )
- 2over start [ swap 2nip ] [ [ 2array ] dip join ] if ;
+ 2over subseq-start [ swap 2nip ] [ [ 2array ] dip join ] if ;
M: iokit-game-input-backend product-string ( controller -- string )
handle>>
DEFER: <% delimiter
: check-<% ( lexer -- col )
- "<%" swap [ line-text>> ] [ column>> ] bi start* ;
+ "<%" swap [ line-text>> ] [ column>> ] bi subseq-start-from ;
: found-<% ( accum lexer col -- accum )
[
locals make math math.order sequences sequences.private sorting ;
IN: interval-maps
+! Intervals are triples of { start end value }
TUPLE: interval-map { array array read-only } ;
<PRIVATE
-ALIAS: start first-unsafe
-ALIAS: end second-unsafe
-ALIAS: value third-unsafe
-
: find-interval ( key interval-map -- interval-node )
- array>> [ start <=> ] with search nip ; inline
+ array>> [ first-unsafe <=> ] with search nip ; inline
: interval-contains? ( key interval-node -- ? )
first2-unsafe between? ; inline
[ [ dup number? [ dup 2array ] when ] dip ] { } assoc-map-as ;
: disjoint? ( node1 node2 -- ? )
- [ end ] [ start ] bi* < ;
+ [ second-unsafe ] [ first-unsafe ] bi* < ;
: ensure-disjoint ( intervals -- intervals )
dup [ disjoint? ] monotonic?
check-interval-map
[ drop ] [ find-interval ] 2bi
[ nip ] [ interval-contains? ] 2bi
- [ value t ] [ drop f f ] if ; inline
+ [ third-unsafe t ] [ drop f f ] if ; inline
: interval-at ( key map -- value ) interval-at* drop ; inline
: interval-key? ( key map -- ? ) interval-at* nip ; inline
: interval-values ( map -- values )
- check-interval-map array>> [ value ] map ;
+ check-interval-map array>> [ third-unsafe ] map ;
: <interval-map> ( specification -- map )
all-intervals [ first-unsafe second-unsafe ] sort-with
IN: interval-sets
! Sets of positive integers
+! Intervals are a pair of { start end }
TUPLE: interval-set { array uint-array read-only } ;
<PRIVATE
: spec>pairs ( sequence -- intervals )
[ dup number? [ dup 2array ] when ] map ;
-ALIAS: start first-unsafe
-ALIAS: end second-unsafe
-
: disjoint? ( node1 node2 -- ? )
- [ end ] [ start ] bi* < ;
+ [ second-unsafe ] [ first-unsafe ] bi* < ;
: (delete-redundancies) ( seq -- )
dup length {
: dump-until-separator ( multipart -- multipart )
dup
[ current-separator>> ] [ bytes>> ] bi
- [ nip ] [ start ] 2bi [
+ [ nip ] [ subseq-start ] 2bi [
cut-slice
[ mime-write ]
[ over current-separator>> length short tail-slice >>bytes ] bi*
:: (scan-multiline-string) ( i end lexer -- j )
lexer line-text>> :> text
lexer still-parsing? [
- end text i start* [| j |
+ end text i subseq-start-from [| j |
i j text subseq % j end length +
] [
text i short tail % CHAR: \n ,
{ [ dup "/" head? ] [ nip ] }
{ [ dup empty? ] [ drop ] }
{ [ over "/" tail? ] [ append ] }
- { [ "/" pick start not ] [ nip ] }
+ { [ "/" pick subseq-start not ] [ nip ] }
[ [ "/" split1-last drop "/" ] dip 3append ]
} cond ;
{ $values { "seq" sequence } { "n" "a non-negative integer" } { "before" sequence } { "after" sequence } }
{ $description "Outputs a pair of sequences, where " { $snippet "after" } " consists of the last " { $snippet "n" } " elements of " { $snippet "seq" } ", while " { $snippet "before" } " holds the remaining elements. Both output sequences have the same type as " { $snippet "seq" } "." } ;
-HELP: start*
+HELP: subseq-start-from
{ $values { "subseq" sequence } { "seq" sequence } { "n" "a start index" } { "i" "a start index" } }
{ $description "Outputs the start index of the first contiguous subsequence equal to " { $snippet "subseq" } ", starting the search from the " { $snippet "n" } "th element. If no matching subsequence is found, outputs " { $link f } "." } ;
-HELP: start
+HELP: subseq-start
{ $values { "subseq" sequence } { "seq" sequence } { "i" "a start index" } }
{ $description "Outputs the start index of the first contiguous subsequence equal to " { $snippet "subseq" } ", or " { $link f } " if no matching subsequence is found." } ;
last-index-from
}
"Finding the start of a subsequence:"
-{ $subsections start start* }
+{ $subsections subseq-start subseq-start-from }
"Finding the index of an element satisfying a predicate:"
{ $subsections
find
<PRIVATE
-: (start) ( subseq seq n length -- subseq seq ? )
+: (subseq-start-from) ( subseq seq n length -- subseq seq ? )
[
[ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe =
] all-integers? nip ; inline
PRIVATE>
-: start* ( subseq seq n -- i )
+: subseq-start-from ( subseq seq n -- i )
pick length [ pick length swap - 1 + ] keep
- [ (start) ] curry (find-integer) 2nip ;
+ [ (subseq-start-from) ] curry (find-integer) 2nip ;
-: start ( subseq seq -- i ) 0 start* ; inline
+: subseq-start ( subseq seq -- i ) 0 subseq-start-from ; inline
-: subseq? ( subseq seq -- ? ) start >boolean ;
+: subseq? ( subseq seq -- ? ) subseq-start >boolean ;
: drop-prefix ( seq1 seq2 -- slice1 slice2 )
2dup mismatch [ 2dup min-length ] unless*
: (split1) ( seq subseq snip-quot -- before after )
[
swap [
- [ drop length ] [ start dup ] 2bi
+ [ drop length ] [ subseq-start dup ] 2bi
[ [ nip ] [ + ] 2bi t ]
[ 2drop f f f ]
if
{ "abc" } [ "ab" "c" append ] unit-test
{ "abc" } [ "a" "b" "c" 3append ] unit-test
-{ 3 } [ "a" "hola" start ] unit-test
-{ f } [ "x" "hola" start ] unit-test
-{ 0 } [ "" "a" start ] unit-test
-{ 0 } [ "" "" start ] unit-test
-{ 0 } [ "hola" "hola" start ] unit-test
-{ 1 } [ "ol" "hola" start ] unit-test
-{ f } [ "amigo" "hola" start ] unit-test
-{ f } [ "holaa" "hola" start ] unit-test
+{ 3 } [ "a" "hola" subseq-start ] unit-test
+{ f } [ "x" "hola" subseq-start ] unit-test
+{ 0 } [ "" "a" subseq-start ] unit-test
+{ 0 } [ "" "" subseq-start ] unit-test
+{ 0 } [ "hola" "hola" subseq-start ] unit-test
+{ 1 } [ "ol" "hola" subseq-start ] unit-test
+{ f } [ "amigo" "hola" subseq-start ] unit-test
+{ f } [ "holaa" "hola" subseq-start ] unit-test
{ "Beginning" } [ "Beginning and end" 9 head ] unit-test
{ "hi " "there" } [
"hi there" {
- { [ "there" over start ] [ cut ] }
+ { [ "there" over subseq-start ] [ cut ] }
[ f ]
} cond*
] unit-test
{ "hi " "there" } [
"hi there" {
- { [ "foo" over start ] [ head f ] }
- { [ "there" over start ] [ cut ] }
+ { [ "foo" over subseq-start ] [ head f ] }
+ { [ "there" over subseq-start ] [ cut ] }
[ f ]
} cond*
] unit-test
{ "hi there" f } [
"hi there" {
- { [ "foo" over start ] [ head f ] }
- { [ "bar" over start ] [ cut ] }
+ { [ "foo" over subseq-start ] [ head f ] }
+ { [ "bar" over subseq-start ] [ cut ] }
[ f ]
} cond*
] unit-test
: prolog-encoding ( string -- iana-encoding )
'[
- _ "encoding=" over start
+ _ "encoding=" over subseq-start
10 + swap [ [ 1 - ] dip nth ] [ index-from ] [ swapd subseq ] 2tri
] [ drop "UTF-8" ] recover ;
] each sieve get ;
: consecutive-under ( m limit -- n/f )
- prime-tau-upto [ dup <repetition> ] dip start ;
+ prime-tau-upto [ dup <repetition> ] dip subseq-start ;
PRIVATE>
: web-scraping-main ( -- )
"http://tycho.usno.navy.mil/cgi-bin/timer.pl" http-get nip
- [ "UTC" swap start [ 9 - ] [ 1 - ] bi ] keep subseq print ;
+ [ "UTC" swap subseq-start [ 9 - ] [ 1 - ] bi ] keep subseq print ;
MAIN: web-scraping-main
:: (start-all) ( subseq seq increment -- indices )
0
- [ [ subseq seq ] dip start* dup ]
+ [ [ subseq seq ] dip subseq-start-from dup ]
[ [ increment + ] keep ] produce nip ;
: start-all ( subseq seq -- indices )
syn keyword factorKeyword 2cache <enum> >alist ?at ?of assoc assoc-all? assoc-any? assoc-clone-like assoc-combine assoc-diff assoc-diff! assoc-differ assoc-each assoc-empty? assoc-filter assoc-filter! assoc-filter-as assoc-find assoc-hashcode assoc-intersect assoc-like assoc-map assoc-map-as assoc-partition assoc-refine assoc-reject assoc-reject! assoc-reject-as assoc-size assoc-stack assoc-subset? assoc-union assoc-union! assoc= assoc>map assoc? at at* at+ cache change-at clear-assoc delete-at delete-at* enum enum? extract-keys harvest-keys harvest-values inc-at key? keys map>alist map>assoc maybe-set-at new-assoc of push-at rename-at set-at sift-keys sift-values substitute unzip value-at value-at* value? values zip zip-as zip-index zip-index-as
syn keyword factorKeyword 2cleave 2cleave>quot 3cleave 3cleave>quot 4cleave 4cleave>quot alist>quot call-effect case case-find case>quot cleave cleave>quot cond cond>quot deep-spread>quot execute-effect linear-case-quot no-case no-case? no-cond no-cond? recursive-hashcode shallow-spread>quot spread to-fixed-point wrong-values wrong-values?
syn keyword factorKeyword (all-integers?) (each-integer) (find-integer) * + - / /f /i /mod 2/ 2^ < <= <fp-nan> > >= >bignum >fixnum >float >fraction >integer >rect ?1+ abs align all-integers? bignum bignum? bit? bitand bitnot bitor bits>double bits>float bitxor complex complex? denominator double>bits each-integer even? fast-gcd find-integer find-last-integer fixnum fixnum? float float>bits float? fp-bitwise= fp-infinity? fp-nan-payload fp-nan? fp-qnan? fp-sign fp-snan? fp-special? gcd if-zero imaginary-part integer integer>fixnum integer>fixnum-strict integer? log2 log2-expects-positive log2-expects-positive? mod neg neg? next-float next-power-of-2 number number= number? numerator odd? power-of-2? prev-float ratio ratio? rational rational? real real-part real? recip rect> rem sgn shift sq times u< u<= u> u>= unless-zero unordered? when-zero zero?
-syn keyword factorKeyword 1sequence 2all? 2each 2each-from 2map 2map-as 2map-reduce 2reduce 2selector 2sequence 3append 3append-as 3each 3map 3map-as 3sequence 4sequence <repetition> <reversed> <slice> ?first ?last ?nth ?second ?set-nth accumulate accumulate! accumulate-as all? any? append append! append-as assert-sequence assert-sequence= assert-sequence? binary-reduce bounds-check bounds-check? bounds-error bounds-error? but-last but-last-slice cartesian-each cartesian-map cartesian-product change-nth check-slice clone-like collapse-slice collector collector-for concat concat-as copy count cut cut* cut-slice delete-all delete-slice drop-prefix each each-from each-index empty? exchange filter filter! filter-as find find-from find-index find-index-from find-last find-last-from first first2 first3 first4 flip follow fourth glue halves harvest head head* head-slice head-slice* head? if-empty immutable immutable-sequence immutable-sequence? immutable? index index-from indices infimum infimum-by insert-nth interleave iota iota-tuple iota-tuple? join join-as last last-index last-index-from length lengthen like longer longer? longest map map! map-as map-find map-find-last map-index map-index-as map-integers map-reduce map-sum max-length member-eq? member? midpoint@ min-length mismatch move new-like new-resizable new-sequence non-negative-integer-expected non-negative-integer-expected? nth nths pad-head pad-tail padding partition pop pop* prefix prepend prepend-as produce produce-as product push push-all push-either push-if reduce reduce-index reject reject! reject-as remove remove! remove-eq remove-eq! remove-nth remove-nth! repetition repetition? replace-slice replicate replicate-as rest rest-slice reverse reverse! reversed reversed? second selector selector-for sequence sequence-hashcode sequence= sequence? set-first set-fourth set-last set-length set-nth set-second set-third short shorten shorter shorter? shortest sift slice slice-error slice-error? slice? snip snip-slice start start* subseq subseq? suffix suffix! sum sum-lengths supremum supremum-by surround tail tail* tail-slice tail-slice* tail? third trim trim-head trim-head-slice trim-slice trim-tail trim-tail-slice unclip unclip-last unclip-last-slice unclip-slice unless-empty virtual-exemplar virtual-sequence virtual-sequence? virtual@ when-empty
+syn keyword factorKeyword 1sequence 2all? 2each 2each-from 2map 2map-as 2map-reduce 2reduce 2selector 2sequence 3append 3append-as 3each 3map 3map-as 3sequence 4sequence <repetition> <reversed> <slice> ?first ?last ?nth ?second ?set-nth accumulate accumulate! accumulate-as all? any? append append! append-as assert-sequence assert-sequence= assert-sequence? binary-reduce bounds-check bounds-check? bounds-error bounds-error? but-last but-last-slice cartesian-each cartesian-map cartesian-product change-nth check-slice clone-like collapse-slice collector collector-for concat concat-as copy count cut cut* cut-slice delete-all delete-slice drop-prefix each each-from each-index empty? exchange filter filter! filter-as find find-from find-index find-index-from find-last find-last-from first first2 first3 first4 flip follow fourth glue halves harvest head head* head-slice head-slice* head? if-empty immutable immutable-sequence immutable-sequence? immutable? index index-from indices infimum infimum-by insert-nth interleave iota iota-tuple iota-tuple? join join-as last last-index last-index-from length lengthen like longer longer? longest map map! map-as map-find map-find-last map-index map-index-as map-integers map-reduce map-sum max-length member-eq? member? midpoint@ min-length mismatch move new-like new-resizable new-sequence non-negative-integer-expected non-negative-integer-expected? nth nths pad-head pad-tail padding partition pop pop* prefix prepend prepend-as produce produce-as product push push-all push-either push-if reduce reduce-index reject reject! reject-as remove remove! remove-eq remove-eq! remove-nth remove-nth! repetition repetition? replace-slice replicate replicate-as rest rest-slice reverse reverse! reversed reversed? second selector selector-for sequence sequence-hashcode sequence= sequence? set-first set-fourth set-last set-length set-nth set-second set-third short shorten shorter shorter? shortest sift slice slice-error slice-error? slice? snip snip-slice subseq-start subseq-start-from subseq subseq? suffix suffix! sum sum-lengths supremum supremum-by surround tail tail* tail-slice tail-slice* tail? third trim trim-head trim-head-slice trim-slice trim-tail trim-tail-slice unclip unclip-last unclip-last-slice unclip-slice unless-empty virtual-exemplar virtual-sequence virtual-sequence? virtual@ when-empty
syn keyword factorKeyword +@ change change-global counter dec get get-global get-namestack global inc init-namespaces initialize namespace off on set set-global set-namestack toggle with-global with-scope with-variable with-variables
syn keyword factorKeyword 1array 2array 3array 4array <array> >array array array? pair pair? resize-array
syn keyword factorKeyword (each-stream-block) (each-stream-block-slice) (stream-contents-by-block) (stream-contents-by-element) (stream-contents-by-length) (stream-contents-by-length-or-block) +byte+ +character+ bad-seek-type bad-seek-type? bl contents each-block each-block-size each-block-slice each-line each-morsel each-stream-block each-stream-block-slice each-stream-line error-stream flush input-stream input-stream? invalid-read-buffer invalid-read-buffer? lines nl output-stream output-stream? print read read-into read-partial read-partial-into read-until read1 readln seek-absolute seek-absolute? seek-end seek-end? seek-input seek-output seek-relative seek-relative? stream-bl stream-contents stream-contents* stream-copy stream-copy* stream-element-type stream-flush stream-length stream-lines stream-nl stream-print stream-read stream-read-into stream-read-partial stream-read-partial-into stream-read-partial-unsafe stream-read-unsafe stream-read-until stream-read1 stream-readln stream-seek stream-seekable? stream-tell stream-write stream-write1 tell-input tell-output with-error-stream with-error-stream* with-error>output with-input-output+error-streams with-input-output+error-streams* with-input-stream with-input-stream* with-output+error-stream with-output+error-stream* with-output-stream with-output-stream* with-output>error with-streams with-streams* write write1
projects / factor.git / commitdiff