Merge remote-tracking branch 'origin/master' into modern-harvey4

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 <process-reader> stream-contents
+        [ blank? ] trim-tail
+    ] with-directory ;
 
 : git-branch-destination ( -- dest )
     build-images-destination get

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
     {

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
 
 <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' )
     {
@@ -169,7 +168,10 @@ PRIVATE>
     dup singular? [ a/an ] [ drop "the" ] if ;
 
 : comma-list ( parts conjunction -- clause-seq )
-    [ ", " interleaved ] dip over length dup 3 >= [
+    [
+        [ 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 ;
 

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 ]

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

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

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 ;

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

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

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 ;

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 )
 <PRIVATE
 
 : loop-list ( obj -- seq )
-    [ [ dup [ Next>> ] when ] keep ] loop>array nip ;
+    [ Next>> ] follow ;
 
 ! Don't use this, use each/map-adapters
 : iterate-interfaces ( -- seq )

build.sh

@@ -154,9 +154,11 @@ 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
+
+    # 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
@@ -170,6 +172,7 @@ set_cc() {
             [ -z "$CXX" ] && CXX=i686-w64-mingw32-g++
             return
         fi
+    fi
 
     test_programs_installed clang clang++
     if [[ $? -ne 0 ]] && clang_version_ok ; then
@@ -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
 }
 

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 <process-reader> stream-contents [ blank? ] trim-tail ;
 
 : git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-process ;

extra/rosetta-code/multisplit/authors.txt

@@ -0,0 +1 @@
+Alexander Ilin

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

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 ;

extra/rosetta-code/multisplit/tags.txt

@@ -0,0 +1 @@
+examples

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 <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
 

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 ;
-
 <PRIVATE
 
 : (map-find-index) ( seq quot find-quot -- result i elt )