From de3b74d1c6c8cbb7c0a00cb1779ebfd5a10befd1 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 1 Apr 2020 21:36:41 -0700 Subject: [PATCH] basis/extra: move fewer things. --- basis/bootstrap/image/upload/upload.factor | 12 ++++++++---- {extra => basis}/couchdb/authors.txt | 0 {extra => basis}/couchdb/couchdb-tests.factor | 0 {extra => basis}/couchdb/couchdb.factor | 0 {extra => basis}/couchdb/tags.txt | 0 .../visual-studio-code/visual-studio-code.factor | 4 ++-- basis/english/english.factor | 16 +++++++++------- basis/escape-strings/escape-strings.factor | 6 +++--- basis/furnace/furnace.factor | 2 +- basis/io/encodings/utf7/utf7.factor | 10 +++++----- {extra => basis}/math/floating-point/authors.txt | 0 .../floating-point/floating-point-tests.factor | 0 .../math/floating-point/floating-point.factor | 0 {extra => basis}/math/floating-point/tags.txt | 0 basis/math/matrices/matrices.factor | 4 ++-- {extra => basis}/math/trig/tags.txt | 0 {extra => basis}/math/trig/trig.factor | 0 {extra => basis}/method-chains/authors.txt | 0 .../method-chains/method-chains-docs.factor | 0 .../method-chains/method-chains-tests.factor | 0 .../method-chains/method-chains.factor | 0 {extra => basis}/method-chains/summary.txt | 0 basis/sequences/deep/deep-tests.factor | 4 ++++ basis/sequences/deep/deep.factor | 11 ++++++++++- {extra => basis}/tools/which/authors.txt | 0 {extra => basis}/tools/which/which-docs.factor | 0 {extra => basis}/tools/which/which.factor | 0 extra/cli/git/git.factor | 4 ++-- extra/sequences/extras/extras-tests.factor | 4 ---- extra/sequences/extras/extras.factor | 9 --------- 30 files changed, 46 insertions(+), 40 deletions(-) rename {extra => basis}/couchdb/authors.txt (100%) rename {extra => basis}/couchdb/couchdb-tests.factor (100%) rename {extra => basis}/couchdb/couchdb.factor (100%) rename {extra => basis}/couchdb/tags.txt (100%) rename {extra => basis}/math/floating-point/authors.txt (100%) rename {extra => basis}/math/floating-point/floating-point-tests.factor (100%) rename {extra => basis}/math/floating-point/floating-point.factor (100%) rename {extra => basis}/math/floating-point/tags.txt (100%) rename {extra => basis}/math/trig/tags.txt (100%) rename {extra => basis}/math/trig/trig.factor (100%) rename {extra => basis}/method-chains/authors.txt (100%) rename {extra => basis}/method-chains/method-chains-docs.factor (100%) rename {extra => basis}/method-chains/method-chains-tests.factor (100%) rename {extra => basis}/method-chains/method-chains.factor (100%) rename {extra => basis}/method-chains/summary.txt (100%) rename {extra => basis}/tools/which/authors.txt (100%) rename {extra => basis}/tools/which/which-docs.factor (100%) rename {extra => basis}/tools/which/which.factor (100%) diff --git a/basis/bootstrap/image/upload/upload.factor b/basis/bootstrap/image/upload/upload.factor index 08f3d02361..47a0fbfc12 100644 --- a/basis/bootstrap/image/upload/upload.factor +++ b/basis/bootstrap/image/upload/upload.factor @@ -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 stream-contents + [ blank? ] trim-tail + ] with-directory ; : git-branch-destination ( -- dest ) build-images-destination get diff --git a/extra/couchdb/authors.txt b/basis/couchdb/authors.txt similarity index 100% rename from extra/couchdb/authors.txt rename to basis/couchdb/authors.txt diff --git a/extra/couchdb/couchdb-tests.factor b/basis/couchdb/couchdb-tests.factor similarity index 100% rename from extra/couchdb/couchdb-tests.factor rename to basis/couchdb/couchdb-tests.factor diff --git a/extra/couchdb/couchdb.factor b/basis/couchdb/couchdb.factor similarity index 100% rename from extra/couchdb/couchdb.factor rename to basis/couchdb/couchdb.factor diff --git a/extra/couchdb/tags.txt b/basis/couchdb/tags.txt similarity index 100% rename from extra/couchdb/tags.txt rename to basis/couchdb/tags.txt diff --git a/basis/editors/visual-studio-code/visual-studio-code.factor b/basis/editors/visual-studio-code/visual-studio-code.factor index f996cbec8a..5ac6c00bfd 100644 --- a/basis/editors/visual-studio-code/visual-studio-code.factor +++ b/basis/editors/visual-studio-code/visual-studio-code.factor @@ -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 { diff --git a/basis/english/english.factor b/basis/english/english.factor index 48cf24bdf6..3ea32284d6 100644 --- a/basis/english/english.factor +++ b/basis/english/english.factor @@ -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 > -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 [-] + ", " ] + [ [ 2 * pick set-nth ] each-index ] bi + ] dip over length dup 3 >= [ [ 3 > ", " " " ? " " surround ] [ 2 - pick set-nth ] bi ] [ 2drop ] if ; diff --git a/basis/escape-strings/escape-strings.factor b/basis/escape-strings/escape-strings.factor index 09fe48836c..5fa7618554 100644 --- a/basis/escape-strings/escape-strings.factor +++ b/basis/escape-strings/escape-strings.factor @@ -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 ] diff --git a/basis/furnace/furnace.factor b/basis/furnace/furnace.factor index 2d12676b3a..8665fe5f2a 100644 --- a/basis/furnace/furnace.factor +++ b/basis/furnace/furnace.factor @@ -25,4 +25,4 @@ USE: vocabs "furnace.scopes" require "furnace.sessions" require "furnace.syndication" require -"webapps.user-admin" require +! "webapps.user-admin" require diff --git a/basis/io/encodings/utf7/utf7.factor b/basis/io/encodings/utf7/utf7.factor index 40d4fe5490..76c89d9885 100644 --- a/basis/io/encodings/utf7/utf7.factor +++ b/basis/io/encodings/utf7/utf7.factor @@ -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 -- ) diff --git a/extra/math/floating-point/authors.txt b/basis/math/floating-point/authors.txt similarity index 100% rename from extra/math/floating-point/authors.txt rename to basis/math/floating-point/authors.txt diff --git a/extra/math/floating-point/floating-point-tests.factor b/basis/math/floating-point/floating-point-tests.factor similarity index 100% rename from extra/math/floating-point/floating-point-tests.factor rename to basis/math/floating-point/floating-point-tests.factor diff --git a/extra/math/floating-point/floating-point.factor b/basis/math/floating-point/floating-point.factor similarity index 100% rename from extra/math/floating-point/floating-point.factor rename to basis/math/floating-point/floating-point.factor diff --git a/extra/math/floating-point/tags.txt b/basis/math/floating-point/tags.txt similarity index 100% rename from extra/math/floating-point/tags.txt rename to basis/math/floating-point/tags.txt diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor index 2ca743dad0..bedd3fd480 100644 --- a/basis/math/matrices/matrices.factor +++ b/basis/math/matrices/matrices.factor @@ -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 diff --git a/extra/math/trig/tags.txt b/basis/math/trig/tags.txt similarity index 100% rename from extra/math/trig/tags.txt rename to basis/math/trig/tags.txt diff --git a/extra/math/trig/trig.factor b/basis/math/trig/trig.factor similarity index 100% rename from extra/math/trig/trig.factor rename to basis/math/trig/trig.factor diff --git a/extra/method-chains/authors.txt b/basis/method-chains/authors.txt similarity index 100% rename from extra/method-chains/authors.txt rename to basis/method-chains/authors.txt diff --git a/extra/method-chains/method-chains-docs.factor b/basis/method-chains/method-chains-docs.factor similarity index 100% rename from extra/method-chains/method-chains-docs.factor rename to basis/method-chains/method-chains-docs.factor diff --git a/extra/method-chains/method-chains-tests.factor b/basis/method-chains/method-chains-tests.factor similarity index 100% rename from extra/method-chains/method-chains-tests.factor rename to basis/method-chains/method-chains-tests.factor diff --git a/extra/method-chains/method-chains.factor b/basis/method-chains/method-chains.factor similarity index 100% rename from extra/method-chains/method-chains.factor rename to basis/method-chains/method-chains.factor diff --git a/extra/method-chains/summary.txt b/basis/method-chains/summary.txt similarity index 100% rename from extra/method-chains/summary.txt rename to basis/method-chains/summary.txt diff --git a/basis/sequences/deep/deep-tests.factor b/basis/sequences/deep/deep-tests.factor index b96a51699a..95f447a957 100644 --- a/basis/sequences/deep/deep-tests.factor +++ b/basis/sequences/deep/deep-tests.factor @@ -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 diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor index e4edd80685..36911bc12b 100644 --- a/basis/sequences/deep/deep.factor +++ b/basis/sequences/deep/deep.factor @@ -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 ; diff --git a/extra/tools/which/authors.txt b/basis/tools/which/authors.txt similarity index 100% rename from extra/tools/which/authors.txt rename to basis/tools/which/authors.txt diff --git a/extra/tools/which/which-docs.factor b/basis/tools/which/which-docs.factor similarity index 100% rename from extra/tools/which/which-docs.factor rename to basis/tools/which/which-docs.factor diff --git a/extra/tools/which/which.factor b/basis/tools/which/which.factor similarity index 100% rename from extra/tools/which/which.factor rename to basis/tools/which/which.factor diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor index f91ad6aa23..b7c3c2dc3c 100644 --- a/extra/cli/git/git.factor +++ b/extra/cli/git/git.factor @@ -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 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 ; diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index 762660f9cf..a85b6c087e 100644 --- a/extra/sequences/extras/extras-tests.factor +++ b/extra/sequences/extras/extras-tests.factor @@ -202,10 +202,6 @@ tools.test vectors vocabs ; { { 1 0 0 1 0 0 0 1 0 0 } } [ 1 { 0 3 7 } 10 0 [ 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 [ [ odd? ] [ 1 > ] bi* and ] map-find-index ] unit-test { f f f } [ 10 [ [ odd? ] [ 9 > ] bi* and ] map-find-index ] unit-test diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 26b343bc7b..45bc1ecd7f 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -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 ; -