[ (hms>timestamp) ] with-string-reader ;\r
\r
: (ymd>timestamp) ( -- timestamp )\r
- read-ymd 0 0 0 instant <timestamp> ;\r
+ read-ymd <date-gmt> ;\r
\r
: ymd>timestamp ( str -- timestamp )\r
[ (ymd>timestamp) ] with-string-reader ;\r
[ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
[ t ] [
- [ 3 <direct-struct-test-optimization-array> third y>> ]
+ [ 3 struct-test-optimization <c-direct-array> third y>> ]
{ <tuple> <tuple-boa> memory>struct y>> } inlined?
] unit-test
over unparse-content-type "content-type" pick set-at
over cookies>> [
ensure-domain unparse-set-cookie
- "set-cookie" swap 2array over push
+ "set-cookie" swap 2array suffix!
] each
write-header ;
dup last V{ } = not [ v-over-push ] when ;
: (close-array) ( accum -- accum' )
- (close) dup pop >array over push ;
+ (close) dup pop >array suffix! ;
: (close-hash) ( accum -- accum' )
- (close) dup dup [ pop ] bi@ swap zip >hashtable over push ;
+ (close) dup dup [ pop ] bi@ swap zip >hashtable suffix! ;
: scan ( accum char -- accum )
! 2dup 1string swap . . ! Great for debug...
{
- { CHAR: \" [ j-string over push ] }
- { CHAR: [ [ V{ } clone over push ] }
+ { CHAR: \" [ j-string suffix! ] }
+ { CHAR: [ [ V{ } clone suffix! ] }
{ CHAR: , [ v-over-push ] }
{ CHAR: ] [ (close-array) ] }
- { CHAR: { [ 2 [ V{ } clone over push ] times ] }
+ { CHAR: { [ 2 [ V{ } clone suffix! ] times ] }
{ CHAR: : [ v-pick-push ] }
{ CHAR: } [ (close-hash) ] }
{ CHAR: \s [ ] }
{ CHAR: \t [ ] }
{ CHAR: \r [ ] }
{ CHAR: \n [ ] }
- { CHAR: t [ 3 read drop t over push ] }
- { CHAR: f [ 4 read drop f over push ] }
- { CHAR: n [ 3 read drop json-null over push ] }
- [ value [ over push ] dip [ scan ] when* ]
+ { CHAR: t [ 3 read drop t suffix! ] }
+ { CHAR: f [ 4 read drop f suffix! ] }
+ { CHAR: n [ 3 read drop json-null suffix! ] }
+ [ value [ suffix! ] dip [ scan ] when* ]
} case ;
PRIVATE>
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators combinators.smart fry kernel
macros math math.bits sequences sequences.private words
-byte-arrays alien alien.c-types specialized-arrays ;
+byte-arrays alien alien.c-types alien.data specialized-arrays ;
SPECIALIZED-ARRAY: uchar
IN: math.bitwise
byte-array-bit-count ;
M: object bit-count
- binary-object <direct-uchar-array> byte-array-bit-count ;
+ binary-object uchar <c-direct-array> byte-array-bit-count ;
: even-parity? ( obj -- ? ) bit-count even? ;
<combo> apply-combination ;
: all-combinations ( seq k -- seq' )
- [ ] combinations-quot map ;
+ [ ] map-combinations ;
: reduce-combinations ( seq k identity quot -- result )
[ -rot ] dip each-combination ; inline
: 2pad-head ( p q n -- p q ) [ 0 pad-head ] curry bi@ ;
: 2pad-tail ( p q n -- p q ) [ 0 pad-tail ] curry bi@ ;
-: pextend ( p q -- p q ) 2dup [ length ] bi@ max 2pad-tail ;
-: pextend-left ( p q -- p q ) 2dup [ length ] bi@ max 2pad-head ;
+: pextend ( p q -- p q ) 2dup max-length 2pad-tail ;
+: pextend-left ( p q -- p q ) 2dup max-length 2pad-head ;
: unempty ( seq -- seq ) [ { 0 } ] when-empty ;
: 2unempty ( seq seq -- seq seq ) [ unempty ] bi@ ;
[ loc>> first ] 2dip swap [ first ] bi@ - min 0 max ;
: preferred-y ( visible-rect -- y )
- [ loc>> ] [ dim>> ] bi [ second ] bi@ + ;
+ rect-bounds [ second ] bi@ + ;
: alternate-y ( visible-rect popup-dim -- y )
[ loc>> ] dip [ second ] bi@ - ;
: popup-rect ( visible-rect popup-dim screen-dim -- rect )
[ adjust-visible-rect ] 2keep
- [ popup-loc dup ] 2keep popup-dim <rect> ;
\ No newline at end of file
+ [ popup-loc dup ] 2keep popup-dim <rect> ;
: mode ( seq -- x )
histogram >alist
- [ ] [ [ [ second ] bi@ > ] 2keep ? ] map-reduce first ;
+ [ ] [ [ [ second ] bi@ > ] most ] map-reduce first ;
ERROR: empty-sequence ;
'[ @ _ _ _ alien-indirect ] ;
:: define-indirect ( abi return function-name function-ptr-quot types names -- )
- function-name create-in dup reset-generic
+ function-name create-function
function-ptr-quot return types abi indirect-quot
names return function-effect
define-declared ;
ERR_clear_error f ERR_error_string ;
: ssl-error-string ( -- string )
- ERR_get_error ERR_clear_error f ERR_error_string ;
+ ERR_get_error (ssl-error-string) ;
: (ssl-error) ( -- * )
ssl-error-string throw ;
[ drop t ] satisfy ;
: search ( string parser -- seq )
- any-char-parser [ drop f ] action 2array choice repeat0
+ any-char-parser [ drop f ] action 2choice repeat0
[ parse sift ] [ 3drop { } ] recover ;
: (replace) ( string parser -- seq )
- any-char-parser 2array choice repeat0 parse sift ;
+ any-char-parser 2choice repeat0 parse sift ;
: replace ( string parser -- result )
[ (replace) [ tree-write ] each ] with-string-writer ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: layouts kernel parser math sequences ;
+USING: layouts kernel parser math math.bitwise sequences ;
IN: persistent.hashtables.config
: radix-bits ( -- n ) << cell 4 = 4 5 ? suffix! >> ; foldable
-: radix-mask ( -- n ) radix-bits 2^ 1 - ; foldable
-: full-bitmap-mask ( -- n ) radix-bits 2^ 2^ 1 - ; inline
+: radix-mask ( -- n ) radix-bits on-bits ; foldable
+: full-bitmap-mask ( -- n ) radix-bits 2^ on-bits ; inline
: cased-range? ( range -- ? )
[ from>> ] [ to>> ] bi {
- [ [ letter? ] bi@ and ]
- [ [ LETTER? ] bi@ and ]
+ [ [ letter? ] both? ]
+ [ [ LETTER? ] both? ]
} 2|| ;
M: range-class modify-class
} cleave ;
: atom1.0 ( xml -- feed )
- feed new
- swap
+ <feed> swap
[ "title" tag-named children>string >>title ]
[ "link" tag-named "href" attr >url >>url ]
[ "entry" tags-named [ atom1.0-entry ] map set-entries ]
! On Windows, even if deploy-io is 3, C streams are still used
! for the console, so don't strip it there.
strip-io?
- deploy-io get 3 = os windows? not and
+ native-io? os windows? not and
or [
"Stripping C I/O" show
"vocab:tools/deploy/shaker/strip-c-io.factor" run-file
:: ico-group-and-icons ( bytes -- group-bytes icon-bytes )
bytes ico-header memory>struct :> header
- ico-header heap-size bytes <displaced-alien>
- header ImageCount>> <direct-ico-directory-entry-array> :> directory
+ ico-header heap-size bytes <displaced-alien>
+ header ImageCount>> ioc-directory-entry <c-direct-array> :> directory
directory dup length iota [ ico>group-directory-entry ] { } 2map-as
:> group-directory
: $values. ( word -- )
"declared-effect" word-prop [
[ in>> ] [ out>> ] bi
- 2dup [ empty? ] bi@ and [
+ 2dup [ empty? ] both? [
2drop
] [
[ members ] dip over diff
<PRIVATE
: callstack-depth ( callstack -- n )
- callstack>array length 2/ ;
+ callstack>array midpoint@ ;
SYMBOL: end
[ break ] [ end drop ] surround
with-variable ;
-<< \ trace t "no-compile" set-word-prop >>
\ No newline at end of file
+<< \ trace t "no-compile" set-word-prop >>
dup label? [ [ clone t >>bold? ] change-font ] when drop ;
: border-button-theme ( gadget -- gadget )
- dup children>> first border-button-label-theme
+ dup gadget-child border-button-label-theme
horizontal >>orientation
<border-button-pen> >>interior
dup dup interior>> pen-pref-dim >>min-dim
[ slider>screen elevator-padding + ] tri ;
: layout-thumb-loc ( thumb slider -- )
- [ thumb-loc ] [ orientation>> ] bi n*v
- [ floor ] map >>loc drop ;
+ [ thumb-loc ] [ orientation>> ] bi n*v vfloor >>loc drop ;
: layout-thumb-dim ( thumb slider -- )
[ dim>> ] [ thumb-dim ] [ orientation>> ] tri [ n*v ] keep set-axis
- [ ceiling ] map >>dim drop ;
+ vceiling >>dim drop ;
: slider-enabled? ( slider -- ? )
visible-portion 1 = not ;
: quot-action ( interactor -- lines )
[ history>> history-add drop ] [ control-value ] [ select-all ] tri
- [ parse-lines ] with-compilation-unit ;
+ parse-lines-interactive ;
: <debugger-popup> ( error continuation -- popup )
over compute-restarts [ hide-glass ] <debugger> "Error" <labeled-gadget> ;
: rule-set-empty? ( ruleset -- ? )
[ rules>> ] [ keywords>> ] bi
- [ assoc-empty? ] bi@ and ;
+ [ assoc-empty? ] both? ;
: check-word-break ( -- ? )
current-char dup blank? [
USING: kernel math math.private math.order ;
IN: math.floats.private
-: float-unordered? ( x y -- ? ) [ fp-nan? ] bi@ or ;
+: float-unordered? ( x y -- ? ) [ fp-nan? ] either? ;
: float-min ( x y -- z ) [ float< ] most ; foldable
: float-max ( x y -- z ) [ float> ] most ; foldable
: float>hex-value ( mantissa -- str )
>hex 13 CHAR: 0 pad-head [ CHAR: 0 = ] trim-tail
- [ "0" ] [ ] if-empty "1." prepend ;
+ [ "0" ] when-empty "1." prepend ;
: float>hex-expt ( mantissa -- str )
10 >base "p" prepend ;
IN: math.compare
: absmin ( a b -- x )
- [ [ abs ] bi@ < ] 2keep ? ;
+ [ [ abs ] bi@ < ] most ;
: absmax ( a b -- x )
- [ [ abs ] bi@ > ] 2keep ? ;
+ [ [ abs ] bi@ > ] most ;
: posmax ( a b -- x )
0 max max ;
dup 3 * 1 - * 2 /i ; inline
: sum-and-diff? ( m n -- ? )
- [ + ] [ - ] 2bi [ pentagonal? ] bi@ and ; inline
+ [ + ] [ - ] 2bi [ pentagonal? ] both? ; inline
: euler044-step ( min m n -- min' )
[ nth-pentagonal ] bi@
[ first "sitemap" = ] partition [ values ] dip
[
{
- [ [ first "user-agent" = ] bi@ and ]
+ [ [ first "user-agent" = ] both? ]
[ nip first "user-agent" = not ]
} 2||
] monotonic-split ;
[ [ param empty? not ] keep set-value ] each ;
: selected-capabilities ( -- seq )
- "capabilities" value [ value ] filter [ string>word ] map ;
+ "capabilities" value [ value ] filter strings>words ;
: validate-user ( -- )
{
projects / factor.git / commitdiff