parse-paragraph paragraph boa ;
: cut-half-slice ( string i -- before after-slice )
- [ head ] [ 1 + cramp tail-slice ] 2bi ;
+ [ head ] [ 1 + bound tail-slice ] 2bi ;
: find-cut ( string quot -- before after delimiter )
dupd find
{ "(each-integer)" { "each-integer-from" "0.99" } }
{ "(find-integer)" { "find-integer-from" "0.99" } }
{ "(all-integers?)" { "all-integers-from?" "0.99" } }
- { "short" { "cramp" "0.99" } }
+ { "short" { "bound" "0.99" } }
{ "map-integers" { "map-integers-as" "0.99" } }
}
sign_ = [+ ] => [[ '[ dup first CHAR: - = [ _ prefix ] unless ] ]]
sign = (sign_)? => [[ [ ] or ]]
-width_ = "." ([0-9])* => [[ second >digits '[ _ cramp head ] ]]
+width_ = "." ([0-9])* => [[ second >digits '[ _ bound head ] ]]
width = (width_)? => [[ [ ] or ]]
digits_ = "." ([0-9])* => [[ second >digits ]]
} cleave ;
: process-entries ( seq -- seq' )
- 20 cramp head-slice [
+ 20 bound head-slice [
>entry clone
[ adjust-url ] change-url
] map ;
completions [
[
{ $heading search } ,
- [ max-completions cramp head keys \ $completions prefix , ]
+ [ max-completions bound head keys \ $completions prefix , ]
[
length max-completions >
[ { $link T{ more-completions f completions search category } } , ] when
: trim-whitespace ( seq -- seq' )
dup rest-slice dup whitespace
- [ '[ _ cramp tail ] map! ] unless-zero drop
+ [ '[ _ bound tail ] map! ] unless-zero drop
0 over [ [ blank? ] trim-head ] change-nth ;
: code-lines ( str -- seq )
drop ;
: recent-histogram ( assoc n -- alist )
- [ sort-values <reversed> ] dip cramp head ;
+ [ sort-values <reversed> ] dip bound head ;
: analyze-entries ( entries word-names -- errors word-histogram message-histogram )
[
i text end find-subseq-from [| j |
i j text subseq % j end length +
] [
- text i cramp tail % CHAR: \n ,
+ text i bound tail % CHAR: \n ,
lexer next-line
0 end lexer (scan-multiline-string)
] if*
] [ ] make ;
: remove-breakpoints ( quot pos -- quot' )
- 1 + cramp cut [ (remove-breakpoints) ] bi@ [ => ] glue ;
+ 1 + bound cut [ (remove-breakpoints) ] bi@ [ => ] glue ;
: optimized-frame? ( triple -- ? ) second word? ;
[ drop-comment ] map harvest ;
: split-column ( line -- columns )
- " \t" split harvest 2 cramp head 2 f pad-tail ;
+ " \t" split harvest 2 bound head 2 f pad-tail ;
: parse-hex ( s -- n )
dup [
{ ";" } split1-last [ ] [ ] ?if ;
: complete-vocab-list? ( tokens -- ? )
- chop-; 1 cramp head* "USING:" swap member? ;
+ chop-; 1 bound head* "USING:" swap member? ;
PRIVATE>
] "" make ;
: <trace-step> ( continuation word -- trace-step )
- [ nip ] [ [ data>> ] [ stack-effect in>> length ] bi* cramp tail* ] 2bi
+ [ nip ] [ [ data>> ] [ stack-effect in>> length ] bi* bound tail* ] 2bi
\ trace-step-state boa ;
: print-step ( continuation -- )
dup children>> length 200,000 > [
! We let the length oscillate between 100k-200k, so we don't
! have to relayout the container every time a gadget is added.
- [ 100,000 cramp cut* ] change-children
+ [ 100,000 bound cut* ] change-children
! Unfocus if any focused gadgets were removed and relayout
dup focus>> pick member-eq? [ f >>focus ] when relayout yield
[ completion-popup? ] find-parent ;
: <completion-model> ( editor element quot -- model )
- [ <element-model> ] dip '[ @ >alist 100
cramp head ] <arrow> ;
+ [ <element-model> ] dip '[ @ >alist 100
bound head ] <arrow> ;
M: completion-popup focusable-child* table>> ;
n [ 0 ] [
drop
interactor interactor-read dup [ join-lines ] when
- n cramp [ head-slice 0 buf copy ] keep
+ n bound [ head-slice 0 buf copy ] keep
] if-zero ;
M: interactor stream-read1
: uuid3 ( namespace name -- string )
[ uuid-parse ] dip append
- md5 checksum-bytes 16 cramp head be>
+ md5 checksum-bytes 16 bound head be>
3 (version) uuid>string ;
: uuid4 ( -- string )
: uuid5 ( namespace name -- string )
[ uuid-parse ] dip append
- sha1 checksum-bytes 16 cramp head be>
+ sha1 checksum-bytes 16 bound head be>
5 (version) uuid>string ;
: uuid6 ( -- string )
}
"When a sequence may not have enough elements:"
{ $example "USING: sequences prettyprint ;"
- "{ 1 2 } 5 cramp head ."
+ "{ 1 2 } 5 bound head ."
"{ 1 2 }"
}
}
}
"When a sequence may not have enough elements:"
{ $example "USING: sequences prettyprint ;"
- "{ 1 2 } 5 cramp tail ."
+ "{ 1 2 } 5 bound tail ."
"{ }"
}
}
}
"When a sequence may not have enough elements:"
{ $example "USING: sequences prettyprint ;"
- "{ 1 2 } 5 cramp head* ."
+ "{ 1 2 } 5 bound head* ."
"{ }"
}
}
}
"When a sequence may not have enough elements:"
{ $example "USING: sequences prettyprint ;"
- "{ 1 2 } 5 cramp tail* ."
+ "{ 1 2 } 5 bound tail* ."
"{ 1 2 }"
}
}
{ "newhash" integer } }
{ $description "An implementation word that computes a running hashcode of a sequence using some bit-twiddling. The resulting hashcode is always a fixnum." } ;
-HELP: cramp
+HELP: bound
{ $values
{ "seq" sequence } { "n" integer } { "n'" integer } }
{ $description "Returns the input sequence and its length or " { $snippet "n" } ", whichever is less." }
{ $examples { $example "USING: sequences kernel prettyprint ;"
- "\"abcd\" 3 cramp [ . ] bi@"
+ "\"abcd\" 3 bound [ . ] bi@"
"\"abcd\"\n3"
} } ;
M: slice length [ to>> ] [ from>> ] bi - ; inline
-: cramp ( seq n -- seq n' ) over length min ; inline
+: bound ( seq n -- seq n' ) over length min ; inline
: head-slice ( seq n -- slice ) head-to-index <slice> ; inline
" " % cpu name>> %
" (" % build # ", " %
vm-git-ref % "-" %
- vm-git-id 10 cramp head % ", " %
+ vm-git-id 10 bound head % ", " %
vm-compile-time % ")\n[" %
vm-compiler % "] on " % os name>> %
] "" make ;
[ uses-make? [ "uses make" print ] when ]
[ rc-files [ length "has %d rc files" sprintf print ] unless-empty ]
[ ignore-files [ length "has %d ignore files" sprintf print ] unless-empty nl ]
- [ "Top 20 largest files" print file-sizes sort-values 20 cramp tail* [ normalize-path ] map-keys reverse assoc. nl ]
- [ "Top 10 file extension sizes" print sum-sizes-by-extension 10 cramp tail* reverse assoc. nl ]
- [ "Top 10 text file line counts" print sum-line-counts-by-extension 10 cramp tail* reverse assoc. nl ]
- [ "Top 10 file extension counts" print count-by-file-extension 10 cramp tail* reverse assoc. nl ]
+ [ "Top 20 largest files" print file-sizes sort-values 20 bound tail* [ normalize-path ] map-keys reverse assoc. nl ]
+ [ "Top 10 file extension sizes" print sum-sizes-by-extension 10 bound tail* reverse assoc. nl ]
+ [ "Top 10 text file line counts" print sum-line-counts-by-extension 10 bound tail* reverse assoc. nl ]
+ [ "Top 10 file extension counts" print count-by-file-extension 10 bound tail* reverse assoc. nl ]
} cleave ;
: analyze-codebase ( path -- )
: hex-rgb ( array -- array' )
[
- 8 cramp tail*
- 2 cramp head
+ 8 bound tail*
+ 2 bound head
2 CHAR: 0 pad-head
] map ;
"https://hacker-news.firebaseio.com/v0/item/%d.json?print=pretty" sprintf ;
: hacker-news-items ( n endpoint -- seq )
- hacker-news-ids swap cramp head
+ hacker-news-ids swap bound head
[ hacker-news-id>json-url http-get nip json> ] parallel-map ;
: hacker-news-top-stories ( n -- seq )
[ 10 over size>> 10 + ] dip <slice> filter-text-data ;
: decode-text ( string -- string' )
- dup 2 cramp head
+ dup 2 bound head
{ { 0xff 0xfe } { 0xfe 0xff } } member?
utf16 ascii ? decode ;
: report-subject ( status -- string )
[
subject-prefix %
- current-git-id get 7 cramp head %
+ current-git-id get 7 bound head %
" -- " %
{
{ status-clean [ "clean" ] }
] with-file-writer ; inline
: file-tail ( file encoding lines -- seq )
- [ file-lines ] dip cramp tail* join-lines ;
+ [ file-lines ] dip bound tail* join-lines ;
:: failed-report ( error file what -- status )
[
[
over ?line-break
over [ font>> ] [ avail-width ] bi visual-wrap
- over avail-lines cramp cut
+ over avail-lines bound cut
[ draw-text ] [ "" concat-as ] bi*
] change-string dup string>> empty? [ drop f ] when ;
[ { } ] [ over [ font>> ] [ width ] bi visual-wrap ]
if-empty
] dip [ prefix ] when*
- over avail-lines cramp cut
+ over avail-lines bound cut
[ draw-text ] [ "" concat-as ] bi*
] change-string dup string>> empty? [ drop f ] when ;
<PRIVATE
: next ( seq -- )
- [ 4 cramp tail* sum ] keep push ;
+ [ 4 bound tail* sum ] keep push ;
: (euler117) ( n -- m )
[ V{ 1 } clone ] dip over [ next ] curry times last ;
[ [ salary>> ] inv-sort-with ] assoc-map ;
: first-n-each ( seq n quot -- )
- [ cramp head-slice ] dip each ; inline
+ [ bound head-slice ] dip each ; inline
: top-rank-main ( -- )
employees prepare-departments [
: process-timings ( -- )
timings get sort-values
- [ slowest cramp tail* reverse slowest-pages set ]
+ [ slowest bound tail* reverse slowest-pages set ]
[
values [
[ mean 1000000 /f mean-time set ]
: syslog ( message level -- )
utf8 [ write-syslog ] with-byte-writer
- 1024 cramp head
+ 1024 bound head
syslog-server get-global
$[ f 0 <inet4> <datagram> ]
send ;
! right of the index, plus one that's not equal, if requested.
:: adjusted-head-slice ( n elt plus-one? seq -- slice )
n seq elt x '[ x _ = not ] find-from drop seq swap
- [ plus-one? [ 1 + ] when cramp head-slice ] when* ;
+ [ plus-one? [ 1 + ] when bound head-slice ] when* ;
! : data-rect ( data -- rect )
! [ [ first x ] [ last x ] bi ] keep
[ date>> ] inv-sort-with ;
: update-cached-postings ( -- )
- blogroll fetch-blogroll sort-entries 8 cramp head [
+ blogroll fetch-blogroll sort-entries 8 bound head [
posting new delete-tuples
[ insert-tuple ] each
] with-transaction ;
: sanitize ( title -- title' )
[ 0 31 between? ] reject
[ "\"#$%'*,./:;<>?^|~\\" member? ] reject
- 200 cramp head ;
+ 200 bound head ;
: downloadable? ( video-info -- ? )
"use_cipher_signature" of "False" = ;
projects / factor.git / commitdiff