basis/extra: move fewer things.

master
John Benediktsson 2020-04-01 21:36:41 -07:00
parent 42cf41e616
commit de3b74d1c6
30 changed files with 46 additions and 40 deletions

View File

@ -1,10 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2015 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image checksums checksums.openssl cli.git fry
io io.directories io.encodings.ascii io.encodings.utf8 io.files
USING: bootstrap.image checksums checksums.openssl fry io
io.directories io.encodings.ascii io.encodings.utf8 io.files
io.files.temp io.files.unique io.launcher io.pathnames kernel
make math.parser namespaces sequences splitting system ;
make math.parser namespaces sequences splitting system unicode ;
IN: bootstrap.image.upload
SYMBOL: upload-images-destination
@ -21,7 +21,11 @@ SYMBOL: build-images-destination
or ;
: factor-git-branch ( -- name )
image-path parent-directory git-current-branch ;
image-path parent-directory [
{ "git" "rev-parse" "--abbrev-ref" "HEAD" }
utf8 <process-reader> stream-contents
[ blank? ] trim-tail
] with-directory ;
: git-branch-destination ( -- dest )
build-images-destination get

View File

@ -1,6 +1,6 @@
! Copyright (C) 2015 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.extras combinators.short-circuit editors
USING: combinators.short-circuit editors
generalizations io.files io.pathnames io.standard-paths kernel
make math.parser memoize namespaces sequences system tools.which ;
IN: editors.visual-studio-code
@ -35,7 +35,7 @@ M: linux find-visual-studio-code-invocation
[ "Code" which ]
[ home "VSCode-linux-x64/Code" append-path ]
[ "/usr/share/code/code" ]
} [ [ exists? ] ?1arg ] map-compose 0|| ;
} [ dup exists? [ drop f ] unless ] map-compose 0|| ;
M: windows find-visual-studio-code-invocation
{

View File

@ -1,9 +1,8 @@
! Copyright (C) 2015, 2018 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: accessors arrays assocs assocs.extras combinators
help.markup kernel literals locals math math.parser sequences
sequences.extras splitting unicode words ;
USING: accessors arrays assocs combinators help.markup kernel
literals locals math math.order math.parser sequences splitting
unicode words ;
IN: english
<PRIVATE
@ -95,7 +94,7 @@ CONSTANT: singular-to-plural H{
}
>>
CONSTANT: plural-to-singular $[ singular-to-plural assoc-invert ]
CONSTANT: plural-to-singular $[ singular-to-plural [ swap ] assoc-map ]
:: match-case ( master disciple -- master' )
{
@ -168,8 +167,11 @@ PRIVATE>
: ?plural-article ( word -- article )
dup singular? [ a/an ] [ drop "the" ] if ;
: comma-list ( parts conjunction -- clause-seq )
[ ", " interleaved ] dip over length dup 3 >= [
: comma-list ( parts conjunction -- clause-seq )
[
[ length dup 1 [-] + ", " <array> ]
[ [ 2 * pick set-nth ] each-index ] bi
] dip over length dup 3 >= [
[ 3 > ", " " " ? " " surround ] [ 2 - pick set-nth ] bi
] [ 2drop ] if ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2017 John Benediktsson, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs assocs.extras combinators kernel math math.order
math.statistics sequences sequences.extras sets ;
USING: assocs combinators kernel math math.order
math.statistics sequences sets ;
IN: escape-strings
: find-escapes ( str -- set )
@ -32,7 +32,7 @@ IN: escape-strings
[ escape-string ] dip prepend ;
: escape-simplest ( str -- str' )
dup { CHAR: ' CHAR: " CHAR: \r CHAR: \n CHAR: \s } counts {
dup histogram {
! { [ dup { CHAR: ' CHAR: \r CHAR: \n CHAR: \s } values-of sum 0 = ] [ drop "'" prepend ] }
{ [ dup CHAR: " of not ] [ drop "\"" "\"" surround ] }
[ drop escape-string ]

View File

@ -25,4 +25,4 @@ USE: vocabs
"furnace.scopes" require
"furnace.sessions" require
"furnace.syndication" require
"webapps.user-admin" require
! "webapps.user-admin" require

View File

@ -1,7 +1,7 @@
! Copyright (C) 2013-2014 Björn Lindqvist
! See http://factorcode.org/license.txt for BSD license
USING: accessors ascii base64 fry grouping.extras io
io.encodings io.encodings.string io.encodings.utf16 kernel math
USING: accessors ascii assocs base64 fry io io.encodings
io.encodings.string io.encodings.utf16 kernel math
math.functions sequences splitting strings ;
IN: io.encodings.utf7
@ -28,13 +28,13 @@ TUPLE: utf7codec dialect buffer ;
: raw-base64> ( str -- str' )
dup length 4 / ceiling 4 * CHAR: = pad-tail base64> utf16be decode ;
: encode-chunk ( repl-pair surround-pair chunk ascii? -- bytes )
: encode-chunk ( repl-pair surround-pair chunk printable? -- bytes )
[ swap [ first ] [ concat ] bi replace nip ]
[ >raw-base64 -rot [ first2 replace ] [ first2 surround ] bi* ] if ;
: encode-utf7-string ( str codec -- bytes )
[ [ printable? ] group-by ] dip
dialect>> first2 '[ _ _ rot first2 swap encode-chunk ] map
[ [ printable? ] collect-by ] dip dialect>> first2
'[ [ _ _ ] 2dip swap encode-chunk ] { } assoc>map
B{ } concat-as ;
M: utf7codec encode-string ( str stream codec -- )

View File

@ -4,8 +4,8 @@ USING: accessors arrays classes.singleton columns combinators
combinators.short-circuit combinators.smart formatting fry
grouping kernel locals math math.bits math.functions math.order
math.private math.ranges math.statistics math.vectors
math.vectors.private sequences sequences.deep sequences.extras
sequences.private slots.private summary ;
math.vectors.private sequences sequences.deep sequences.private
slots.private summary ;
IN: math.matrices
! defined here because of issue #1943

View File

@ -47,3 +47,7 @@ IN: sequences.deep.tests
dup integer? [ even? [ 1 + ] when ] [ drop ] if
] deep-reduce
] unit-test
{ V{ 1 } } [ 1 flatten1 ] unit-test
{ { 1 2 3 } } [ { 1 2 3 } flatten1 ] unit-test
{ { 1 2 3 { { 4 } } } } [ { 1 { 2 } { 3 { { 4 } } } } flatten1 ] unit-test

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Daniel Ehrenberg, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel strings math fry ;
USING: fry kernel make math sequences strings ;
IN: sequences.deep
! All traversal goes in postorder
@ -69,3 +69,12 @@ M: object branch? drop f ;
: flatten-as ( obj exemplar -- seq )
[ branch? ] swap deep-reject-as ;
: flatten1 ( obj -- seq )
[
[
dup branch? [
[ dup branch? [ % ] [ , ] if ] each
] [ , ] if
]
] keep dup branch? [ drop f ] unless make ;

View File

@ -9,8 +9,8 @@ IN: cli.git
SYMBOL: cli-git-num-parallel
cli-git-num-parallel [ cpus 2 * ] initialize
: git-command>string ( quot -- string )
utf8 <process-reader> stream-contents [ blank? ] trim-tail ;
: git-command>string ( desc -- string )
process-contents [ blank? ] trim-tail ;
: git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-process ;
: git-clone ( uri -- process ) [ { "git" "clone" } ] dip suffix run-process ;

View File

@ -202,10 +202,6 @@ tools.test vectors vocabs ;
{ { 1 0 0 1 0 0 0 1 0 0 } }
[ 1 { 0 3 7 } 10 0 <array> [ set-nths-unsafe ] keep ] unit-test
{ V{ 1 } } [ 1 flatten1 ] unit-test
{ { 1 2 3 } } [ { 1 2 3 } flatten1 ] unit-test
{ { 1 2 3 { { 4 } } } } [ { 1 { 2 } { 3 { { 4 } } } } flatten1 ] unit-test
{ t 3 3 } [ 10 <iota> [ [ odd? ] [ 1 > ] bi* and ] map-find-index ] unit-test
{ f f f } [ 10 <iota> [ [ odd? ] [ 9 > ] bi* and ] map-find-index ] unit-test

View File

@ -481,15 +481,6 @@ PRIVATE>
: set-nths-unsafe ( value indices seq -- )
swapd '[ _ swap _ set-nth-unsafe ] each ; inline
: flatten1 ( obj -- seq )
[
[
dup branch? [
[ dup branch? [ % ] [ , ] if ] each
] [ , ] if
]
] keep dup branch? [ drop f ] unless make ;
<PRIVATE
: (map-find-index) ( seq quot find-quot -- result i elt )