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 dfde0c7bb5..6c712718e6 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 502b928a3a..b141ec7445 100644 --- a/basis/escape-strings/escape-strings.factor +++ b/basis/escape-strings/escape-strings.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2017 John Benediktsson, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: ascii assocs assocs.extras combinators kernel math -math.order math.statistics sequences sequences.extras sets -strings ; +USING: assocs combinators kernel math math.order +math.statistics sequences sets ; IN: escape-strings : find-escapes ( str -- set ) @@ -48,7 +47,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/actions/actions.factor b/basis/furnace/actions/actions.factor index cdf088ee53..544ce01028 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -1,20 +1,9 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors sequences kernel assocs combinators -validators http hashtables namespaces fry continuations locals -io arrays math boxes splitting urls -xml.entities -http.server -http.server.responses -furnace.utilities -furnace.redirection -furnace.conversations -furnace.chloe-tags -html.forms -html.components -html.templates.chloe -html.templates.chloe.syntax -html.templates.chloe.compiler ; +USING: accessors assocs combinators fry furnace.conversations +furnace.utilities html.forms html.templates.chloe http +http.server http.server.responses kernel namespaces sequences +splitting urls validators ; IN: furnace.actions SYMBOL: rest 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 56f9da0ee8..a18bbe9b41 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 base64 fry io io.encodings +io.encodings.string io.encodings.utf16 kernel make math math.functions sequences splitting strings ; IN: io.encodings.utf7 @@ -28,14 +28,22 @@ 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 ; +: split-chunk ( str -- after before printable? ) + dup first printable? [ + [ 1 over ] dip '[ printable? _ = not ] find-from drop + [ cut-slice ] [ f ] if* swap + ] keep ; + : encode-utf7-string ( str codec -- bytes ) - [ [ printable? ] group-by ] dip - dialect>> first2 '[ _ _ rot first2 swap encode-chunk ] map - B{ } concat-as ; + dialect>> first2 rot '[ + [ dup empty? ] [ + split-chunk '[ 2dup _ _ encode-chunk % ] dip + ] until + ] B{ } make 3nip ; M: utf7codec encode-string ( str stream codec -- ) swapd encode-utf7-string swap stream-write ; diff --git a/basis/tools/directory-to-file/authors.txt b/basis/math/floating-point/authors.txt similarity index 100% rename from basis/tools/directory-to-file/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/basis/windows/iphlpapi/iphlpapi.factor b/basis/windows/iphlpapi/iphlpapi.factor index 8f910e0d26..8394b3bdf4 100644 --- a/basis/windows/iphlpapi/iphlpapi.factor +++ b/basis/windows/iphlpapi/iphlpapi.factor @@ -4,8 +4,8 @@ USING: accessors alien alien.c-types alien.data alien.strings alien.syntax arrays byte-arrays classes.struct combinators combinators.smart destructors io.encodings.string io.encodings.utf8 io.sockets io.sockets.private kernel libc -make refs sequences sequences.extras windows.errors -windows.kernel32 windows.types windows.winsock fry ; +make refs sequences windows.errors windows.kernel32 +windows.types windows.winsock ; IN: windows.iphlpapi LIBRARY: iphlpapi @@ -404,7 +404,7 @@ FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) > ] when ] keep ] loop>array nip ; + [ Next>> ] follow ; ! Don't use this, use each/map-adapters : iterate-interfaces ( -- seq ) diff --git a/build.sh b/build.sh index 5414b06825..80ff0c3dc8 100755 --- a/build.sh +++ b/build.sh @@ -154,21 +154,24 @@ clang_version_ok() { } set_cc() { - # on Cygwin we MUST use the MinGW "cross-compiler", therefore check these first # furthermore, we prefer 64 bit over 32 bit versions if both are available - test_programs_installed x86_64-w64-mingw32-gcc x86_64-w64-mingw32-g++ - if [[ $? -ne 0 ]] ; then - [ -z "$CC" ] && CC=x86_64-w64-mingw32-gcc - [ -z "$CXX" ] && CXX=x86_64-w64-mingw32-g++ - return - fi - test_programs_installed i686-w64-mingw32-gcc i686-w64-mingw32-g++ - if [[ $? -ne 0 ]] ; then - [ -z "$CC" ] && CC=i686-w64-mingw32-gcc - [ -z "$CXX" ] && CXX=i686-w64-mingw32-g++ - return + # we need this condition so we don't find a mingw32 compiler on linux + if [[ $OS == windows ]] ; then + test_programs_installed x86_64-w64-mingw32-gcc x86_64-w64-mingw32-g++ + if [[ $? -ne 0 ]] ; then + [ -z "$CC" ] && CC=x86_64-w64-mingw32-gcc + [ -z "$CXX" ] && CXX=x86_64-w64-mingw32-g++ + return + fi + + test_programs_installed i686-w64-mingw32-gcc i686-w64-mingw32-g++ + if [[ $? -ne 0 ]] ; then + [ -z "$CC" ] && CC=i686-w64-mingw32-gcc + [ -z "$CXX" ] && CXX=i686-w64-mingw32-g++ + return + fi fi test_programs_installed clang clang++ @@ -274,6 +277,7 @@ find_os() { *CYGWIN_NT*) OS=windows;; *CYGWIN*) OS=windows;; MINGW32*) OS=windows;; + MINGW64*) OS=windows;; MSYS_NT*) OS=windows;; *darwin*) OS=macosx;; *Darwin*) OS=macosx;; @@ -324,6 +328,14 @@ c_find_word_size() { check_ret $CC ./$C_WORD WORD=$? + case $WORD in + 32) ;; + 64) ;; + *) + echo "Word size should be 32/64, got $WORD" + exit_script 15;; + esac + $DELETE -f $C_WORD } diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor index 2f5afb3fbe..70539dd093 100644 --- a/extra/cli/git/git.factor +++ b/extra/cli/git/git.factor @@ -8,7 +8,7 @@ IN: cli.git INITIALIZED-SYMBOL: cli-git-num-parallel [ cpus 2 * ] -: git-command>string ( quot -- string ) +: git-command>string ( desc -- string ) utf8 stream-contents [ blank? ] trim-tail ; : git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-process ; diff --git a/extra/rosetta-code/multisplit/authors.txt b/extra/rosetta-code/multisplit/authors.txt new file mode 100644 index 0000000000..8e1955f8e1 --- /dev/null +++ b/extra/rosetta-code/multisplit/authors.txt @@ -0,0 +1 @@ +Alexander Ilin diff --git a/extra/rosetta-code/multisplit/multisplit-tests.factor b/extra/rosetta-code/multisplit/multisplit-tests.factor new file mode 100644 index 0000000000..e7094d8e9a --- /dev/null +++ b/extra/rosetta-code/multisplit/multisplit-tests.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2020 Alexander Ilin. +! See http://factorcode.org/license.txt for BSD license. +USING: sequences strings tools.test rosetta-code.multisplit ; +IN: rosetta-code.multisplit.tests + +{ { "a" "" "b" "" "c" } } [ + "a!===b=!=c" { "==" "!=" "=" } multisplit [ >string ] map +] unit-test diff --git a/extra/rosetta-code/multisplit/multisplit.factor b/extra/rosetta-code/multisplit/multisplit.factor new file mode 100644 index 0000000000..cfe5583bc3 --- /dev/null +++ b/extra/rosetta-code/multisplit/multisplit.factor @@ -0,0 +1,22 @@ +! Copyright (C) 2020 Alexander Ilin. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays fry kernel make sequences ; + +IN: rosetta-code.multisplit + +: ?pair ( ? x -- {?,x}/f ) + over [ 2array ] [ 2drop f ] if ; + +: best-separator ( seq -- pos index ) + dup [ first ] map infimum '[ first _ = ] find nip first2 ; + +: first-subseq ( separators seq -- n separator ) + dupd [ swap [ subseq-start ] dip ?pair ] curry map-index sift + [ drop f f ] [ best-separator rot nth ] if-empty ; + +: multisplit ( string separators -- seq ) + '[ + [ _ over first-subseq dup ] [ + length -rot cut-slice swap , swap tail-slice + ] while 2drop , + ] { } make ; diff --git a/extra/rosetta-code/multisplit/tags.txt b/extra/rosetta-code/multisplit/tags.txt new file mode 100644 index 0000000000..1e107f52e4 --- /dev/null +++ b/extra/rosetta-code/multisplit/tags.txt @@ -0,0 +1 @@ +examples diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index 74de4273e1..6fb90eb8c7 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 44668ef8f6..a08187c4cc 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -488,15 +488,6 @@ PRIVATE> : set-nths-unsafe* ( values indices seq -- seq ) -rot [ pick set-nth-unsafe ] 2each ; inline -: flatten1 ( obj -- seq ) - [ - [ - dup branch? [ - [ dup branch? [ % ] [ , ] if ] each - ] [ , ] if - ] - ] keep dup branch? [ drop f ] unless make ; -