From 211d69561ae364e70f21dec5a55386b4fd5f659c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 30 Jun 2018 00:38:16 -0500 Subject: [PATCH 01/84] escape-strings: Add a way to find the shortest lua-string escape. Also add a way to escape a string as either 'foo "foo" or [[foo]] depending on which delimiters will do the job. Add a couple helper words to assocs.extras --- basis/escape-strings/authors.txt | 2 ++ .../escape-strings-tests.factor | 25 +++++++++++++ basis/escape-strings/escape-strings.factor | 36 +++++++++++++++++++ extra/assocs/extras/extras.factor | 11 +++++- 4 files changed, 73 insertions(+), 1 deletion(-) create mode 100644 basis/escape-strings/authors.txt create mode 100644 basis/escape-strings/escape-strings-tests.factor create mode 100644 basis/escape-strings/escape-strings.factor diff --git a/basis/escape-strings/authors.txt b/basis/escape-strings/authors.txt new file mode 100644 index 0000000000..dbe8e57c80 --- /dev/null +++ b/basis/escape-strings/authors.txt @@ -0,0 +1,2 @@ +John Benediktsson +Doug Coleman diff --git a/basis/escape-strings/escape-strings-tests.factor b/basis/escape-strings/escape-strings-tests.factor new file mode 100644 index 0000000000..93a388f9bd --- /dev/null +++ b/basis/escape-strings/escape-strings-tests.factor @@ -0,0 +1,25 @@ +! Copyright (C) 2017 John Benediktsson, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test escape-strings ; +IN: escape-strings.tests + +{ "[[asdf]]" } [ "asdf" escape-string ] unit-test +{ "[[[[]]" } [ "[[" escape-string ] unit-test +{ "[=[]]]=]" } [ "]]" escape-string ] unit-test + +{ "[===[]]]==][=[=]=]]===]" } [ "]]]==][=[=]=]" escape-string ] unit-test +{ "[==[[=[=]=]]==]" } [ "[=[=]=]" escape-string ] unit-test +{ "[[[a[]]" } [ "[a[" escape-string ] unit-test + +{ "[=[ab]]=]" } [ "ab]" escape-string ] unit-test + +{ "[==[[=[abcd]]=]]==]" } [ { "abcd]" } escape-strings ] unit-test +{ "[==[[=[abcd]]]=]]==]" } [ { "abcd]]" } escape-strings ] unit-test + +{ "[==[]]ab]=]==]" } [ "]]ab]=" escape-string ] unit-test +{ "[=[]]ab]==]=]" } [ "]]ab]==" escape-string ] unit-test +{ "[=[]]ab]===]=]" } [ "]]ab]===" escape-string ] unit-test + +{ "[[]ab]=]]" } [ "]ab]=" escape-string ] unit-test +{ "[[]ab]==]]" } [ "]ab]==" escape-string ] unit-test +{ "[[]ab]===]]" } [ "]ab]===" escape-string ] unit-test diff --git a/basis/escape-strings/escape-strings.factor b/basis/escape-strings/escape-strings.factor new file mode 100644 index 0000000000..423b4051fe --- /dev/null +++ b/basis/escape-strings/escape-strings.factor @@ -0,0 +1,36 @@ +! 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 ; +IN: escape-strings + +: find-escapes ( str -- set ) + [ HS{ } clone 0 0 ] dip + [ + { + { CHAR: ] [ 1 + dup 2 = [ drop over adjoin 0 1 ] when ] } + { CHAR: = [ dup 1 = [ [ 1 + ] dip ] when ] } + [ 3drop 0 0 ] + } case + ] each 0 > [ over adjoin ] [ drop ] if ; + +: lowest-missing ( set -- min ) + members dup [ = not ] find-index + [ nip ] [ drop length ] if ; + +: escape-string* ( str n -- str' ) + CHAR: = + [ "[" dup surround ] [ "]" dup surround ] bi surround ; + +: escape-string ( str -- str' ) + dup find-escapes lowest-missing escape-string* ; + +: escape-strings ( strs -- str ) + [ escape-string ] map concat escape-string ; + +: escape-simplest ( str -- str' ) + dup { CHAR: ' CHAR: " CHAR: \r CHAR: \n CHAR: \s } counts { + { [ dup { CHAR: ' CHAR: \r CHAR: \n CHAR: \s } values-of sum 0 = ] [ drop "'" prepend ] } + { [ dup CHAR: " of not ] [ drop "\"" "\"" surround ] } + [ drop escape-string ] + } cond ; \ No newline at end of file diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor index 27da0347e9..a426ae4568 100644 --- a/extra/assocs/extras/extras.factor +++ b/extra/assocs/extras/extras.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2012 John Benediktsson, Doug Coleman ! See http://factorcode.org/license.txt for BSD license USING: arrays assocs assocs.private fry generalizations kernel -math sequences ; +math math.statistics sequences sequences.extras ; IN: assocs.extras : deep-at ( assoc seq -- value/f ) @@ -163,3 +163,12 @@ PRIVATE> : flatten-values ( assoc -- assoc' ) dup any-multi-value? [ expand-values-set-at flatten-values ] when ; + +: intersect-keys ( assoc seq -- elts ) + [ of ] with map-zip sift-values ; inline + +: values-of ( assoc seq -- elts ) + [ of ] with map sift ; inline + +: counts ( seq elts -- counts ) + [ histogram ] dip intersect-keys ; \ No newline at end of file From 9af298fd49494dbbf20412f318cd929c53260157 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 16:10:39 -0500 Subject: [PATCH 02/84] gap-buffer: resurrect! gap-buffer/cursortree still needs to be ported. removed in c1792d169e7e1bfd97ddd0a419feaca200b96c36 --- extra/gap-buffer/authors.txt | 1 + extra/gap-buffer/gap-buffer-tests.factor | 82 +++++++ extra/gap-buffer/gap-buffer.factor | 288 +++++++++++++++++++++++ extra/gap-buffer/summary.txt | 1 + extra/gap-buffer/tags.txt | 1 + 5 files changed, 373 insertions(+) create mode 100644 extra/gap-buffer/authors.txt create mode 100644 extra/gap-buffer/gap-buffer-tests.factor create mode 100644 extra/gap-buffer/gap-buffer.factor create mode 100644 extra/gap-buffer/summary.txt create mode 100644 extra/gap-buffer/tags.txt diff --git a/extra/gap-buffer/authors.txt b/extra/gap-buffer/authors.txt new file mode 100644 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/gap-buffer/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/gap-buffer/gap-buffer-tests.factor b/extra/gap-buffer/gap-buffer-tests.factor new file mode 100644 index 0000000000..fbf2364cc6 --- /dev/null +++ b/extra/gap-buffer/gap-buffer-tests.factor @@ -0,0 +1,82 @@ +USING: kernel sequences tools.test gap-buffer strings math ; + +! test copy-elements +{ { 0 3 4 3 4 5 } } +[ { 0 1 2 3 4 5 } dup [ -2 3 5 ] dip copy-elements ] unit-test + +{ { 0 1 2 1 2 5 } } +[ { 0 1 2 3 4 5 } dup [ 2 2 0 ] dip copy-elements ] unit-test + +{ "01234567856" } +[ "01234567890" dup [ 4 6 4 ] dip copy-elements ] unit-test + +! test sequence protocol (like, length, nth, set-nth) +{ "gap buffers are cool" } +[ "gap buffers are cool" "" like ] unit-test + +! test move-gap-back-inside +{ t f } +[ 5 "0123456" move-gap-forward? [ move-gap-back-inside? 2nip ] dip ] unit-test + +{ "0123456" } +[ "0123456" 5 over move-gap >string ] unit-test + +! test move-gap-forward-inside +{ t } +[ "I once ate a spaniel" 15 over move-gap 17 swap move-gap-forward-inside? 2nip ] unit-test + +{ "I once ate a spaniel" } +[ "I once ate a spaniel" 15 over move-gap 17 over move-gap >string ] unit-test + +! test move-gap-back-around +{ f f } +[ 2 "terriers are ok too" move-gap-forward? [ move-gap-back-inside? 2nip ] dip ] unit-test + +{ "terriers are ok too" } +[ "terriers are ok too" 2 over move-gap >string ] unit-test + +! test move-gap-forward-around +{ f t } +[ + "god is nam's best friend" + 2 over move-gap 22 over position>index swap move-gap-forward? + [ move-gap-forward-inside? 2nip ] dip +] unit-test + +{ "god is nam's best friend" } +[ "god is nam's best friend" 2 over move-gap 22 over move-gap >string ] unit-test + +! test changing buffer contents +{ "factory" } +[ "factor" CHAR: y 6 pick insert* >string ] unit-test + +! test inserting multiple elements in different places. buffer should grow +{ "refractory" } +[ "factor" CHAR: y 6 pick insert* "re" 0 pick insert* CHAR: r 3 pick insert* >string ] unit-test + +! test deleting elements. buffer should shrink +{ "for" } +[ "factor" 3 [ 1 over delete* ] times >string ] unit-test + +! more testing of nth and set-nth +{ "raptor" } +[ "factor" CHAR: p 2 pick set-nth 5 over nth 0 pick set-nth >string ] unit-test + +! test stack/queue operations +{ "slaughter" } +[ "laughter" CHAR: s over push-start >string ] unit-test + +{ "pantonio" } +[ "pant" "onio" over push-end >string ] unit-test + +{ CHAR: f "actor" } +[ "factor" dup pop-start swap >string ] unit-test + +{ CHAR: s "pant" } +[ "pants" dup pop-end swap >string ] unit-test + +{ "end this is the " } +[ "this is the end " 4 over rotate >string ] unit-test + +{ "your jedi training is finished " } +[ "finished your jedi training is " -9 over rotate >string ] unit-test diff --git a/extra/gap-buffer/gap-buffer.factor b/extra/gap-buffer/gap-buffer.factor new file mode 100644 index 0000000000..166bc13400 --- /dev/null +++ b/extra/gap-buffer/gap-buffer.factor @@ -0,0 +1,288 @@ +! Copyright (C) 2007 Alex Chapman All Rights Reserved. +! See http://factorcode.org/license.txt for BSD license. +! +! gap buffer -- largely influenced by Strandh and Villeneuve's Flexichain +! for a good introduction see: +! https://common-lisp.net/project/flexichain/download/StrandhVilleneuveMoore.pdf +USING: accessors arrays circular kernel math math.functions +math.order multiline sequences sequences.private ; +IN: gap-buffer + +! gap-start -- the first element of the gap +! gap-end -- the first element after the gap +! expand-factor -- should be > 1 + + +! min-size -- < 5 is not sensible + +TUPLE: gb + seq + gap-start + gap-end + expand-factor + min-size ; + +: required-space ( n gb -- n ) + [ expand-factor>> * ceiling >fixnum ] + [ min-size>> ] bi max ; + +: ( seq -- gb ) + gb new + 5 >>min-size + 1.5 >>expand-factor + swap + [ length >>gap-start ] keep + [ length over required-space >>gap-end ] keep + over gap-end>> swap { } like resize-array >>seq ; + +M: gb like ( seq gb -- seq ) drop ; + +: gap-length ( gb -- n ) [ gap-end>> ] keep gap-start>> - ; + +: buffer-length ( gb -- n ) seq>> length ; + +M: gb length ( gb -- n ) [ buffer-length ] keep gap-length - ; + +: valid-position? ( pos gb -- ? ) + ! one element past the end of the buffer is a valid position when we're inserting + length -1 swap between? ; + +: valid-index? ( i gb -- ? ) + buffer-length -1 swap between? ; + +ERROR: position-out-of-bounds position gap-buffer ; + +: position>index ( pos gb -- i ) + 2dup valid-position? [ + 2dup gap-start>> >= [ + gap-length + + ] [ drop ] if + ] [ + position-out-of-bounds + ] if ; + +TUPLE: index-out-of-bounds index gap-buffer ; +C: index-out-of-bounds + +: index>position ( i gb -- pos ) + 2dup valid-index? [ + 2dup gap-end>> >= [ + gap-length - + ] [ drop ] if + ] [ + throw + ] if ; + +M: gb virtual@ ( n gb -- n seq ) [ position>index ] keep seq>> ; + +M: gb nth ( n gb -- elt ) bounds-check virtual@ nth-unsafe ; + +M: gb nth-unsafe ( n gb -- elt ) virtual@ nth-unsafe ; + +M: gb set-nth ( elt n seq -- ) bounds-check virtual@ set-nth-unsafe ; + +M: gb set-nth-unsafe ( elt n seq -- ) virtual@ set-nth-unsafe ; + +M: gb virtual-exemplar seq>> ; + +INSTANCE: gb virtual-sequence + +! ------------- moving the gap ------------------------------- + +: (copy-element) ( to start seq -- ) tuck nth -rot set-nth ; + +: copy-element ( dst start seq -- ) [ [ + ] keep ] dip (copy-element) ; + +: copy-elements-back ( dst start seq n -- ) + dup 0 > [ + [ [ copy-element ] 3keep [ 1 + ] dip ] dip 1 - copy-elements-back + ] [ 3drop drop ] if ; + +: copy-elements-forward ( dst start seq n -- ) + dup 0 > [ + [ [ copy-element ] 3keep [ 1 - ] dip ] dip 1 - copy-elements-forward + ] [ 3drop drop ] if ; + +: copy-elements ( dst start end seq -- ) + pick pick > [ + [ dupd - ] dip swap copy-elements-forward + ] [ + [ over - ] dip swap copy-elements-back + ] if ; + +! the gap can be moved either forward or back. Moving the gap 'inside' means +! moving elements across the gap. Moving the gap 'around' means changing the +! start of the circular buffer to avoid moving as many elements. + +! We decide which method (inside or around) to pick based on the number of +! elements that will need to be moved. We always try to move as few elements as +! possible. + +: move-gap? ( i gb -- i gb ? ) 2dup gap-end>> = not ; + +: move-gap-forward? ( i gb -- i gb ? ) 2dup gap-start>> >= ; + +: move-gap-back-inside? ( i gb -- i gb ? ) + ! is it cheaper to move the gap inside than around? + 2dup [ gap-start>> swap 2 * - ] keep [ buffer-length ] keep gap-end>> - <= ; + +: move-gap-forward-inside? ( i gb -- i gb ? ) + ! is it cheaper to move the gap inside than around? + 2dup [ gap-end>> [ 2 * ] dip - ] keep [ gap-start>> ] keep buffer-length + <= ; + +: move-gap-forward-inside ( i gb -- ) + [ dup gap-length neg swap gap-end>> rot ] keep seq>> copy-elements ; + +: move-gap-back-inside ( i gb -- ) + [ dup gap-length swap gap-start>> 1 - rot 1 - ] keep seq>> copy-elements ; + +: move-gap-forward-around ( i gb -- ) + 0 over move-gap-back-inside [ + dup buffer-length [ + swap gap-length - neg swap + ] keep + ] keep [ + seq>> copy-elements + ] keep dup gap-length swap seq>> change-circular-start ; + +: move-gap-back-around ( i gb -- ) + dup buffer-length over move-gap-forward-inside [ + length swap -1 + ] keep [ + seq>> copy-elements + ] keep dup length swap seq>> change-circular-start ; + +: move-gap-forward ( i gb -- ) + move-gap-forward-inside? [ + move-gap-forward-inside + ] [ + move-gap-forward-around + ] if ; + +: move-gap-back ( i gb -- ) + move-gap-back-inside? [ + move-gap-back-inside + ] [ + move-gap-back-around + ] if ; + +: (move-gap) ( i gb -- ) + move-gap? [ + move-gap-forward? [ + move-gap-forward + ] [ + move-gap-back + ] if + ] [ 2drop ] if ; + +: fix-gap ( n gb -- ) + 2dup [ gap-length + ] keep gap-end<< gap-start<< ; + +! moving the gap to position 5 means that the element in position 5 will be immediately after the gap +GENERIC: move-gap ( n gb -- ) + +M: gb move-gap ( n gb -- ) 2dup [ position>index ] keep (move-gap) fix-gap ; + +! ------------ resizing ------------------------------------- + +: enough-room? ( n gb -- ? ) + ! is there enough room to add 'n' elements to gb? + tuck length + swap buffer-length <= ; + +: set-new-gap-end ( array gb -- ) + [ buffer-length swap length swap - ] keep + [ gap-end>> + ] keep gap-end<< ; + +: after-gap ( gb -- gb ) + dup seq>> swap gap-end>> tail ; + +: before-gap ( gb -- gb ) + dup gap-start>> head ; + +: copy-after-gap ( array gb -- ) + ! copy everything after the gap in 'gb' into the end of 'array', + ! and change 'gb's gap-end to reflect the gap-end in 'array' + dup after-gap [ 2dup set-new-gap-end gap-end>> swap ] dip -rot copy ; + +: copy-before-gap ( array gb -- ) + ! copy everything before the gap in 'gb' into the start of 'array' + before-gap 0 rot copy ; ! gap start doesn't change + +: resize-buffer ( gb new-size -- ) + f swap 2dup copy-before-gap 2dup copy-after-gap + [ ] dip seq<< ; + +: decrease-buffer-size ( gb -- ) + ! the gap is too big, so resize to something sensible + dup length over required-space resize-buffer ; + +: increase-buffer-size ( n gb -- ) + ! increase the buffer to fit at least 'n' more elements + tuck length + over required-space resize-buffer ; + +: gb-too-big? ( gb -- ? ) + dup buffer-length over min-size>> > [ + dup length over buffer-length rot expand-factor>> sq / < + ] [ drop f ] if ; + +: ?decrease ( gb -- ) + dup gb-too-big? [ + decrease-buffer-size + ] [ drop ] if ; + +: ensure-room ( n gb -- ) + ! ensure that ther will be enough room for 'n' more elements + 2dup enough-room? [ 2drop ] [ + increase-buffer-size + ] if ; + +! ------- editing operations --------------- + +GENERIC#: insert* 2 ( seq position gb -- ) + +: prepare-insert ( seq position gb -- seq gb ) + tuck move-gap over length over ensure-room ; + +: insert-elements ( seq gb -- ) + dup gap-start>> swap seq>> copy ; + +: increment-gap-start ( gb n -- ) + over gap-start>> + swap gap-start<< ; + +! generic dispatch identifies numbers as sequences before numbers... +M: number insert* ( elem position gb -- ) [ 1array ] 2dip insert* ; +! : number-insert ( num position gb -- ) [ 1array ] 2dip insert* ; + +M: sequence insert* ( seq position gb -- ) + prepare-insert [ insert-elements ] 2keep swap length increment-gap-start ; + +: (delete*) ( gb -- ) + dup gap-end>> 1 + over gap-end<< ?decrease ; + +GENERIC: delete* ( pos gb -- ) + +M: gb delete* ( position gb -- ) + tuck move-gap (delete*) ; + +! -------- stack/queue operations ----------- + +: push-start ( obj gb -- ) 0 swap insert* ; + +: push-end ( obj gb -- ) [ length ] keep insert* ; + +: pop-elem ( position gb -- elem ) [ nth ] 2keep delete* ; + +: pop-start ( gb -- elem ) 0 swap pop-elem ; + +: pop-end ( gb -- elem ) [ length 1 - ] keep pop-elem ; + +: rotate-right ( gb -- ) + dup [ pop-end ] keep push-start drop ; + +: rotate-left ( gb -- ) + dup [ pop-start ] keep push-end drop ; + +: rotate ( n gb -- ) + over 0 > [ + '[ _ rotate-right ] times + ] [ + [ neg ] dip '[ _ rotate-left ] times + ] if ; diff --git a/extra/gap-buffer/summary.txt b/extra/gap-buffer/summary.txt new file mode 100644 index 0000000000..0da4c0075d --- /dev/null +++ b/extra/gap-buffer/summary.txt @@ -0,0 +1 @@ +Gap buffer data structure diff --git a/extra/gap-buffer/tags.txt b/extra/gap-buffer/tags.txt new file mode 100644 index 0000000000..57de004d91 --- /dev/null +++ b/extra/gap-buffer/tags.txt @@ -0,0 +1 @@ +collections sequences From 0e51880199e8d27abe271e53e62e1cb56b196a93 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 16:14:44 -0500 Subject: [PATCH 03/84] math.matrices: Add some more matrix norms. --- basis/math/matrices/matrices-tests.factor | 9 +++++++++ basis/math/matrices/matrices.factor | 3 +++ 2 files changed, 12 insertions(+) diff --git a/basis/math/matrices/matrices-tests.factor b/basis/math/matrices/matrices-tests.factor index 3855357b46..f82fef7c85 100644 --- a/basis/math/matrices/matrices-tests.factor +++ b/basis/math/matrices/matrices-tests.factor @@ -383,3 +383,12 @@ CONSTANT: test-points { { t } [ { { 1 2 } { 3 4 } } square-matrix? ] unit-test { f } [ { { 1 } { 2 3 } } square-matrix? ] unit-test { f } [ { { 1 2 } } square-matrix? ] unit-test + +{ 9 } +[ { { 2 -2 1 } { 1 3 -1 } { 2 -4 2 } } m-1norm ] unit-test + +{ 8 } +[ { { 2 -2 1 } { 1 3 -1 } { 2 -4 2 } } m-infinity-norm ] unit-test + +{ 2.0 } +[ { { 1 1 } { 1 1 } } frobenius-norm ] unit-test diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor index 0cab9a1472..ef5a06a22f 100644 --- a/basis/math/matrices/matrices.factor +++ b/basis/math/matrices/matrices.factor @@ -141,6 +141,9 @@ IN: math.matrices : mmin ( m -- n ) [ 1/0. ] dip [ [ min ] each ] each ; : mmax ( m -- n ) [ -1/0. ] dip [ [ max ] each ] each ; : mnorm ( m -- n ) dup mmax abs m/n ; +: m-infinity-norm ( m -- n ) [ [ abs ] map-sum ] map supremum ; +: m-1norm ( m -- n ) flip m-infinity-norm ; +: frobenius-norm ( m -- n ) [ [ sq ] map-sum ] map-sum sqrt ; : cross ( vec1 vec2 -- vec3 ) [ [ { 1 2 0 } vshuffle ] [ { 2 0 1 } vshuffle ] bi* v* ] From b1e179106b7232d5eb7ae9b8528ad60e81ba3e44 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 18:05:40 -0500 Subject: [PATCH 04/84] gap-buffer: fix using. I'm cooking something up for travisci for this... --- extra/gap-buffer/gap-buffer.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/gap-buffer/gap-buffer.factor b/extra/gap-buffer/gap-buffer.factor index 166bc13400..5da01b2491 100644 --- a/extra/gap-buffer/gap-buffer.factor +++ b/extra/gap-buffer/gap-buffer.factor @@ -4,7 +4,7 @@ ! gap buffer -- largely influenced by Strandh and Villeneuve's Flexichain ! for a good introduction see: ! https://common-lisp.net/project/flexichain/download/StrandhVilleneuveMoore.pdf -USING: accessors arrays circular kernel math math.functions +USING: accessors arrays circular fry kernel math math.functions math.order multiline sequences sequences.private ; IN: gap-buffer From 147d13ed19f2b6735ef5bc99b944359bb71b4acb Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 18:29:17 -0500 Subject: [PATCH 05/84] io.pathnames: Add a useful word 3append-path --- core/io/pathnames/pathnames.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index 2d382e49d1..29e683a48d 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -111,6 +111,9 @@ PRIVATE> : prepend-path ( path1 path2 -- path ) swap append-path ; inline +: 3append-path ( path chunk1 chunk2 -- path' ) + [ append-path ] dip append-path ; inline + : file-name ( path -- string ) dup root-directory? [ trim-tail-separators From 000f3eab07a77986987375a03cbfec9fb6461f49 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 18:32:19 -0500 Subject: [PATCH 06/84] sequences.extras: Add count-head and count-tail --- extra/sequences/extras/extras.factor | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 334fc60b3f..85bf132719 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -628,6 +628,13 @@ PRIVATE> [ '[ @ not ] find drop ] keepd swap [ dup length ] unless* tail-slice ; inline +: count-head ( seq quot -- n ) + [ not ] compose find drop ; inline + +: count-tail ( seq quot -- n ) + [ not ] compose [ find-last drop ] 2keep drop + length swap [ - 1 - ] when* ; inline + :: interleaved-as ( seq glue exemplar -- newseq ) seq length dup 1 - + 0 max exemplar new-sequence :> newseq seq [ 2 * newseq set-nth-unsafe ] each-index From 725bbf9e455b2d21a7a27d065107ae5c1e76e488 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 18:32:34 -0500 Subject: [PATCH 07/84] cli.git: Allow git commands from within the directory and from without.. --- extra/cli/git/git.factor | 37 +++++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 12 deletions(-) diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor index ce9bbcc7b0..1b589a008f 100644 --- a/extra/cli/git/git.factor +++ b/extra/cli/git/git.factor @@ -9,24 +9,37 @@ IN: cli.git SYMBOL: cli-git-num-parallel cli-git-num-parallel [ cpus 2 * ] initialize -: git-clone-as ( ssh-url path -- process ) - [ { "git" "clone" } ] 2dip 2array append run-process ; - -: git-clone ( ssh-url -- process ) - [ { "git" "clone" } ] dip suffix run-process ; - -: git-pull ( path -- process ) - [ { "git" "pull" } run-process ] with-directory ; +: git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-process ; +: git-clone ( uri -- process ) [ { "git" "clone" } ] dip suffix run-process ; +: git-pull* ( -- process ) { "git" "pull" } run-process ; +: git-pull ( path -- process ) [ git-pull* ] with-directory ; +: git-fetch-all* ( -- process ) { "git" "fetch" "--all" } run-process ; +: git-fetch-all ( path -- process ) [ git-fetch-all* ] with-directory ; +: git-fetch-tags* ( -- process ) { "git" "fetch" "--tags" } run-process ; +: git-fetch-tags ( path -- process ) [ git-fetch-tags* ] with-directory ; +: git-checkout-new-branch* ( branch -- process ) [ { "git" "checkout" "-b" } ] dip suffix run-process ; +: git-checkout-new-branch ( path branch -- process ) '[ _ git-checkout-new-branch* ] with-directory ; +: git-checkout-existing-branch* ( branch -- process ) [ { "git" "checkout" } ] dip suffix run-process ; +: git-checkout-existing-branch ( path branch -- process ) '[ _ git-checkout-existing-branch* ] with-directory ; +: git-change-remote* ( remote uri -- process ) [ { "git" "remote" "set-url" } ] 2dip 2array append run-process ; +: git-change-remote ( path remote uri -- process ) '[ _ _ git-change-remote* ] with-directory ; +: git-remote-add* ( remote uri -- process ) [ { "git" "remote" "add" } ] 2dip 2array append run-process ; +: git-remote-add ( path remote uri -- process ) '[ _ _ git-remote-add* ] with-directory ; +: git-remote-get-url* ( remote -- process ) [ { "git" "remote" "get-url" } ] dip suffix run-process ; +: git-remote-get-url ( path remote -- process ) '[ _ git-remote-get-url* ] with-directory ; : git-repository? ( directory -- ? ) ".git" append-path current-directory get prepend-path ?file-info dup [ directory? ] when ; +: git-current-branch* ( -- name ) + ! { "git" "rev-parse" "--abbrev-ref" "HEAD" } + { "git" "name-rev" "--name-only" "HEAD" } + utf8 stream-contents + [ blank? ] trim-tail ; + : git-current-branch ( directory -- name ) - [ - { "git" "rev-parse" "--abbrev-ref" "HEAD" } - utf8 stream-contents - ] with-directory [ blank? ] trim-tail ; + [ git-current-branch* ] with-directory ; : repository-url>name ( string -- string' ) file-name ".git" ?tail drop ; From 1a084d2293bc9dd3ca2a2dbceba7a87137f17e37 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 18:33:37 -0500 Subject: [PATCH 08/84] webservices.github: Add more commands needed for zealot. --- extra/web-services/github/github.factor | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/extra/web-services/github/github.factor b/extra/web-services/github/github.factor index 09cfa16485..4fe79a700c 100644 --- a/extra/web-services/github/github.factor +++ b/extra/web-services/github/github.factor @@ -1,9 +1,7 @@ ! Copyright (C) 2017 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs cli.git concurrency.combinators -concurrency.semaphores formatting fry http.client io -io.directories json.reader kernel locals math namespaces -sequences ; +USING: assocs cli.git formatting http.client io.pathnames +json.reader kernel locals math namespaces sequences ; IN: web-services.github SYMBOL: github-username @@ -31,3 +29,10 @@ SYMBOL: github-token github-token get sync-organization-with-credentials ; +: github-git-uri ( user project -- uri ) [ "git@github.com" ] 2dip "/" glue ":" glue ; +: github-ssh-uri ( user project -- uri ) [ "https://github.com" ] 2dip 3append-path ; +: github-git-clone-as ( user project name -- process ) [ github-git-uri ] dip git-clone-as ; +: github-ssh-clone-as ( user project name -- process ) [ github-ssh-uri ] dip git-clone-as ; +: github-git-clone ( user project -- process ) dup github-git-clone-as ; +: github-ssh-clone ( user project -- process ) dup github-ssh-clone-as ; + From 138d150da21fc693badb2fcd328c6439589eea0f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 18:35:24 -0500 Subject: [PATCH 09/84] zealot: Add a second CI type system to compete with mason. This is for testing PRs against changed vocabs. --- extra/zealot/authors.txt | 1 + extra/zealot/factor/authors.txt | 1 + extra/zealot/factor/factor.factor | 170 ++++++++++++++++++++++++++++++ extra/zealot/zealot.factor | 77 ++++++++++++++ 4 files changed, 249 insertions(+) create mode 100644 extra/zealot/authors.txt create mode 100644 extra/zealot/factor/authors.txt create mode 100644 extra/zealot/factor/factor.factor create mode 100644 extra/zealot/zealot.factor diff --git a/extra/zealot/authors.txt b/extra/zealot/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/zealot/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/zealot/factor/authors.txt b/extra/zealot/factor/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/zealot/factor/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/zealot/factor/factor.factor b/extra/zealot/factor/factor.factor new file mode 100644 index 0000000000..0fdaffcfb7 --- /dev/null +++ b/extra/zealot/factor/factor.factor @@ -0,0 +1,170 @@ +! Copyright (C) 2017 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays bootstrap.image calendar cli.git +combinators concurrency.combinators formatting fry http.client +io io.directories io.launcher io.pathnames kernel math.parser +memory modern.paths namespaces parser.notes prettyprint +sequences sequences.extras system system-info threads tools.test +tools.test.private vocabs vocabs.hierarchy +vocabs.hierarchy.private vocabs.loader zealot ; +IN: zealot.factor + +: download-boot-checksums ( path branch -- ) + '[ _ "http://downloads.factorcode.org/images/%s/checksums.txt" sprintf download ] with-directory ; + +: download-boot-image ( path branch image-name -- ) + '[ _ _ "http://downloads.factorcode.org/images/%s/%s" sprintf download ] with-directory ; + +: download-my-boot-image ( path branch -- ) + my-boot-image-name download-boot-image ; + +HOOK: compile-factor-command os ( -- array ) +M: unix compile-factor-command ( -- array ) + { "make" "-j" } cpus number>string suffix ; +M: windows compile-factor-command ( -- array ) + { "nmake" "/f" "NMakefile" "x86-64" } ; + +HOOK: factor-path os ( -- path ) +M: unix factor-path "./factor" ; +M: windows factor-path "./factor.com" ; + +: compile-factor ( path -- ) + [ + + compile-factor-command >>command + "./compile-log" >>stdout + +stdout+ >>stderr + +new-group+ >>group + try-process + ] with-directory ; + +: bootstrap-factor ( path -- ) + [ + + factor-path "-i=" my-boot-image-name append "-no-user-init" 3array >>command + +closed+ >>stdin + "./bootstrap-log" >>stdout + +stdout+ >>stderr + 30 minutes >>timeout + +new-group+ >>group + try-process + ] with-directory ; + +! Meant to run in the child process +: with-child-options ( quot -- ) + f parser-quiet? set-global + f restartable-tests? set-global + f long-unit-tests-enabled? set-global + call ; inline + +: zealot-load-and-save ( vocabs path -- ) + dup "load-and-save to " prepend print flush yield + '[ + [ load ] each _ save-image + ] with-child-options ; + +: zealot-load-basis ( -- ) basis-vocabs "factor.image.basis" zealot-load-and-save ; +: zealot-load-extra ( -- ) extra-vocabs "factor.image.extra" zealot-load-and-save ; + +! like ``"" load`` -- only platform-friendly vocabs +: zealot-vocabs-from-root ( root -- seq ) "" vocabs-to-load [ vocab-name ] map ; +: zealot-all-vocabs ( -- seq ) vocab-roots get [ zealot-vocabs-from-root ] map-concat ; +: zealot-core-vocabs ( -- seq ) "resource:core" zealot-vocabs-from-root ; +: zealot-basis-vocabs ( -- seq ) "resource:basis" zealot-vocabs-from-root ; +: zealot-extra-vocabs ( -- seq ) "resource:extra" zealot-vocabs-from-root ; + +: zealot-load-all ( -- ) zealot-all-vocabs "factor.image.all" zealot-load-and-save ; + +: zealot-load-command ( command log-path -- process ) + + swap >>stdout + swap >>command + +closed+ >>stdin + +stdout+ >>stderr + 60 minutes >>timeout + +new-group+ >>group ; + +: zealot-load-basis-command ( -- process ) + factor-path "-e=USE: zealot.factor zealot-load-basis" 2array + "./load-basis-log" zealot-load-command ; + +: zealot-load-extra-command ( -- process ) + factor-path "-e=USE: zealot.factor zealot-load-extra" 2array + "./load-extra-log" zealot-load-command ; + +: zealot-load-commands ( path -- ) + [ + zealot-load-basis-command + zealot-load-extra-command 2array + [ try-process ] parallel-each + ] with-directory ; + +: zealot-test-command ( command log-path -- process ) + + swap >>stdout + swap >>command + +closed+ >>stdin + +stdout+ >>stderr + 60 minutes >>timeout + +new-group+ >>group ; + +: zealot-load-and-test ( vocabs -- ) + '[ + _ [ [ load ] each ] [ test-vocabs ] bi + ] with-child-options ; + +: load-and-test-command ( i -- command ) + [ + factor-path + "-i=factor.image" + ] dip + [ + "-e=USING: zealot.factor tools.test grouping.extras formatting ; [ %d all-zealot-vocabs 32 n-groups nth zealot-load-and-test ] with-child-options" + sprintf 3array + ] [ "./test-%d-log" sprintf ] bi + + + swap >>stdout + swap >>command + +closed+ >>stdin + +stdout+ >>stderr + 60 minutes >>timeout + +new-group+ >>group ; + +: zealot-test-commands ( path -- ) + [ + 32 [ + load-and-test-command + ] map [ try-process ] parallel-each + ] with-directory ; + +: zealot-test-commands-old ( path -- ) + [ + factor-path "-i=factor.image" "-e=USE: zealot.factor USE: tools.test [ zealot-core-vocabs test-vocabs ] with-child-options" 3array + "./test-core-log" zealot-test-command + + factor-path "-i=factor.image.basis" "-e=USE: zealot.factor USE: tools.test [ zealot-basis-vocabs test-vocabs ] with-child-options" 3array + "./test-basis-log" zealot-test-command + + factor-path "-i=factor.image.extra" "-e=USE: zealot.factor USE: tools.test [ zealot-extra-vocabs test-vocabs ] with-child-options" 3array + "./test-extra-log" zealot-test-command 3array + + [ try-process ] parallel-each + ] with-directory ; + +: build-new-factor ( branch -- ) + "factor" "factor" zealot-github-ensure drop + + [ "factor" "factor" zealot-github-clone-paths nip ] dip + over . flush yield + { + [ drop "factor" "factor" zealot-github-add-build-remote drop ] + [ drop [ git-fetch-all* ] with-directory drop ] + [ zealot-build-checkout-branch drop ] + [ "ZEALOT DOWNLOADING BOOT IMAGE" print flush download-my-boot-image ] + [ "ZEALOT DOWNLOADING CHECKSUMS" print flush download-boot-checksums ] + [ "ZEALOT COMPILING" print flush drop compile-factor ] + [ "ZEALOT BOOTSTRAPPING" print flush drop bootstrap-factor ] + [ "ZEALOT LOADING ROOTS" print flush drop zealot-load-commands ] + [ "ZEALOT TESTING ROOTS" print flush drop zealot-test-commands ] + } 2cleave ; diff --git a/extra/zealot/zealot.factor b/extra/zealot/zealot.factor new file mode 100644 index 0000000000..9fcd173768 --- /dev/null +++ b/extra/zealot/zealot.factor @@ -0,0 +1,77 @@ +! Copyright (C) 2017 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: cli.git combinators fry io.directories io.files.info +io.pathnames kernel sequences uuid web-services.github ; +IN: zealot + +: default-zealot-directory ( chunk -- path ) [ home ".zealot" ] dip 3append-path ; +: default-zealot-source-directory ( -- path ) "source" default-zealot-directory ; +: default-zealot-builds-directory ( -- path ) "builds" default-zealot-directory ; + +: zealot-source-directory ( chunk -- path ) [ default-zealot-source-directory ] dip append-path ; +: zealot-builds-directory ( chunk -- path ) [ default-zealot-builds-directory ] dip append-path ; + +: with-default-zealot-source-directory ( chunk quot -- ) + [ default-zealot-source-directory ] dip with-ensure-directory ; inline + +: with-default-zealot-builds-directory ( chunk quot -- ) + [ default-zealot-builds-directory ] dip with-ensure-directory ; inline + +: with-zealot-source-directory ( chunk quot -- ) + [ zealot-source-directory ] dip with-ensure-directory ; inline + +: with-zealot-builds-directory ( chunk quot -- ) + [ zealot-builds-directory ] dip with-ensure-directory ; inline + + +: with-zealot-github-directory ( quot -- ) + [ "github" ] dip with-zealot-source-directory ; inline + +: with-zealot-github-project-directory ( user project quot -- ) + [ "github" ] 3dip [ 3append-path ] dip with-zealot-source-directory ; inline + +: zealot-github-clone ( user project -- process ) + '[ _ _ 2dup "/" glue github-git-clone-as ] with-zealot-github-directory ; inline + +: zealot-github-source-path ( user project -- path ) + [ "github" ] 2dip 3append-path zealot-source-directory ; + +: zealot-github-builds-path ( user project -- path ) + [ "github" ] 2dip 3append-path uuid1 append-path zealot-builds-directory ; + +: zealot-github-fetch-all ( user project -- process ) + [ git-fetch-all* ] with-zealot-github-project-directory ; + +: zealot-github-fetch-tags ( user project -- process ) + [ git-fetch-tags* ] with-zealot-github-project-directory ; + +: zealot-github-pull ( user project -- process ) + [ git-pull* ] with-zealot-github-project-directory ; + +: zealot-github-exists-locally? ( user project -- ? ) + zealot-github-source-path ?file-info >boolean ; + +: zealot-github-ensure ( user project -- process ) + 2dup zealot-github-exists-locally? [ + { + [ zealot-github-fetch-all drop ] + [ zealot-github-fetch-tags drop ] + [ zealot-github-pull ] + } 2cleave + ] [ + zealot-github-clone + ] if ; + +: zealot-github-set-build-remote ( path user project -- process ) + '[ "origin" _ _ github-ssh-uri git-change-remote* ] with-directory ; + +: zealot-github-add-build-remote ( path user project -- process ) + '[ "github" _ _ github-ssh-uri git-remote-add* ] with-directory ; + +: zealot-github-clone-paths ( user project -- process builds-path ) + [ zealot-github-source-path ] + [ zealot-github-builds-path ] 2bi + [ git-clone-as ] keep ; + +: zealot-build-checkout-branch ( path branch -- process ) + '[ _ git-checkout-existing-branch* ] with-directory ; From 256f0ed4a406d38db4afe390ed29c869f88b42f1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 18:47:14 -0500 Subject: [PATCH 10/84] modern: Add to extra/ some version of modern that has the modern.paths vocab. For travisci. --- extra/modern/modern-tests.factor | 243 +++++++++++++++ extra/modern/modern.factor | 499 ++++++++++++++++++++++++++++++ extra/modern/out/authors.txt | 1 + extra/modern/out/out.factor | 108 +++++++ extra/modern/paths/authors.txt | 1 + extra/modern/paths/paths.factor | 107 +++++++ extra/modern/slices/slices.factor | 228 ++++++++++++++ 7 files changed, 1187 insertions(+) create mode 100644 extra/modern/modern-tests.factor create mode 100644 extra/modern/modern.factor create mode 100644 extra/modern/out/authors.txt create mode 100644 extra/modern/out/out.factor create mode 100644 extra/modern/paths/authors.txt create mode 100644 extra/modern/paths/paths.factor create mode 100644 extra/modern/slices/slices.factor diff --git a/extra/modern/modern-tests.factor b/extra/modern/modern-tests.factor new file mode 100644 index 0000000000..ff71231544 --- /dev/null +++ b/extra/modern/modern-tests.factor @@ -0,0 +1,243 @@ +! Copyright (C) 2017 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: modern modern.slices multiline tools.test ; +IN: modern.tests + +{ f } [ "" upper-colon? ] unit-test +{ t } [ ":" upper-colon? ] unit-test +{ t } [ "::" upper-colon? ] unit-test +{ t } [ ":::" upper-colon? ] unit-test +{ t } [ "FOO:" upper-colon? ] unit-test +{ t } [ "FOO::" upper-colon? ] unit-test +{ t } [ "FOO:::" upper-colon? ] unit-test + +! 'FOO: +{ f } [ "'" upper-colon? ] unit-test +{ t } [ "':" upper-colon? ] unit-test +{ t } [ "'::" upper-colon? ] unit-test +{ t } [ "':::" upper-colon? ] unit-test +{ t } [ "'FOO:" upper-colon? ] unit-test +{ t } [ "'FOO::" upper-colon? ] unit-test +{ t } [ "'FOO:::" upper-colon? ] unit-test + +! \FOO: is not an upper-colon form, it is deactivated by the \ +{ f } [ "\\" upper-colon? ] unit-test +{ f } [ "\\:" upper-colon? ] unit-test +{ f } [ "\\::" upper-colon? ] unit-test +{ f } [ "\\:::" upper-colon? ] unit-test +{ f } [ "\\FOO:" upper-colon? ] unit-test +{ f } [ "\\FOO::" upper-colon? ] unit-test +{ f } [ "\\FOO:::" upper-colon? ] unit-test + + +! Comment +{ + { { "!" "" } } +} [ "!" string>literals >strings ] unit-test + +{ + { { "!" " lol" } } +} [ "! lol" string>literals >strings ] unit-test + +{ + { "lol!" } +} [ "lol!" string>literals >strings ] unit-test + +{ + { { "!" "lol" } } +} [ "!lol" string>literals >strings ] unit-test + +! Colon +{ + { ":asdf:" } +} [ ":asdf:" string>literals >strings ] unit-test + +{ + { { "one:" { "1" } } } +} [ "one: 1" string>literals >strings ] unit-test + +{ + { { "two::" { "1" "2" } } } +} [ "two:: 1 2" string>literals >strings ] unit-test + +{ + { "1" ":>" "one" } +} [ "1 :> one" string>literals >strings ] unit-test + +{ + { { ":" { "foo" } ";" } } +} [ ": foo ;" string>literals >strings ] unit-test + +{ + { + { "FOO:" { "a" } } + { "BAR:" { "b" } } + } +} [ "FOO: a BAR: b" string>literals >strings ] unit-test + +{ + { { "FOO:" { "a" } ";" } } +} [ "FOO: a ;" string>literals >strings ] unit-test + +{ + { { "FOO:" { "a" } "FOO;" } } +} [ "FOO: a FOO;" string>literals >strings ] unit-test + + +! Acute +{ + { { "" } } +} [ "" string>literals >strings ] unit-test + +{ + { { "" } } +} [ "" string>literals >strings ] unit-test + +{ { "" } } [ "" string>literals >strings ] unit-test +{ { ">foo<" } } [ ">foo<" string>literals >strings ] unit-test + +{ { "foo>" } } [ "foo>" string>literals >strings ] unit-test +{ { ">foo" } } [ ">foo" string>literals >strings ] unit-test +{ { ">foo>" } } [ ">foo>" string>literals >strings ] unit-test +{ { ">>foo>" } } [ ">>foo>" string>literals >strings ] unit-test +{ { ">>foo>>" } } [ ">>foo>>" string>literals >strings ] unit-test + +{ { "foo<" } } [ "foo<" string>literals >strings ] unit-test +{ { "literals >strings ] unit-test +{ { "literals >strings ] unit-test +{ { "<literals >strings ] unit-test +{ { "<literals >strings ] unit-test + +! Backslash \AVL{ foo\bar foo\bar{ +{ + { { "SYNTAX:" { "\\AVL{" } } } +} [ "SYNTAX: \\AVL{" string>literals >strings ] unit-test + +[ "\\" string>literals >strings ] must-fail ! \ alone should be legal eventually (?) + +{ { "\\FOO" } } [ "\\FOO" string>literals >strings ] unit-test + +{ + { "foo\\bar" } +} [ "foo\\bar" string>literals >strings ] unit-test + +[ "foo\\bar{" string>literals >strings ] must-fail + +{ + { { "foo\\bar{" { "1" } "}" } } +} [ "foo\\bar{ 1 }" string>literals >strings ] unit-test + +{ { { "char:" { "\\{" } } } } [ "char: \\{" string>literals >strings ] unit-test +[ "char: {" string>literals >strings ] must-fail +[ "char: [" string>literals >strings ] must-fail +[ "char: {" string>literals >strings ] must-fail +[ "char: \"" string>literals >strings ] must-fail +! { { { "char:" { "\\\\" } } } } [ "char: \\\\" string>literals >strings ] unit-test + +[ "char: \\" string>literals >strings ] must-fail ! char: \ should be legal eventually + +{ { { "\\" { "(" } } } } [ "\\ (" string>literals >strings ] unit-test + +{ { "\\[[" } } [ "\\[[" string>literals >strings ] unit-test +{ { "\\[=[" } } [ "\\[=[" string>literals >strings ] unit-test +{ { "\\[==[" } } [ "\\[==[" string>literals >strings ] unit-test + + +{ t } [ "FOO:" strict-upper? ] unit-test +{ t } [ ":" strict-upper? ] unit-test +{ f } [ "" strict-upper? ] unit-test +{ f } [ "FOO>" strict-upper? ] unit-test +{ f } [ ";FOO>" strict-upper? ] unit-test + +{ f } [ "FOO" section-open? ] unit-test +{ f } [ "FOO:" section-open? ] unit-test +{ f } [ ";FOO" section-close? ] unit-test +{ f } [ "FOO" section-close? ] unit-test + + +! Strings +{ + { { "url\"" "google.com" "\"" } } +} [ [[ url"google.com" ]] string>literals >strings ] unit-test + +{ + { { "\"" "google.com" "\"" } } +} [ [[ "google.com" ]] string>literals >strings ] unit-test + +{ + { + { "(" { "a" "b" } ")" } + { "[" { "a" "b" "+" } "]" } + { "(" { "c" } ")" } + } +} [ "( a b ) [ a b + ] ( c )" string>literals >strings ] unit-test + +![[ +! Concatenated syntax +{ + { + { + { "(" { "a" "b" } ")" } + { "[" { "a" "b" "+" } "]" } + { "(" { "c" } ")" } + } + } +} [ "( a b )[ a b + ]( c )" string>literals >strings ] unit-test + +{ + { + { + { "\"" "abc" "\"" } + { "[" { "0" } "]" } + } + } +} [ "\"abc\"[ 0 ]" string>literals >strings ] unit-test +]] + + +{ + { + { "" } + } +} [ "" string>literals >strings ] unit-test + +{ + { + { "" } + } +} [ "" string>literals >strings ] unit-test + + +![[ +{ + { + { + { + "foo::" + { + { + { "" } + { "[" { "0" } "]" } + { "[" { "1" } "]" } + { "[" { "2" } "]" } + { "[" { "3" } "]" } + } + { { "" } } + } + } + } + } +} [ "foo:: [ 0 ][ 1 ][ 2 ][ 3 ] " string>literals >strings ] unit-test +]] + +{ + { + { "foo::" { { "" } { "[" { "0" } "]" } } } + { "[" { "1" } "]" } + { "[" { "2" } "]" } + { "[" { "3" } "]" } + { "" } + } +} [ "foo:: [ 0 ] [ 1 ] [ 2 ] [ 3 ] " string>literals >strings ] unit-test diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor new file mode 100644 index 0000000000..63f2645eda --- /dev/null +++ b/extra/modern/modern.factor @@ -0,0 +1,499 @@ +! Copyright (C) 2016 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays assocs combinators combinators.short-circuit +continuations fry io.encodings.utf8 io.files kernel locals make +math math.order modern.paths modern.slices sequences +sequences.extras sets splitting strings unicode vocabs.loader ; +IN: modern + +ERROR: string-expected-got-eof n string ; +ERROR: long-opening-mismatch tag open n string ch ; + +! (( )) [[ ]] {{ }} +MACRO:: read-double-matched ( open-ch -- quot: ( n string tag ch -- n' string seq ) ) + open-ch dup matching-delimiter { + [ drop 2 swap ] + [ drop 1string ] + [ nip 2 swap ] + } 2cleave :> ( openstr2 openstr1 closestr2 ) + [| n string tag! ch | + ch { + { CHAR: = [ + tag 1 cut-slice* drop tag! ! tag of (=( is ( here, fix it + n string openstr1 slice-til-separator-inclusive [ -1 modify-from ] dip :> ( n' string' opening ch ) + ch open-ch = [ tag openstr2 n string ch long-opening-mismatch ] unless + opening matching-delimiter-string :> needle + + n' string' needle slice-til-string :> ( n'' string'' payload closing ) + n'' string + tag opening payload closing 4array + ] } + { open-ch [ + tag 1 cut-slice* swap tag! 1 modify-to :> opening + n 1 + string closestr2 slice-til-string :> ( n' string' payload closing ) + n' string + tag opening payload closing 4array + ] } + [ [ tag openstr2 n string ] dip long-opening-mismatch ] + } case + ] ; + +: read-double-matched-paren ( n string tag ch -- n' string seq ) CHAR: ( read-double-matched ; +: read-double-matched-bracket ( n string tag ch -- n' string seq ) CHAR: [ read-double-matched ; +: read-double-matched-brace ( n string tag ch -- n' string seq ) CHAR: { read-double-matched ; + +DEFER: lex-factor-top +DEFER: lex-factor +ERROR: lex-expected-but-got-eof n string expected ; +! For implementing [ { ( +: lex-until ( n string tag-sequence -- n' string payload ) + 3dup '[ + [ + lex-factor-top dup f like [ , ] when* [ + dup [ + ! } gets a chance, but then also full seq { } after recursion... + [ _ ] dip '[ _ sequence= ] any? not + ] [ + drop t ! loop again? + ] if + ] [ + _ _ _ lex-expected-but-got-eof + ] if* + ] loop + ] { } make ; + +DEFER: section-close? +DEFER: upper-colon? +DEFER: lex-factor-nested +: lex-colon-until ( n string tag-sequence -- n' string payload ) + '[ + [ + lex-factor-nested dup f like [ , ] when* [ + dup [ + ! This is for ending COLON: forms like ``A: PRIVATE>`` + dup section-close? [ + drop f + ] [ + ! } gets a chance, but then also full seq { } after recursion... + [ _ ] dip '[ _ sequence= ] any? not + ] if + ] [ + drop t ! loop again? + ] if + ] [ + f + ] if* + ] loop + ] { } make ; + +: split-double-dash ( seq -- seqs ) + dup [ { [ "--" sequence= ] } 1&& ] split-when + dup length 1 > [ nip ] [ drop ] if ; + +MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) ) + ch dup matching-delimiter { + [ drop "=" swap prefix ] + [ nip 1string ] + } 2cleave :> ( openstreq closestr1 ) ! [= ] + [| n string tag | + n string tag + 2over nth-check-eof { + { [ dup openstreq member? ] [ ch read-double-matched ] } ! (=( or (( + { [ dup blank? ] [ + drop dup '[ _ matching-delimiter-string closestr1 2array members lex-until ] dip + swap unclip-last 3array ] } ! ( foo ) + [ drop [ slice-til-whitespace drop ] dip span-slices ] ! (foo) + } cond + ] ; + +: read-bracket ( n string slice -- n' string slice' ) CHAR: [ read-matched ; +: read-brace ( n string slice -- n' string slice' ) CHAR: { read-matched ; +: read-paren ( n string slice -- n' string slice' ) CHAR: ( read-matched ; +: read-string-payload ( n string -- n' string ) + over [ + { CHAR: \\ CHAR: \" } slice-til-separator-inclusive { + { f [ drop ] } + { CHAR: \" [ drop ] } + { CHAR: \\ [ drop next-char-from drop read-string-payload ] } + } case + ] [ + string-expected-got-eof + ] if ; + +:: read-string ( n string tag -- n' string seq ) + n string read-string-payload drop :> n' + n' string + n' [ n string string-expected-got-eof ] unless + n n' 1 - string + n' 1 - n' string + tag -rot 3array ; + +: take-comment ( n string slice -- n' string comment ) + 2over ?nth CHAR: [ = [ + [ 1 + ] 2dip 2over ?nth read-double-matched-bracket + ] [ + [ slice-til-eol drop ] dip swap 2array + ] if ; + +: terminator? ( slice -- ? ) + { + [ ";" sequence= ] + [ "]" sequence= ] + [ "}" sequence= ] + [ ")" sequence= ] + } 1|| ; + +ERROR: expected-length-tokens n string length seq ; +: ensure-no-false ( n string seq -- n string seq ) + dup [ length 0 > ] all? [ [ length ] keep expected-length-tokens ] unless ; + +ERROR: token-expected n string obj ; +ERROR: unexpected-terminator n string slice ; +: read-lowercase-colon ( n string slice -- n' string lowercase-colon ) + dup [ CHAR: : = ] count-tail + '[ + _ [ lex-factor ] replicate ensure-no-false dup [ token-expected ] unless + dup terminator? [ unexpected-terminator ] when + ] dip swap 2array ; + +: (strict-upper?) ( string -- ? ) + { + ! All chars must... + [ + [ + { [ CHAR: A CHAR: Z between? ] [ "':-\\#" member? ] } 1|| + ] all? + ] + ! At least one char must... + [ [ { [ CHAR: A CHAR: Z between? ] [ CHAR: ' = ] } 1|| ] any? ] + } 1&& ; + +: strict-upper? ( string -- ? ) + { [ ":" sequence= ] [ (strict-upper?) ] } 1|| ; + +! +: section-open? ( string -- ? ) + { + [ "<" head? ] + [ length 2 >= ] + [ rest strict-upper? ] + [ ">" tail? not ] + } 1&& ; + +: html-self-close? ( string -- ? ) + { + [ "<" head? ] + [ length 2 >= ] + [ rest strict-upper? not ] + [ [ blank? ] any? not ] + [ "/>" tail? ] + } 1&& ; + +: html-full-open? ( string -- ? ) + { + [ "<" head? ] + [ length 2 >= ] + [ second CHAR: / = not ] + [ rest strict-upper? not ] + [ [ blank? ] any? not ] + [ ">" tail? ] + } 1&& ; + +: html-half-open? ( string -- ? ) + { + [ "<" head? ] + [ length 2 >= ] + [ second CHAR: / = not ] + [ rest strict-upper? not ] + [ [ blank? ] any? not ] + [ ">" tail? not ] + } 1&& ; + +: html-close? ( string -- ? ) + { + [ "= ] + [ rest strict-upper? not ] + [ [ blank? ] any? not ] + [ ">" tail? ] + } 1&& ; + +: special-acute? ( string -- ? ) + { + [ section-open? ] + [ html-self-close? ] + [ html-full-open? ] + [ html-half-open? ] + [ html-close? ] + } 1|| ; + +: upper-colon? ( string -- ? ) + dup { [ length 0 > ] [ [ CHAR: : = ] all? ] } 1&& [ + drop t + ] [ + { + [ length 2 >= ] + [ "\\" head? not ] ! XXX: good? + [ ":" tail? ] + [ dup [ CHAR: : = ] find drop head strict-upper? ] + } 1&& + ] if ; + +: section-close? ( string -- ? ) + { + [ length 2 >= ] + [ "\\" head? not ] ! XXX: good? + [ ">" tail? ] + [ + { + [ but-last strict-upper? ] + [ { [ ";" head? ] [ rest but-last strict-upper? ] } 1&& ] + } 1|| + ] + } 1&& ; + +: read-til-semicolon ( n string slice -- n' string semi ) + dup '[ but-last ";" append ";" 2array { "--" ")" } append lex-colon-until ] dip + swap + ! What ended the FOO: .. ; form? + ! Remove the ; from the payload if present + ! XXX: probably can remove this, T: is dumb + ! Also in stack effects ( T: int -- ) can be ended by -- and ) + dup ?last { + { [ dup ";" sequence= ] [ drop unclip-last 3array ] } + { [ dup ";" tail? ] [ drop unclip-last 3array ] } + { [ dup "--" sequence= ] [ drop unclip-last -rot 2array [ rewind-slice ] dip ] } + { [ dup "]" sequence= ] [ drop unclip-last -rot 2array [ rewind-slice ] dip ] } + { [ dup "}" sequence= ] [ drop unclip-last -rot 2array [ rewind-slice ] dip ] } + { [ dup ")" sequence= ] [ drop unclip-last -rot 2array [ rewind-slice ] dip ] } ! (n*quot) breaks + { [ dup section-close? ] [ drop unclip-last -rot 2array [ rewind-slice ] dip ] } + { [ dup upper-colon? ] [ drop unclip-last -rot 2array [ rewind-slice ] dip ] } + [ drop 2array ] + } cond ; + +ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ; +: read-colon ( n string slice -- n' string colon ) + { + { [ dup strict-upper? ] [ read-til-semicolon ] } + { [ dup ":" tail? ] [ dup ":" head? [ read-lowercase-colon ] unless ] } ! :foo: vs foo: + [ ] + } cond ; + +: read-acute-html ( n string slice -- n' string acute ) + { + ! + { [ dup html-self-close? ] [ + ! do nothing special + ] } + ! + { [ dup html-full-open? ] [ + dup [ + rest-slice + dup ">" tail? [ but-last-slice ] when + "" surround 1array lex-until unclip-last + ] dip -rot 3array + ] } + ! " "/>" } lex-until ] dip + ! n seq slice2 slice + over ">" sequence= [ + "" surround array '[ _ lex-until ] dip unclip-last + -rot roll unclip-last [ 3array ] 2dip 3array + ] [ + ! self-contained + swap unclip-last 3array + ] if + ] } + ! + { [ dup html-close? ] [ + ! Do nothing + ] } + [ [ slice-til-whitespace drop ] dip span-slices ] + } cond ; + +: read-acute ( n string slice -- n' string acute ) + [ matching-section-delimiter 1array lex-until ] keep swap unclip-last 3array ; + +! Words like append! and suffix! are allowed for now. +: read-exclamation ( n string slice -- n' string obj ) + dup { [ "!" sequence= ] [ "#!" sequence= ] } 1|| + [ take-comment ] [ merge-slice-til-whitespace ] if ; + +ERROR: no-backslash-payload n string slice ; +: (read-backslash) ( n string slice -- n' string obj ) + merge-slice-til-whitespace dup "\\" tail? [ + ! \ foo, M\ foo + dup [ CHAR: \\ = ] count-tail + '[ + _ [ skip-blank-from slice-til-whitespace drop ] replicate + ensure-no-false + dup [ no-backslash-payload ] unless + ] dip swap 2array + ] when ; + +DEFER: lex-factor-top* +: read-backslash ( n string slice -- n' string obj ) + ! foo\ so far, could be foo\bar{ + ! remove the \ and continue til delimiter/eof + [ "\"!:[{(<>\s\r\n" slice-til-either ] dip swap [ span-slices ] dip + over "\\" head? [ + drop + ! \ foo + dup [ CHAR: \\ = ] all? [ (read-backslash) ] [ merge-slice-til-whitespace ] if + ] [ + ! foo\ or foo\bar (?) + over "\\" tail? [ drop (read-backslash) ] [ lex-factor-top* ] if + ] if ; + +! If the slice is 0 width, we stopped on whitespace. +! Advance the index and read again! + +: read-token-or-whitespace-top ( n string slice -- n' string slice/f ) + dup length 0 = [ [ 1 + ] 2dip drop lex-factor-top ] when ; + +: read-token-or-whitespace-nested ( n string slice -- n' string slice/f ) + dup length 0 = [ [ 1 + ] 2dip drop lex-factor-nested ] when ; + +: lex-factor-fallthrough ( n/f string slice/f ch/f -- n'/f string literal ) + { + { CHAR: \ [ read-backslash ] } + { CHAR: [ [ read-bracket ] } + { CHAR: { [ read-brace ] } + { CHAR: ( [ read-paren ] } + { CHAR: ] [ ] } + { CHAR: } [ ] } + { CHAR: ) [ ] } + { CHAR: " [ read-string ] } + { CHAR: ! [ read-exclamation ] } + { CHAR: > [ + [ [ CHAR: > = not ] slice-until ] dip merge-slices + dup section-close? [ + [ slice-til-whitespace drop ] dip ?span-slices + ] unless + ] } + { f [ ] } + } case ; + +! Inside a FOO: or a +: lex-factor-nested* ( n/f string slice/f ch/f -- n'/f string literal ) + { + ! Nested ``A: a B: b`` so rewind and let the parser get it top-level + { CHAR: : [ + ! A: B: then interrupt the current parser + ! A: b: then keep going + merge-slice-til-whitespace + dup { [ upper-colon? ] [ ":" = ] } 1|| + ! dup upper-colon? + [ rewind-slice f ] + [ read-colon ] if + ] } + { CHAR: < [ + ! FOO: a b + ! FOO: a b + ! FOO: a b + ! FOO: a b + + ! if we are in a FOO: and we hit a or + [ slice-til-whitespace drop ] dip span-slices + dup section-open? [ rewind-slice f ] when + ] } + { CHAR: \s [ read-token-or-whitespace-nested ] } + { CHAR: \r [ read-token-or-whitespace-nested ] } + { CHAR: \n [ read-token-or-whitespace-nested ] } + [ lex-factor-fallthrough ] + } case ; + +: lex-factor-nested ( n/f string -- n'/f string literal ) + ! skip-whitespace + "\"\\!:[{(]})<>\s\r\n" slice-til-either + lex-factor-nested* ; inline + +: lex-factor-top* ( n/f string slice/f ch/f -- n'/f string literal ) + { + { CHAR: : [ merge-slice-til-whitespace read-colon ] } + { CHAR: < [ + ! FOO: a b + ! FOO: a b + ! FOO: a b + ! FOO: a b + + ! if we are in a FOO: and we hit a \s\r\n" slice-til-either + lex-factor-top* ; inline + +ERROR: compound-syntax-disallowed n seq obj ; +: check-for-compound-syntax ( n/f seq obj -- n/f seq obj ) + dup length 1 > [ compound-syntax-disallowed ] when ; + +: check-compound-loop ( n/f string -- n/f string ? ) + [ ] [ peek-from ] [ previous-from ] 2tri + [ blank? ] bi@ or not ! no blanks between tokens + pick and ; ! and a valid index + +: lex-factor ( n/f string/f -- n'/f string literal/f ) + [ + ! Compound syntax loop + [ + lex-factor-top f like [ , ] when* + ! concatenated syntax ( a )[ a 1 + ]( b ) + check-compound-loop + ] loop + ] { } make + check-for-compound-syntax + ! concat ! "ALIAS: n*quot (n*quot)" string>literals ... breaks here + ?first f like ; + +: string>literals ( string -- sequence ) + [ 0 ] dip [ + [ lex-factor [ , ] when* over ] loop + ] { } make 2nip ; + +: vocab>literals ( vocab -- sequence ) + ".private" ?tail drop + vocab-source-path utf8 file-contents string>literals ; + +: path>literals ( path -- sequence ) + utf8 file-contents string>literals ; + +: lex-paths ( vocabs -- assoc ) + [ [ path>literals ] [ nip ] recover ] map-zip ; + +: lex-vocabs ( vocabs -- assoc ) + [ [ vocab>literals ] [ nip ] recover ] map-zip ; + +: failed-lexing ( assoc -- assoc' ) [ nip array? ] assoc-reject ; + +: lex-core ( -- assoc ) core-bootstrap-vocabs lex-vocabs ; +: lex-basis ( -- assoc ) basis-vocabs lex-vocabs ; +: lex-extra ( -- assoc ) extra-vocabs lex-vocabs ; +: lex-roots ( -- assoc ) lex-core lex-basis lex-extra 3append ; + +: lex-docs ( -- assoc ) all-docs-paths lex-paths ; +: lex-tests ( -- assoc ) all-tests-paths lex-paths ; + +: lex-all ( -- assoc ) + lex-roots lex-docs lex-tests 3append ; diff --git a/extra/modern/out/authors.txt b/extra/modern/out/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/modern/out/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/modern/out/out.factor b/extra/modern/out/out.factor new file mode 100644 index 0000000000..86a8cf81d9 --- /dev/null +++ b/extra/modern/out/out.factor @@ -0,0 +1,108 @@ +! Copyright (C) 2017 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs combinators.short-circuit +constructors continuations io io.encodings.utf8 io.files +io.streams.string kernel modern modern.paths modern.slices +prettyprint sequences sequences.extras splitting strings +vocabs.loader ; +IN: modern.out + +: token? ( obj -- ? ) + { [ slice? ] [ seq>> string? ] } 1&& ; + +TUPLE: renamed slice string ; +CONSTRUCTOR: renamed ( slice string -- obj ) ; + +: trim-before-newline ( seq -- seq' ) + dup [ char: \s = not ] find + { char: \r char: \n } member? + [ tail-slice ] [ drop ] if ; + +: write-whitespace ( last obj -- ) + swap + [ swap slice-between ] [ slice-before ] if* + trim-before-newline io::write ; + +GENERIC: write-literal* ( last obj -- last' ) +M: slice write-literal* [ write-whitespace ] [ write ] [ ] tri ; +M: array write-literal* [ write-literal* ] each ; +M: renamed write-literal* [ slice>> write-whitespace ] [ string>> write ] [ slice>> ] tri ; ! for refactoring + + + +DEFER: map-literals +: (map-literals) ( obj quot: ( obj -- obj' ) -- seq ) + over [ array? ] any? [ + [ call drop ] [ map-literals ] 2bi + ] [ + over array? [ map-literals ] [ call ] if + ] if ; inline recursive + +: map-literals ( obj quot: ( obj -- obj' ) -- seq ) + '[ _ (map-literals) ] map ; inline recursive + + + +! Start with no slice as ``last`` +: write-literal ( obj -- ) f swap write-literal* drop ; + +: write-modern-string ( seq -- string ) + [ write-literal ] with-string-writer ; inline + +: write-modern-path ( seq path -- ) + utf8 [ write-literal nl ] with-file-writer ; inline + +: write-modern-vocab ( seq vocab -- ) + vocab-source-path write-modern-path ; inline + +: rewrite-path ( path quot: ( obj -- obj' ) -- ) + ! dup print + '[ [ path>literals _ map-literals ] [ ] bi write-modern-path ] + [ drop . ] recover ; inline recursive + +: rewrite-string ( string quot: ( obj -- obj' ) -- ) + ! dup print + [ string>literals ] dip map-literals write-modern-string ; inline recursive + +: rewrite-paths ( seq quot: ( obj -- obj' ) -- ) '[ _ rewrite-path ] each ; inline recursive + +: rewrite-vocab ( vocab quot: ( obj -- obj' ) -- ) + [ [ vocab>literals ] dip map-literals ] 2keep drop write-modern-vocab ; inline recursive + +: rewrite-string-exact ( string -- string' ) + string>literals write-modern-string ; + +![[ +: rewrite-path-exact ( path -- ) + [ path>literals ] [ ] bi write-modern-path ; + +: rewrite-vocab-exact ( name -- ) + vocab-source-path rewrite-path-exact ; + +: rewrite-paths ( paths -- ) + [ rewrite-path-exact ] each ; +]] + +: strings-core-to-file ( -- ) + core-bootstrap-vocabs + [ ".private" ?tail drop vocab-source-path utf8 file-contents ] map-zip + [ "[========[" dup matching-delimiter-string surround ] assoc-map + [ + first2 [ "VOCAB: " prepend ] dip " " glue + ] map + [ " " prepend ] map "\n\n" join + "" surround "resource:core-strings.factor" utf8 set-file-contents ; + +: parsed-core-to-file ( -- ) + core-bootstrap-vocabs + [ vocab>literals ] map-zip + [ + first2 [ "strings + ! [ 3 head ] [ 3 tail* ] bi [ >strings ] bi@ { "..." } glue + ";VOCAB>" 3array + ] map 1array + + { "" } surround "resource:core-parsed.factor" utf8 [ ... ] with-file-writer ; diff --git a/extra/modern/paths/authors.txt b/extra/modern/paths/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/modern/paths/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/modern/paths/paths.factor b/extra/modern/paths/paths.factor new file mode 100644 index 0000000000..d8f896e471 --- /dev/null +++ b/extra/modern/paths/paths.factor @@ -0,0 +1,107 @@ +! Copyright (C) 2015 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators.smart io.files kernel sequences +splitting vocabs.files vocabs.hierarchy vocabs.loader +vocabs.metadata sets ; +IN: modern.paths + +ERROR: not-a-source-path path ; + +: vocabs-from ( root -- vocabs ) + "" disk-vocabs-in-root/prefix + no-prefixes [ name>> ] map ; + +: core-vocabs ( -- seq ) "resource:core" vocabs-from ; +: less-core-test-vocabs ( seq -- seq' ) + { + "vocabs.loader.test.a" + "vocabs.loader.test.b" + "vocabs.loader.test.c" + "vocabs.loader.test.d" + "vocabs.loader.test.e" + "vocabs.loader.test.f" + "vocabs.loader.test.g" + "vocabs.loader.test.h" + "vocabs.loader.test.i" + "vocabs.loader.test.j" + "vocabs.loader.test.k" + "vocabs.loader.test.l" + "vocabs.loader.test.m" + "vocabs.loader.test.n" + "vocabs.loader.test.o" + "vocabs.loader.test.p" + } diff ; + +: core-bootstrap-vocabs ( -- seq ) + core-vocabs less-core-test-vocabs ; + +: basis-vocabs ( -- seq ) "resource:basis" vocabs-from ; +: extra-vocabs ( -- seq ) "resource:extra" vocabs-from ; +: all-vocabs ( -- seq ) + [ + core-vocabs + basis-vocabs + extra-vocabs + ] { } append-outputs-as ; + +: filter-exists ( seq -- seq' ) [ exists? ] filter ; + +! These paths have syntax errors on purpose... +: reject-some-paths ( seq -- seq' ) + { + "resource:core/vocabs/loader/test/a/a.factor" + "resource:core/vocabs/loader/test/b/b.factor" + "resource:core/vocabs/loader/test/c/c.factor" + ! Here down have parse errors + "resource:core/vocabs/loader/test/d/d.factor" + "resource:core/vocabs/loader/test/e/e.factor" + "resource:core/vocabs/loader/test/f/f.factor" + "resource:core/vocabs/loader/test/g/g.factor" + "resource:core/vocabs/loader/test/h/h.factor" + "resource:core/vocabs/loader/test/i/i.factor" + "resource:core/vocabs/loader/test/j/j.factor" + "resource:core/vocabs/loader/test/k/k.factor" + "resource:core/vocabs/loader/test/l/l.factor" + "resource:core/vocabs/loader/test/m/m.factor" + "resource:core/vocabs/loader/test/n/n.factor" + "resource:core/vocabs/loader/test/o/o.factor" + "resource:core/vocabs/loader/test/p/p.factor" + } diff + ! Don't parse .modern files yet + [ ".modern" tail? ] reject ; + +: modern-source-paths ( names -- paths ) + [ vocab-source-path ] map filter-exists reject-some-paths ; +: modern-docs-paths ( names -- paths ) + [ vocab-docs-path ] map filter-exists reject-some-paths ; +: modern-tests-paths ( names -- paths ) + [ vocab-tests ] map concat filter-exists reject-some-paths ; + +: all-source-paths ( -- seq ) + all-vocabs modern-source-paths ; + +: core-docs-paths ( -- seq ) core-vocabs modern-docs-paths ; +: basis-docs-paths ( -- seq ) basis-vocabs modern-docs-paths ; +: extra-docs-paths ( -- seq ) extra-vocabs modern-docs-paths ; + +: core-test-paths ( -- seq ) core-vocabs modern-tests-paths ; +: basis-test-paths ( -- seq ) basis-vocabs modern-tests-paths ; +: extra-test-paths ( -- seq ) extra-vocabs modern-tests-paths ; + + +: all-docs-paths ( -- seq ) all-vocabs modern-docs-paths ; + : all-tests-paths ( -- seq ) all-vocabs modern-tests-paths ; + +: all-paths ( -- seq ) + [ + all-source-paths all-docs-paths all-tests-paths + ] { } append-outputs-as ; + +: core-source-paths ( -- seq ) + core-vocabs modern-source-paths reject-some-paths ; +: basis-source-paths ( -- seq ) + basis-vocabs + modern-source-paths reject-some-paths ; +: extra-source-paths ( -- seq ) + extra-vocabs + modern-source-paths reject-some-paths ; diff --git a/extra/modern/slices/slices.factor b/extra/modern/slices/slices.factor new file mode 100644 index 0000000000..ad14276a06 --- /dev/null +++ b/extra/modern/slices/slices.factor @@ -0,0 +1,228 @@ +! Copyright (C) 2016 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs fry kernel locals math sequences +sequences.deep sequences.extras strings unicode ; +IN: modern.slices + +: >strings ( seq -- str ) + [ dup slice? [ >string ] when ] deep-map ; + +: matching-delimiter ( ch -- ch' ) + H{ + { CHAR: ( CHAR: ) } + { CHAR: [ CHAR: ] } + { CHAR: { CHAR: } } + { CHAR: < CHAR: > } + { CHAR: : CHAR: ; } + } ?at drop ; + +: matching-delimiter-string ( string -- string' ) + [ matching-delimiter ] map ; + +: matching-section-delimiter ( string -- string' ) + dup ":" tail? [ + rest but-last ";" ">" surround + ] [ + rest ">" append + ] if ; + +ERROR: unexpected-end n string ; +: nth-check-eof ( n string -- nth ) + 2dup ?nth [ 2nip ] [ unexpected-end ] if* ; + +: peek-from ( n/f string -- ch ) + over [ ?nth ] [ 2drop f ] if ; + +: previous-from ( n/f string -- ch ) + over [ [ 1 - ] dip ?nth ] [ 2drop f ] if ; + +! Allow eof +: next-char-from ( n/f string -- n'/f string ch/f ) + over [ + 2dup ?nth [ [ 1 + ] 2dip ] [ f ] if* + ] [ + [ 2drop f ] [ nip ] 2bi f + ] if ; + +: prev-char-from-slice-end ( slice -- ch/f ) + [ to>> 2 - ] [ seq>> ] bi ?nth ; + +: prev-char-from-slice ( slice -- ch/f ) + [ from>> 1 - ] [ seq>> ] bi ?nth ; + +: next-char-from-slice ( slice -- ch/f ) + [ to>> ] [ seq>> ] bi ?nth ; + +: char-before-slice ( slice -- ch/f ) + [ from>> 1 - ] [ seq>> ] bi ?nth ; + +: char-after-slice ( slice -- ch/f ) + [ to>> ] [ seq>> ] bi ?nth ; + +: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt ? ) + [ find-from ] 2keep drop + pick [ drop t ] [ length -rot nip f ] if ; inline + +: skip-blank-from ( n string -- n' string ) + over [ + [ [ blank? not ] find-from* 2drop ] keep + ] when ; inline + +: skip-til-eol-from ( n string -- n' string ) + [ [ "\r\n" member? ] find-from* 2drop ] keep ; inline + +! Don't include the whitespace in the slice +:: slice-til-whitespace ( n string -- n' string slice/f ch/f ) + n [ + n string [ "\s\r\n" member? ] find-from :> ( n' ch ) + n' string + n n' string ? + ch + ] [ + f string f f + ] if ; inline + +:: (slice-until) ( n string quot -- n' string slice/f ch/f ) + n string quot find-from :> ( n' ch ) + n' string + n n' string ? + ch ; inline + +: slice-until ( n string quot -- n' string slice/f ) + (slice-until) drop ; inline + +:: slice-til-not-whitespace ( n string -- n' string slice/f ch/f ) + n [ + n string [ "\s\r\n" member? not ] find-from :> ( n' ch ) + n' string + n n' string ? + ch + ] [ + n string f f + ] if ; inline + +: skip-whitespace ( n/f string -- n'/f string ) + slice-til-not-whitespace 2drop ; + +: empty-slice-end ( seq -- slice ) + [ length dup ] [ ] bi ; inline + +: empty-slice-from ( n seq -- slice ) + dupd ; inline + +:: slice-til-eol ( n string -- n' string slice/f ch/f ) + n [ + n string '[ "\r\n" member? ] find-from :> ( n' ch ) + n' string + n n' string ? + ch + ] [ + n string string empty-slice-end f + ] if ; inline + +:: merge-slice-til-eol-slash'' ( n string -- n' string slice/f ch/f ) + n [ + n string '[ "\r\n\\" member? ] find-from :> ( n' ch ) + n' string + n n' string ? + ch + ] [ + n string string empty-slice-end f + ] if ; inline + +: merge-slice-til-whitespace ( n string slice -- n' string slice' ) + pick [ + [ slice-til-whitespace drop ] dip merge-slices + ] when ; + +: merge-slice-til-eol ( n string slice -- n' string slice' ) + [ slice-til-eol drop ] dip merge-slices ; + +: slice-between ( slice1 slice2 -- slice ) + ! ensure-same-underlying + slice-order-by-from + [ to>> ] + [ [ from>> 2dup < [ swap ] unless ] [ seq>> ] bi ] bi* ; + +: slice-before ( slice -- slice' ) + [ drop 0 ] [ from>> ] [ seq>> ] tri ; + +: (?nth) ( n/f string/f -- obj/f ) + over [ (?nth) ] [ 2drop f ] if ; + +:: merge-slice-til-eol-slash' ( n string slice -- n' string slice/f ch/f ) + n string merge-slice-til-eol-slash'' :> ( n' string' slice' ch' ) + ch' CHAR: \\ = [ + n' 1 + string' (?nth) "\r\n" member? [ + n' 2 + string' slice slice' span-slices merge-slice-til-eol-slash' + ] [ + "omg" throw + ] if + ] [ + n' string' slice slice' span-slices ch' + ] if ; + +! Supports \ at eol (with no space after it) +: slice-til-eol-slash ( n string -- n' string slice/f ch/f ) + 2dup empty-slice-from merge-slice-til-eol-slash' ; + +:: slice-til-separator-inclusive ( n string tokens -- n' string slice/f ch/f ) + n string '[ tokens member? ] find-from [ dup [ 1 + ] when ] dip :> ( n' ch ) + n' string + n n' string ? + ch ; inline + +: slice-til-separator-exclusive ( n string tokens -- n' string slice/f ch/f ) + slice-til-separator-inclusive dup [ + [ [ 1 - ] change-to ] dip + ] when ; + +! Takes at least one character if not whitespace +:: slice-til-either ( n string tokens -- n'/f string slice/f ch/f ) + n [ + n string '[ tokens member? ] find-from + dup "\s\r\n" member? [ + :> ( n' ch ) + n' string + n n' string ? + ch + ] [ + [ dup [ 1 + ] when ] dip :> ( n' ch ) + n' string + n n' string ? + ch + ] if + ] [ + f string f f + ] if ; inline + +ERROR: subseq-expected-but-got-eof n string expected ; + +:: slice-til-string ( n string search -- n' string payload end-string ) + search string n subseq-start-from :> n' + n' [ n string search subseq-expected-but-got-eof ] unless + n' search length + string + n n' string ? + n' dup search length + string ? ; + +: modify-from ( slice n -- slice' ) + '[ from>> _ + ] [ to>> ] [ seq>> ] tri ; + +: modify-to ( slice n -- slice' ) + [ [ from>> ] [ to>> ] [ seq>> ] tri ] dip + swap [ + ] dip ; + +! { CHAR: \] [ read-closing ] } +! { CHAR: \} [ read-closing ] } +! { CHAR: \) [ read-closing ] } +: read-closing ( n string tok -- n string tok ) + dup length 1 = [ + -1 modify-to [ 1 - ] 2dip + ] unless ; + +: rewind-slice ( n string slice -- n' string ) + pick [ + length swap [ - ] dip + ] [ + [ nip ] dip [ [ length ] bi@ - ] 2keep drop + ] if ; inline From afd60c1d3b836223573a10c52231eaa6bb4aeed4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 18:47:50 -0500 Subject: [PATCH 11/84] .gitignore: Don't ignore all directories that have factor in them, e.g. extra/zealot/factor/ --- .gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitignore b/.gitignore index 362414e7e4..68df555f07 100644 --- a/.gitignore +++ b/.gitignore @@ -14,7 +14,6 @@ Factor/factor *.image factor.image.fresh *.dylib -factor factor.com *#*# .DS_Store From e01d1133be8fd06ad586ef703e08cbe5bfc8580a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 19:05:37 -0500 Subject: [PATCH 12/84] modern: core-vocabs should not return the broken test vocabs. --- extra/modern/modern.factor | 2 +- extra/modern/paths/paths.factor | 11 +++++------ 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor index 63f2645eda..e949a387e1 100644 --- a/extra/modern/modern.factor +++ b/extra/modern/modern.factor @@ -487,7 +487,7 @@ ERROR: compound-syntax-disallowed n seq obj ; : failed-lexing ( assoc -- assoc' ) [ nip array? ] assoc-reject ; -: lex-core ( -- assoc ) core-bootstrap-vocabs lex-vocabs ; +: lex-core ( -- assoc ) core-vocabs lex-vocabs ; : lex-basis ( -- assoc ) basis-vocabs lex-vocabs ; : lex-extra ( -- assoc ) extra-vocabs lex-vocabs ; : lex-roots ( -- assoc ) lex-core lex-basis lex-extra 3append ; diff --git a/extra/modern/paths/paths.factor b/extra/modern/paths/paths.factor index d8f896e471..a6e46ebde0 100644 --- a/extra/modern/paths/paths.factor +++ b/extra/modern/paths/paths.factor @@ -11,9 +11,8 @@ ERROR: not-a-source-path path ; "" disk-vocabs-in-root/prefix no-prefixes [ name>> ] map ; -: core-vocabs ( -- seq ) "resource:core" vocabs-from ; -: less-core-test-vocabs ( seq -- seq' ) - { +CONSTANT: core-broken-vocabs + { "vocabs.loader.test.a" "vocabs.loader.test.b" "vocabs.loader.test.c" @@ -30,10 +29,10 @@ ERROR: not-a-source-path path ; "vocabs.loader.test.n" "vocabs.loader.test.o" "vocabs.loader.test.p" - } diff ; + } -: core-bootstrap-vocabs ( -- seq ) - core-vocabs less-core-test-vocabs ; +: core-vocabs ( -- seq ) + "resource:core" vocabs-from core-broken-vocabs diff ; : basis-vocabs ( -- seq ) "resource:basis" vocabs-from ; : extra-vocabs ( -- seq ) "resource:extra" vocabs-from ; From 6df7360ec98b7269f6ac9d1ce1f41babcf048851 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 20:19:02 -0500 Subject: [PATCH 13/84] vocabs.loader: make a word for the default vocabs. --- core/vocabs/loader/loader.factor | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index f77c32d57e..b1d6e31359 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -9,13 +9,15 @@ SYMBOL: vocab-roots SYMBOL: add-vocab-root-hook +CONSTANT: default-vocab-roots { + "resource:core" + "resource:basis" + "resource:extra" + "resource:work" +} + [ - V{ - "resource:core" - "resource:basis" - "resource:extra" - "resource:work" - } clone vocab-roots set-global + default-vocab-roots V{ } like vocab-roots set-global [ drop ] add-vocab-root-hook set-global ] "vocabs.loader" add-startup-hook From 76e50c3479cf2bb638b73ba50c0995bb61ca6bf4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 20:19:31 -0500 Subject: [PATCH 14/84] cli.git: Add more git commands. --- extra/cli/git/git.factor | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor index 1b589a008f..2ea02a53cf 100644 --- a/extra/cli/git/git.factor +++ b/extra/cli/git/git.factor @@ -9,6 +9,12 @@ 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>lines ( quot -- string ) + utf8 stream-lines ; + : git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-process ; : git-clone ( uri -- process ) [ { "git" "clone" } ] dip suffix run-process ; : git-pull* ( -- process ) { "git" "pull" } run-process ; @@ -27,6 +33,12 @@ cli-git-num-parallel [ cpus 2 * ] initialize : git-remote-add ( path remote uri -- process ) '[ _ _ git-remote-add* ] with-directory ; : git-remote-get-url* ( remote -- process ) [ { "git" "remote" "get-url" } ] dip suffix run-process ; : git-remote-get-url ( path remote -- process ) '[ _ git-remote-get-url* ] with-directory ; +: git-rev-parse* ( branch -- string ) [ { "git" "rev-parse" } ] dip suffix git-command>string ; +: git-rev-parse ( path branch -- string ) '[ _ git-rev-parse* ] with-directory ; +: git-diff-name-only* ( from to -- lines ) + [ { "git" "diff" "--name-only" } ] 2dip 2array append git-command>lines ; +: git-diff-name-only ( path from to -- lines ) + [ git-diff-name-only* ] with-directory ; : git-repository? ( directory -- ? ) ".git" append-path current-directory get prepend-path @@ -34,9 +46,7 @@ cli-git-num-parallel [ cpus 2 * ] initialize : git-current-branch* ( -- name ) ! { "git" "rev-parse" "--abbrev-ref" "HEAD" } - { "git" "name-rev" "--name-only" "HEAD" } - utf8 stream-contents - [ blank? ] trim-tail ; + { "git" "name-rev" "--name-only" "HEAD" } git-command>string ; : git-current-branch ( directory -- name ) [ git-current-branch* ] with-directory ; From d35df269d87e189bd4aeb92c803c04f6f7745897 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 20:19:54 -0500 Subject: [PATCH 15/84] modern.out: fix load error.. --- extra/modern/out/out.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/extra/modern/out/out.factor b/extra/modern/out/out.factor index 86a8cf81d9..c4e3f085b1 100644 --- a/extra/modern/out/out.factor +++ b/extra/modern/out/out.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2017 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators.short-circuit -constructors continuations io io.encodings.utf8 io.files +constructors continuations fry io io.encodings.utf8 io.files io.streams.string kernel modern modern.paths modern.slices -prettyprint sequences sequences.extras splitting strings -vocabs.loader ; +multiline prettyprint sequences sequences.extras splitting +strings vocabs.loader ; IN: modern.out : token? ( obj -- ? ) @@ -14,14 +14,14 @@ TUPLE: renamed slice string ; CONSTRUCTOR: renamed ( slice string -- obj ) ; : trim-before-newline ( seq -- seq' ) - dup [ char: \s = not ] find - { char: \r char: \n } member? + dup [ CHAR: \s = not ] find + { CHAR: \r CHAR: \n } member? [ tail-slice ] [ drop ] if ; : write-whitespace ( last obj -- ) swap [ swap slice-between ] [ slice-before ] if* - trim-before-newline io::write ; + trim-before-newline io:write ; GENERIC: write-literal* ( last obj -- last' ) M: slice write-literal* [ write-whitespace ] [ write ] [ ] tri ; @@ -84,7 +84,7 @@ DEFER: map-literals ]] : strings-core-to-file ( -- ) - core-bootstrap-vocabs + core-vocabs [ ".private" ?tail drop vocab-source-path utf8 file-contents ] map-zip [ "[========[" dup matching-delimiter-string surround ] assoc-map [ @@ -95,7 +95,7 @@ DEFER: map-literals "\n;VOCAB-ROOT>" surround "resource:core-strings.factor" utf8 set-file-contents ; : parsed-core-to-file ( -- ) - core-bootstrap-vocabs + core-vocabs [ vocab>literals ] map-zip [ first2 [ " Date: Wed, 4 Jul 2018 20:20:20 -0500 Subject: [PATCH 16/84] zealot: Get a list of changed vocabs from the last run until now. Also add a word to get a list of vocabs that changed between any two git revs. --- extra/zealot/cli-changed-vocabs/authors.txt | 1 + .../cli-changed-vocabs.factor | 8 +++++ extra/zealot/factor/factor.factor | 32 +++++++++++++++++-- 3 files changed, 38 insertions(+), 3 deletions(-) create mode 100644 extra/zealot/cli-changed-vocabs/authors.txt create mode 100644 extra/zealot/cli-changed-vocabs/cli-changed-vocabs.factor diff --git a/extra/zealot/cli-changed-vocabs/authors.txt b/extra/zealot/cli-changed-vocabs/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/zealot/cli-changed-vocabs/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/zealot/cli-changed-vocabs/cli-changed-vocabs.factor b/extra/zealot/cli-changed-vocabs/cli-changed-vocabs.factor new file mode 100644 index 0000000000..c14bbedc78 --- /dev/null +++ b/extra/zealot/cli-changed-vocabs/cli-changed-vocabs.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2018 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: io sequences zealot.factor ; +IN: zealot.cli-changed-vocabs + +: zealot-changed-vocabs ( -- ) ci-vocabs-to-test [ print ] each ; + +MAIN: zealot-changed-vocabs \ No newline at end of file diff --git a/extra/zealot/factor/factor.factor b/extra/zealot/factor/factor.factor index 0fdaffcfb7..a4fc2a7e15 100644 --- a/extra/zealot/factor/factor.factor +++ b/extra/zealot/factor/factor.factor @@ -4,9 +4,9 @@ USING: accessors arrays bootstrap.image calendar cli.git combinators concurrency.combinators formatting fry http.client io io.directories io.launcher io.pathnames kernel math.parser memory modern.paths namespaces parser.notes prettyprint -sequences sequences.extras system system-info threads tools.test -tools.test.private vocabs vocabs.hierarchy -vocabs.hierarchy.private vocabs.loader zealot ; +sequences sequences.extras sets splitting system system-info +threads tools.test tools.test.private vocabs vocabs.hierarchy +vocabs.hierarchy.private vocabs.loader vocabs.metadata zealot ; IN: zealot.factor : download-boot-checksums ( path branch -- ) @@ -168,3 +168,29 @@ M: windows factor-path "./factor.com" ; [ "ZEALOT LOADING ROOTS" print flush drop zealot-load-commands ] [ "ZEALOT TESTING ROOTS" print flush drop zealot-test-commands ] } 2cleave ; + +: vocab-path>vocab ( path -- vocab ) + [ parent-directory ] map + [ "/" split1 nip ] map + [ path-separator split harvest "." join ] map ; + +: changed-factor-vocabs ( old-rev new-rev -- vocabs ) + [ + default-vocab-roots + [ ":" split1 nip ] map + [ "/" append ] map + ] 2dip git-diff-name-only* + [ ".factor" tail? ] filter + [ swap [ head? ] with any? ] with filter + [ parent-directory ] map + [ "/" split1 nip ] map + [ path-separator split harvest "." join ] map members ; + +: changed-factor-vocabs-from-master ( -- vocabs ) + "master" "origin/master" changed-factor-vocabs ; + +: reject-unloadable-vocabs ( vocabs -- vocabs' ) + [ don't-load? ] reject ; + +: ci-vocabs-to-test ( -- vocabs ) + changed-factor-vocabs-from-master reject-unloadable-vocabs ; \ No newline at end of file From 957dea14b463a232b1dc39ec55e4d4c812b5ea0a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 20:21:13 -0500 Subject: [PATCH 17/84] .travis.yml: Experimental command to test changed vocabs. Takes into account if the vocabs can run on the test machine's platform or not. --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 393fe6bea6..1653d104e8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -42,3 +42,4 @@ before_install: ( [[ "$TRAVIS_OS_NAME" != "osx" ]] && sudo ldconfig || true ) script: - DEBUG=1 ./build.sh net-bootstrap < /dev/null + - ./factor -run=zealot.cli-changed-vocabs | while read line ; do ./factor -e="USING: kernel tools.test vocabs.hierarchy ; \"$line\" [ load ] [ test ] bi" ; done From 682e0b92e365f56198229e19ef7234fce1bc3337 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 20:31:44 -0500 Subject: [PATCH 18/84] cli.git: Better branch names maybe. zealot: use CI_BRANCH and set it in travis. zealot.factor: Check against HEAD .travis.yml: Travis seems to be terminating my command after the USING:. [[ [0K$ ./factor -run=zealot.cli-changed-vocabs io.pathnames vocabs.loader cli.git modern modern.out modern.paths modern.slices sequences.extras web-services.github zealot.cli-changed-vocabs zealot.factor zealot travis_time:end:155cd3d8:start=1530762416088842089,finish=1530762475370504525,duration=59281662436 [0K [32;1mThe command "./factor -run=zealot.cli-changed-vocabs" exited with 0.[0m travis_time:start:2ac2d2d0 [0K$ {:"./factor -run=zealot.cli-changed-vocabs | while read line ; do ./factor -e=\"USING"=>"kernel tools.test vocabs.hierarchy ; \\\"$line\\\" [ load ] [ test ] bi\" ; done"} /home/travis/.travis/job_stages: line 78: {:./factor -run=zealot.cli-changed-vocabs | while read line ; do ./factor -e="USING=: No such file or directory travis_time:end:2ac2d2d0:start=1530762475377510994,finish=1530762475383948090,duration=6437096 [0K [31;1mThe command "{:"./factor -run=zealot.cli-changed-vocabs | while read line ; do ./factor -e=\"USING"=>"kernel tools.test vocabs.hierarchy ; \\"$line\\" [ load ] [ test ] bi\" ; done"}" exited with 127.[0m Done. Your build exited with 1. ]] zealot: test on cli. travis: Load zealot so we can use it quickly twice. Also fetch origin/master so we can ``git diff`` against it. --- .travis.yml | 9 ++++++++- build.sh | 6 +++--- extra/cli/git/git.factor | 3 +-- extra/zealot/cli-test-changed-vocabs/authors.txt | 1 + .../cli-test-changed-vocabs.factor | 13 +++++++++++++ extra/zealot/factor/factor.factor | 15 ++++++++------- 6 files changed, 34 insertions(+), 13 deletions(-) create mode 100644 extra/zealot/cli-test-changed-vocabs/authors.txt create mode 100644 extra/zealot/cli-test-changed-vocabs/cli-test-changed-vocabs.factor diff --git a/.travis.yml b/.travis.yml index 1653d104e8..a3ee330bfd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -40,6 +40,13 @@ before_install: wget https://github.com/vmt/udis86/archive/v1.7.2.tar.gz && tar xzvf v1.7.2.tar.gz && ( cd udis86-1.7.2/ && ./autogen.sh && ./configure --enable-shared=yes && make && sudo make install ) && ( [[ "$TRAVIS_OS_NAME" != "osx" ]] && sudo ldconfig || true ) + - git remote set-branches --add origin master + - git fetch # so we can see which vocabs changed versus origin/master... script: + - echo "TRAVIS_BRANCH=$TRAVIS_BRANCH, TRAVIS_PULL_REQUEST_BRANCH=$TRAVIS_PULL_REQUEST_BRANCH" + - export CI_BRANCH="${TRAVIS_PULL_REQUEST_BRANCH:-$TRAVIS_BRANCH}" + - echo "CI_BRANCH=${CI_BRANCH}" - DEBUG=1 ./build.sh net-bootstrap < /dev/null - - ./factor -run=zealot.cli-changed-vocabs | while read line ; do ./factor -e="USING: kernel tools.test vocabs.hierarchy ; \"$line\" [ load ] [ test ] bi" ; done + - "./factor -e='USING: memory vocabs.hierarchy ; \"zealot\" load save'" + - ./factor -run=zealot.cli-changed-vocabs + - ./factor -run=zealot.cli-test-changed-vocabs diff --git a/build.sh b/build.sh index 7b1c5632da..97a4a719ea 100755 --- a/build.sh +++ b/build.sh @@ -590,10 +590,10 @@ set_boot_image_vars() { } set_current_branch() { - if [ -z ${TRAVIS_BRANCH} ]; then - CURRENT_BRANCH=$(current_git_branch) + if [ -n "${CI_BRANCH}" ]; then + CURRENT_BRANCH="${CI_BRANCH}" else - CURRENT_BRANCH=${TRAVIS_BRANCH} + CURRENT_BRANCH=$(current_git_branch) fi } diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor index 2ea02a53cf..bfee6419ff 100644 --- a/extra/cli/git/git.factor +++ b/extra/cli/git/git.factor @@ -45,8 +45,7 @@ cli-git-num-parallel [ cpus 2 * ] initialize ?file-info dup [ directory? ] when ; : git-current-branch* ( -- name ) - ! { "git" "rev-parse" "--abbrev-ref" "HEAD" } - { "git" "name-rev" "--name-only" "HEAD" } git-command>string ; + { "git" "rev-parse" "--abbrev-ref" "HEAD" } git-command>string ; : git-current-branch ( directory -- name ) [ git-current-branch* ] with-directory ; diff --git a/extra/zealot/cli-test-changed-vocabs/authors.txt b/extra/zealot/cli-test-changed-vocabs/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/zealot/cli-test-changed-vocabs/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/zealot/cli-test-changed-vocabs/cli-test-changed-vocabs.factor b/extra/zealot/cli-test-changed-vocabs/cli-test-changed-vocabs.factor new file mode 100644 index 0000000000..200313c55e --- /dev/null +++ b/extra/zealot/cli-test-changed-vocabs/cli-test-changed-vocabs.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2018 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel sequences tools.test vocabs zealot.factor ; +IN: zealot.cli-test-changed-vocabs + +: zealot-test-changed-vocabs ( -- ) + ci-vocabs-to-test [ + [ require ] each + ] [ + [ test ] each + ] bi ; + +MAIN: zealot-test-changed-vocabs \ No newline at end of file diff --git a/extra/zealot/factor/factor.factor b/extra/zealot/factor/factor.factor index a4fc2a7e15..4382e94237 100644 --- a/extra/zealot/factor/factor.factor +++ b/extra/zealot/factor/factor.factor @@ -1,11 +1,12 @@ ! Copyright (C) 2017 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays bootstrap.image calendar cli.git -combinators concurrency.combinators formatting fry http.client -io io.directories io.launcher io.pathnames kernel math.parser -memory modern.paths namespaces parser.notes prettyprint -sequences sequences.extras sets splitting system system-info -threads tools.test tools.test.private vocabs vocabs.hierarchy +USING: accessors arrays bootstrap.image bootstrap.image.upload +calendar cli.git combinators concurrency.combinators environment +formatting fry http.client io io.directories io.launcher +io.pathnames kernel math.parser memory modern.paths namespaces +parser.notes prettyprint sequences sequences.extras sets +splitting system system-info threads tools.test +tools.test.private vocabs vocabs.hierarchy vocabs.hierarchy.private vocabs.loader vocabs.metadata zealot ; IN: zealot.factor @@ -187,7 +188,7 @@ M: windows factor-path "./factor.com" ; [ path-separator split harvest "." join ] map members ; : changed-factor-vocabs-from-master ( -- vocabs ) - "master" "origin/master" changed-factor-vocabs ; + "HEAD" "origin/master" changed-factor-vocabs ; : reject-unloadable-vocabs ( vocabs -- vocabs' ) [ don't-load? ] reject ; From 4d3430c8cc5cfa7b28b0ad2f7a5e72c9c457c814 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 5 Jul 2018 00:34:16 -0500 Subject: [PATCH 19/84] .travis.yml: Test all of core/ on each PR since it doesn't take that long. Related to #1760. --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index a3ee330bfd..fdac26d71d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -50,3 +50,4 @@ script: - "./factor -e='USING: memory vocabs.hierarchy ; \"zealot\" load save'" - ./factor -run=zealot.cli-changed-vocabs - ./factor -run=zealot.cli-test-changed-vocabs + - "./factor -e='USING: modern.paths tools.test sequences ; core-vocabs [ test ] each'" From 739742d0ae20039490e0e32d3d718724ac6dce93 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 5 Jul 2018 01:18:37 -0500 Subject: [PATCH 20/84] travis.yml: Testing all of core is too much code? It hung for 10m without any output. Maybe we could load-all then test core? Also, maybe doing ``"math" test`` takes too long because we test all the subvocabs, so we should just test single vocabs at a time, non-recursively. --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index fdac26d71d..bb41068b7c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -50,4 +50,4 @@ script: - "./factor -e='USING: memory vocabs.hierarchy ; \"zealot\" load save'" - ./factor -run=zealot.cli-changed-vocabs - ./factor -run=zealot.cli-test-changed-vocabs - - "./factor -e='USING: modern.paths tools.test sequences ; core-vocabs [ test ] each'" +# - "./factor -e='USING: modern.paths tools.test sequences ; core-vocabs [ test ] each'" From 6e89e4ecabe86b78a7ad479fcdb742a5cb676aca Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 6 Jul 2018 08:07:11 -0700 Subject: [PATCH 21/84] sequences.extras: fix bug in count-head, add some tests. --- extra/sequences/extras/extras-tests.factor | 8 ++++++++ extra/sequences/extras/extras.factor | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index cbf4b42457..aec14a8dc6 100644 --- a/extra/sequences/extras/extras-tests.factor +++ b/extra/sequences/extras/extras-tests.factor @@ -273,3 +273,11 @@ tools.test vectors vocabs ; { "a_b" } [ "ab" CHAR: _ interleaved ] unit-test { "a_b_c" } [ "abc" CHAR: _ interleaved ] unit-test { "a_b_c_d" } [ "abcd" CHAR: _ interleaved ] unit-test + +{ 0 } [ { 1 2 3 4 } [ 5 > ] count-head ] unit-test +{ 2 } [ { 1 2 3 4 } [ 3 < ] count-head ] unit-test +{ 4 } [ { 1 2 3 4 } [ 5 < ] count-head ] unit-test + +{ 0 } [ { 1 2 3 4 } [ 5 > ] count-tail ] unit-test +{ 2 } [ { 1 2 3 4 } [ 2 > ] count-tail ] unit-test +{ 4 } [ { 1 2 3 4 } [ 5 < ] count-tail ] unit-test diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 85bf132719..72ee2f6aa9 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -629,7 +629,7 @@ PRIVATE> [ dup length ] unless* tail-slice ; inline : count-head ( seq quot -- n ) - [ not ] compose find drop ; inline + [ not ] compose [ find drop ] 2keep drop length or ; inline : count-tail ( seq quot -- n ) [ not ] compose [ find-last drop ] 2keep drop From 0f2466e6fb17f6e9a5c8d625bfb28c65a8c7c51a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 6 Jul 2018 21:20:23 -0500 Subject: [PATCH 22/84] windows.user32: Fix signature of LoadCursorW. Also change a couple more that weren't exactly right. Fixes #2011. --- basis/windows/user32/user32.factor | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor index f6ab76dfe4..fe1844802c 100644 --- a/basis/windows/user32/user32.factor +++ b/basis/windows/user32/user32.factor @@ -1813,16 +1813,14 @@ FUNCTION: HACCEL LoadAcceleratorsW ( HINSTANCE hInstance, LPCTSTR lpTableName ) ! FUNCTION: LoadCursorFromFileW -! FUNCTION: HCURSOR LoadCursorW ( HINSTANCE hInstance, LPCWSTR lpCursorName ) -FUNCTION: HCURSOR LoadCursorW ( HINSTANCE hInstance, ushort lpCursorName ) +FUNCTION: HCURSOR LoadCursorW ( HINSTANCE hInstance, LPCWSTR lpCursorName ) ALIAS: LoadCursor LoadCursorW -! FUNCTION: HICON LoadIconA ( HINSTANCE hInstance, LPCTSTR lpIconName ) -FUNCTION: HICON LoadIconW ( HINSTANCE hInstance, LPCTSTR lpIconName ) +FUNCTION: HICON LoadIconW ( HINSTANCE hInstance, LPCWSTR lpIconName ) ALIAS: LoadIcon LoadIconW ! FUNCTION: LoadImageA -FUNCTION: HANDLE LoadImageW ( HINSTANCE hinst, LPCTSTR lpszName, UINT uType, int cxDesired, int cyDesired, UINT fuLoad ) +FUNCTION: HANDLE LoadImageW ( HINSTANCE hinst, LPCWSTR lpszName, UINT uType, int cxDesired, int cyDesired, UINT fuLoad ) ALIAS: LoadImage LoadImageW ! FUNCTION: LoadKeyboardLayoutA ! FUNCTION: LoadKeyboardLayoutEx From 9d911fab73340f46f214387121879b3819995f5c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 6 Jul 2018 18:49:19 -0500 Subject: [PATCH 23/84] cli.git: Fix parameter order. --- extra/cli/git/git.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor index bfee6419ff..03c8cbeabb 100644 --- a/extra/cli/git/git.factor +++ b/extra/cli/git/git.factor @@ -38,7 +38,7 @@ cli-git-num-parallel [ cpus 2 * ] initialize : git-diff-name-only* ( from to -- lines ) [ { "git" "diff" "--name-only" } ] 2dip 2array append git-command>lines ; : git-diff-name-only ( path from to -- lines ) - [ git-diff-name-only* ] with-directory ; + '[ _ _ git-diff-name-only* ] with-directory ; : git-repository? ( directory -- ? ) ".git" append-path current-directory get prepend-path From d92ebf4f8230074a9940bb8f9de82607a52d1b90 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 6 Jul 2018 21:22:37 -0500 Subject: [PATCH 24/84] .travis: Use tools.test as a command line app. --- .travis.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index bb41068b7c..70fa7ffbcf 100644 --- a/.travis.yml +++ b/.travis.yml @@ -48,6 +48,6 @@ script: - echo "CI_BRANCH=${CI_BRANCH}" - DEBUG=1 ./build.sh net-bootstrap < /dev/null - "./factor -e='USING: memory vocabs.hierarchy ; \"zealot\" load save'" - - ./factor -run=zealot.cli-changed-vocabs - - ./factor -run=zealot.cli-test-changed-vocabs + - './factor -run=tools.test `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`' +# - ./factor -run=zealot.cli-changed-vocabs # - "./factor -e='USING: modern.paths tools.test sequences ; core-vocabs [ test ] each'" From a3abec6f5c3d364a5f49d8459ba52b93de64765a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 6 Jul 2018 21:25:29 -0500 Subject: [PATCH 25/84] ui.backend.windows: And fix the UI for LoadCursor. Related to #2011 --- basis/ui/backend/windows/windows.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 2b7751d932..7431ddb4c9 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -578,7 +578,7 @@ M: windows-ui-backend do-events 0 >>cbWndExtra f GetModuleHandle >>hInstance f GetModuleHandle "APPICON" native-string>alien LoadIcon >>hIcon - f IDC_ARROW LoadCursor >>hCursor + f IDC_ARROW MAKEINTRESOURCE LoadCursor >>hCursor class-name-ptr >>lpszClassName RegisterClassEx win32-error=0/f From e21125ac2cf17309481e2b9f8ce2e08743b25dc9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 6 Jul 2018 23:53:40 -0500 Subject: [PATCH 26/84] tools.test: Print out test failures at the end of test main. --- basis/tools/test/test.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor index b33afe19c8..06e5be435b 100644 --- a/basis/tools/test/test.factor +++ b/basis/tools/test/test.factor @@ -212,6 +212,8 @@ M: test-failure error. ( error -- ) : test-main ( -- ) command-line get [ [ load ] [ test ] bi ] each - test-failures get empty? [ 0 ] [ 1 ] if exit ; + test-failures get empty? + [ [ "==== FAILING TESTS" print :test-failures ] unless ] + [ 0 1 ? exit ] bi ; MAIN: test-main From 06b07b9e9c66734579e9a05854d852a7a5137c96 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 00:06:52 -0500 Subject: [PATCH 27/84] help.lint.checks: Fix regression in help-lint introduced in 8c158aa68ff5a478349392f89fee6c50e0bd16af. We haven't been checking words in help-lint for two years! Ack! --- basis/help/lint/checks/checks.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index 8e3d73487d..47a4c6a43f 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -99,7 +99,7 @@ SYMBOL: vocab-articles [ parsing-word? ] [ "declared-effect" word-prop not ] [ constant? ] - [ "word-help" word-prop not ] + [ "help" word-prop not ] } 1|| ; : skip-check-values? ( word element -- ? ) From 411a55314c7fe2d64cd71a47ed52bb71d5c04e32 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 00:16:52 -0500 Subject: [PATCH 28/84] help.lint: Add a MAIN: to help-lint to test lint from command line like we already have for unit tests. Also flush stdout for both MAIN: test apps. --- basis/help/lint/lint.factor | 17 +++++++++++++---- basis/tools/test/test.factor | 2 +- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor index 95a2f7e0d0..c126b956be 100644 --- a/basis/help/lint/lint.factor +++ b/basis/help/lint/lint.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs combinators continuations fry help -help.lint.checks help.topics io kernel namespaces parser -sequences source-files.errors vocabs.hierarchy vocabs words -classes locals tools.errors listener ; +USING: assocs classes combinators command-line continuations fry +help help.lint.checks help.topics io kernel listener locals +namespaces parser sequences source-files.errors system +tools.errors vocabs vocabs.hierarchy ; IN: help.lint SYMBOL: lint-failures @@ -97,3 +97,12 @@ PRIVATE> [ word-help ] reject [ article-parent ] filter [ predicate? ] reject ; + +: test-lint-main ( -- ) + command-line get [ load ] each + help-lint-all + lint-failures get assoc-empty? + [ [ "==== FAILING LINT" print :lint-failures flush ] unless ] + [ 0 1 ? exit ] bi ; + +MAIN: test-lint-main diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor index 06e5be435b..dcbb99b219 100644 --- a/basis/tools/test/test.factor +++ b/basis/tools/test/test.factor @@ -213,7 +213,7 @@ M: test-failure error. ( error -- ) : test-main ( -- ) command-line get [ [ load ] [ test ] bi ] each test-failures get empty? - [ [ "==== FAILING TESTS" print :test-failures ] unless ] + [ [ "==== FAILING TESTS" print flush :test-failures ] unless ] [ 0 1 ? exit ] bi ; MAIN: test-main From ff466b894a912e19521f14adce53715cebb33b0c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 00:18:23 -0500 Subject: [PATCH 29/84] zealot.factor: Test against the clean branch if we are pushing to master. --- extra/zealot/factor/factor.factor | 33 +++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/extra/zealot/factor/factor.factor b/extra/zealot/factor/factor.factor index 4382e94237..5d5327c022 100644 --- a/extra/zealot/factor/factor.factor +++ b/extra/zealot/factor/factor.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2017 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays bootstrap.image bootstrap.image.upload -calendar cli.git combinators concurrency.combinators environment -formatting fry http.client io io.directories io.launcher -io.pathnames kernel math.parser memory modern.paths namespaces -parser.notes prettyprint sequences sequences.extras sets -splitting system system-info threads tools.test -tools.test.private vocabs vocabs.hierarchy +USING: accessors arrays assocs bootstrap.image +bootstrap.image.upload calendar cli.git combinators +concurrency.combinators environment formatting fry http.client +io io.directories io.launcher io.pathnames kernel math.parser +memory modern.paths namespaces parser.notes prettyprint +sequences sequences.extras sets splitting system system-info +threads tools.test tools.test.private vocabs vocabs.hierarchy vocabs.hierarchy.private vocabs.loader vocabs.metadata zealot ; IN: zealot.factor @@ -170,6 +170,10 @@ M: windows factor-path "./factor.com" ; [ "ZEALOT TESTING ROOTS" print flush drop zealot-test-commands ] } 2cleave ; +: factor-clean-branch ( -- str ) + os cpu [ name>> ] bi@ { { CHAR: . CHAR: - } } substitute + "-" glue "origin/clean-" prepend ; + : vocab-path>vocab ( path -- vocab ) [ parent-directory ] map [ "/" split1 nip ] map @@ -190,8 +194,21 @@ M: windows factor-path "./factor.com" ; : changed-factor-vocabs-from-master ( -- vocabs ) "HEAD" "origin/master" changed-factor-vocabs ; +: changed-factor-vocabs-from-clean ( -- vocabs ) + "HEAD" factor-clean-branch changed-factor-vocabs ; + +: testing-a-branch? ( -- ? ) + "CI_BRANCH" os-env "master" or + "master" = not ; + : reject-unloadable-vocabs ( vocabs -- vocabs' ) [ don't-load? ] reject ; +! Test changes from a CI_BRANCH against origin/master +! Test master against last clean build, e.g. origin/clean-linux-x86-64 : ci-vocabs-to-test ( -- vocabs ) - changed-factor-vocabs-from-master reject-unloadable-vocabs ; \ No newline at end of file + testing-a-branch? [ + changed-factor-vocabs-from-master + ] [ + changed-factor-vocabs-from-clean + ] if reject-unloadable-vocabs ; \ No newline at end of file From 4e9d383fe5dedb0994e40f2e62e0fb3eb3944ba8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 00:44:46 -0500 Subject: [PATCH 30/84] docs: Fix help-lint-all mistakes. --- basis/alien/libraries/libraries-docs.factor | 6 ++--- .../image/primitives/primitives-docs.factor | 2 +- .../compiler/cfg/builder/builder-docs.factor | 12 +++++----- .../assignment/assignment-docs.factor | 2 +- .../linear-scan/assignment/assignment.factor | 2 +- .../cfg/stacks/local/local-docs.factor | 9 ++++---- .../cpu/architecture/architecture-docs.factor | 9 +++++++- basis/cpu/architecture/architecture.factor | 2 +- basis/english/english-docs.factor | 4 ++-- basis/help/topics/topics.factor | 2 +- basis/io/directories/directories-docs.factor | 2 +- basis/lists/lazy/lazy-docs.factor | 4 ++-- basis/math/vectors/vectors-docs.factor | 2 +- basis/opengl/shaders/shaders-docs.factor | 1 + .../dependencies/dependencies-docs.factor | 2 +- basis/suffix-arrays/suffix-arrays-docs.factor | 2 +- basis/typed/typed-docs.factor | 4 ++-- basis/ui/backend/gtk/gtk-docs.factor | 6 ++--- basis/vocabs/metadata/metadata-docs.factor | 2 +- basis/wrap/words/words-docs.factor | 2 +- basis/wrap/wrap-docs.factor | 4 ++-- core/alien/alien-docs.factor | 2 +- core/classes/tuple/tuple-docs.factor | 2 +- core/kernel/kernel-docs.factor | 10 ++++---- core/math/math-docs.factor | 2 +- core/sequences/sequences-docs.factor | 8 +++---- extra/ctags/ctags-docs.factor | 2 +- extra/fuel/help/help-docs.factor | 2 +- extra/gpu/shaders/shaders-docs.factor | 1 + extra/odbc/odbc-docs.factor | 4 ++-- extra/successor/successor-docs.factor | 2 +- extra/trees/trees-docs.factor | 4 ++-- .../ui/gadgets/charts/lines/lines-docs.factor | 23 +++++++++++++++++++ 33 files changed, 88 insertions(+), 55 deletions(-) diff --git a/basis/alien/libraries/libraries-docs.factor b/basis/alien/libraries/libraries-docs.factor index 366cc91da6..582b607f32 100644 --- a/basis/alien/libraries/libraries-docs.factor +++ b/basis/alien/libraries/libraries-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.syntax assocs help.markup help.syntax strings words -; +USING: alien alien.syntax assocs help.markup help.syntax kernel +strings ; IN: alien.libraries HELP: add-library @@ -73,7 +73,7 @@ HELP: library } ; HELP: library-dll -{ $values { "name" string } { "dll" "a DLL handle" } } +{ $values { "obj" object } { "dll" "a DLL handle" } } { $description "Looks up a library by logical name and outputs a handle which may be passed to " { $link dlsym } " or " { $link dlclose } "." } ; HELP: remove-library diff --git a/basis/bootstrap/image/primitives/primitives-docs.factor b/basis/bootstrap/image/primitives/primitives-docs.factor index 78b9f08056..ce435ac5a7 100644 --- a/basis/bootstrap/image/primitives/primitives-docs.factor +++ b/basis/bootstrap/image/primitives/primitives-docs.factor @@ -19,7 +19,7 @@ HELP: primitive-quot { $description "Creates the defining quotation for the primitive. If 'vm-func' is a string, then it is prefixed with 'primitive_' and a quotation calling that C++ function is generated." } ; ARTICLE: "bootstrap.image.primitives" "Bootstrap primitives" -"This vocab contains utilities for declaring primitives to be added to the bootstrap image. It is used by " { $vocab-link "bootstrap.primitives" } +"This vocab contains utilities for declaring primitives to be added to the bootstrap image. It is used by the file " { $snippet "resource:core/bootstrap/primitives.factor" } $nl { $link all-primitives } " is an assoc where all primitives are declared. See that constant for a description of the format." ; diff --git a/basis/compiler/cfg/builder/builder-docs.factor b/basis/compiler/cfg/builder/builder-docs.factor index f57320b4b5..308c3e4ff0 100644 --- a/basis/compiler/cfg/builder/builder-docs.factor +++ b/basis/compiler/cfg/builder/builder-docs.factor @@ -1,7 +1,7 @@ -USING: assocs compiler.cfg compiler.cfg.builder.blocks -compiler.cfg.instructions compiler.cfg.stacks.local compiler.tree -help.markup help.syntax kernel literals math multiline quotations -sequences vectors words ; +USING: arrays assocs compiler.cfg compiler.cfg.builder.blocks +compiler.cfg.instructions compiler.cfg.stacks.local +compiler.tree help.markup help.syntax kernel literals math +multiline quotations sequences vectors words ; IN: compiler.cfg.builder << @@ -104,7 +104,7 @@ HELP: end-word { $description "Ends the word by adding a basic block containing a " { $link ##return } " instructions to the " { $link cfg } "." } ; HELP: height-changes -{ $values { "#shuffle" #shuffle } { "height-changes" sequence } } +{ $values { "#shuffle" #shuffle } { "height-changes" pair } } { $description "Returns a two-tuple which represents how much the " { $link #shuffle } " node increases or decreases the data and retainstacks." } { $examples { $example @@ -115,7 +115,7 @@ HELP: height-changes } ; HELP: out-vregs/stack -{ $values { "#shuffle" #shuffle } { "seq" sequence } } +{ $values { "#shuffle" #shuffle } { "pair" sequence } } { $description "Returns a sequence of what vregs are on which stack locations after the shuffle instruction." } ; HELP: trivial-branch? diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment-docs.factor b/basis/compiler/cfg/linear-scan/assignment/assignment-docs.factor index 6d9ad819bd..646c0d8674 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment-docs.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment-docs.factor @@ -72,7 +72,7 @@ HELP: vreg>reg { $see-also lookup-spill-slot pending-interval-assoc } ; HELP: vregs>regs -{ $values { "assoc" "an " { $link assoc } " (set) of virtual registers" } { "assoc" assoc } } +{ $values { "assoc" "an " { $link assoc } " (set) of virtual registers" } { "assoc'" assoc } } { $description "Creates a mapping of virtual registers to registers." } ; HELP: vreg>spill-slot diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index b5ffb4d0ee..37fb24b2d4 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -29,7 +29,7 @@ SYMBOL: pending-interval-assoc : remove-pending ( live-interval -- ) vreg>> pending-interval-assoc get delete-at ; -: vreg>spill-slot ( vreg -- slot ) +: vreg>spill-slot ( vreg -- spill-slot ) dup rep-of lookup-spill-slot ; : vreg>reg ( vreg -- reg/spill-slot ) diff --git a/basis/compiler/cfg/stacks/local/local-docs.factor b/basis/compiler/cfg/stacks/local/local-docs.factor index a3e7d8919b..0131a1098d 100644 --- a/basis/compiler/cfg/stacks/local/local-docs.factor +++ b/basis/compiler/cfg/stacks/local/local-docs.factor @@ -51,7 +51,7 @@ HELP: height-state { $see-also inc-stack reset-incs } ; HELP: height-state>insns -{ $values { "state" sequence } { "insns" sequence } } +{ $values { "height-state" height-state } { "insns" sequence } } { $description "Converts a " { $link height-state } " tuple to 0-2 stack height change instructions." } { $examples "In this example the datastacks height is increased by 4 and the retainstacks decreased by 2." @@ -67,7 +67,7 @@ HELP: inc-stack { $description "Increases or decreases the data or retain stack depending on if loc is a " { $link ds-loc } " or " { $link rs-loc } " instance. An " { $link ##inc } " instruction will later be inserted." } ; HELP: local-loc>global -{ $values { "loc" loc } { "bb" basic-block } { "loc'" loc } } +{ $values { "loc" loc } { "height-state" height-state } { "loc'" loc } } { $description "Translates a stack location relative to a block to an absolute one. The word does the opposite to " { $link global-loc>local } "." } ; HELP: loc>vreg @@ -76,10 +76,11 @@ HELP: loc>vreg HELP: local-kill-set { $values - { "ds-height" integer } + { "ds-begin" integer } { "ds-inc" integer } - { "rs-height" integer } + { "rs-begin" integer } { "rs-inc" integer } + { "set" hash-set } } { $description "The set of stack locations that was killed. Locations on a stack are deemed killed if that stacks height is decremented." } { $see-also compute-local-kill-set } ; diff --git a/basis/cpu/architecture/architecture-docs.factor b/basis/cpu/architecture/architecture-docs.factor index 4adaae350a..8d1788b57f 100644 --- a/basis/cpu/architecture/architecture-docs.factor +++ b/basis/cpu/architecture/architecture-docs.factor @@ -75,6 +75,7 @@ init-relocation [ RAX RBX 3 -14 RCX RDX %write-barrier ] B{ } make disassemble HELP: %alien-invoke { $values + { "varargs?" boolean } { "reg-inputs" sequence } { "stack-inputs" sequence } { "reg-outputs" sequence } @@ -292,12 +293,18 @@ HELP: %store-memory-imm HELP: %test-imm-branch { $values { "label" "branch destination" } + { "cc" "comparison symbol" } { "src1" "register" } { "src2" "immediate" } - { "cc" "comparison symbol" } } { $description "Emits a TEST instruction with a register and an immediate, followed by a branch." } ; HELP: %unbox +{ $values + { "dst" "destination register" } + { "src" "source register" } + { "func" "function?" } + { "rep" representation } +} { $description "Call a function to convert a tagged pointer into a value that can be passed to a C function, or returned from a callback." } ; HELP: %vector>scalar diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 55b13c48b5..83de9fbf6b 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -522,7 +522,7 @@ HOOK: fused-unboxing? cpu ( -- ? ) HOOK: immediate-arithmetic? cpu ( n -- ? ) HOOK: immediate-bitwise? cpu ( n -- ? ) HOOK: immediate-comparand? cpu ( n -- ? ) -HOOK: immediate-store? cpu ( obj -- ? ) +HOOK: immediate-store? cpu ( n -- ? ) M: object immediate-comparand? ( n -- ? ) { diff --git a/basis/english/english-docs.factor b/basis/english/english-docs.factor index 4cbe1a5e96..e025a04aa9 100644 --- a/basis/english/english-docs.factor +++ b/basis/english/english-docs.factor @@ -110,7 +110,7 @@ HELP: count-of-things } ; HELP: ?pluralize -{ $values { "count" number } { "singular" string } { "singluar/plural" string } } +{ $values { "count" number } { "singular" string } { "singular/plural" string } } { $description "A simpler variant of " { $link count-of-things } " which omits its input value from the output. As with " { $link count-of-things } ", " { $snippet "word" } " is expected to be in singular form." } { $notes { $list $keep-case $0-plurality } } { $examples @@ -189,7 +189,7 @@ HELP: comma-list } ; HELP: or-markup-example -{ $values { "markup" "a sequence of markup elements" } { "classes" "a sequence of words" } } +{ $values { "classes" "a sequence of words" } { "markup" "a sequence of markup elements" } } { $description "Used to implement " { $link $or-markup-example } " and demonstrate " { $link comma-list } "." } { $examples { "See the examples in " { $link $or-markup-example } "." } } ; diff --git a/basis/help/topics/topics.factor b/basis/help/topics/topics.factor index e52486d3ee..635b459d0d 100644 --- a/basis/help/topics/topics.factor +++ b/basis/help/topics/topics.factor @@ -42,7 +42,7 @@ GENERIC: valid-article? ( topic -- ? ) GENERIC: article-title ( topic -- string ) GENERIC: article-name ( topic -- string ) GENERIC: article-content ( topic -- content ) -GENERIC: article-parent ( topic -- parent ) +GENERIC: article-parent ( topic -- parent/f ) GENERIC: set-article-parent ( parent topic -- ) M: object article-name article-title ; diff --git a/basis/io/directories/directories-docs.factor b/basis/io/directories/directories-docs.factor index caf2913cf2..db49a4bdd0 100644 --- a/basis/io/directories/directories-docs.factor +++ b/basis/io/directories/directories-docs.factor @@ -20,7 +20,7 @@ $nl "This variable should never be set directly; instead, use " { $link set-current-directory } " or " { $link with-directory } ". This preserves the invariant that the value of this variable is an absolute path." } ; HELP: make-parent-directories -{ $values { "path" "a pathname string" } } +{ $values { "filename" "a pathname string" } } { $description "Creates all parent directories of the path which do not yet exist." } { $errors "Throws an error if the directories could not be created." } ; diff --git a/basis/lists/lazy/lazy-docs.factor b/basis/lists/lazy/lazy-docs.factor index ac9e053985..fa43da2186 100644 --- a/basis/lists/lazy/lazy-docs.factor +++ b/basis/lists/lazy/lazy-docs.factor @@ -109,11 +109,11 @@ HELP: lappend-lazy { $description "Perform a similar functionality to that of the " { $link append } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link lazy-append } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required. Successive calls to " { $link cdr } " will iterate through list1, followed by list2." } ; HELP: lfrom-by -{ $values { "n" integer } { "quot" { $quotation ( n -- o ) } } { "lazy-from-by" "a lazy list of integers" } } +{ $values { "n" integer } { "quot" { $quotation ( n -- o ) } } { "result" "a lazy list of integers" } } { $description "Return an infinite lazy list of values starting from n, with each successive value being the result of applying quot to the previous value." } ; HELP: lfrom -{ $values { "n" integer } { "list" "a lazy list of integers" } } +{ $values { "n" integer } { "result" "a lazy list of integers" } } { $description "Return an infinite lazy list of incrementing integers starting from n." } ; HELP: sequence-tail>list diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor index 5c928f8e5b..24f5866d42 100644 --- a/basis/math/vectors/vectors-docs.factor +++ b/basis/math/vectors/vectors-docs.factor @@ -304,7 +304,7 @@ HELP: vmin { $examples { $example "USING: math.vectors prettyprint ;" "{ 1 2 5 } { -7 6 3 } vmin ." "{ -7 2 3 }" } } ; HELP: vclamp -{ $values { "v" "a sequence of real numbers" } { "min" "a sequence of real numbers" } { "max" "a sequence of real numbers" } } +{ $values { "v" "a sequence of real numbers" } { "min" "a sequence of real numbers" } { "max" "a sequence of real numbers" } { "w" "a sequence of real numbers" } } { $description "Creates a sequence where each element is clamped to the minimum and maximum elements of the " { $snippet "min" } " and " { $snippet "max" } " sequences." } { $examples { $example diff --git a/basis/opengl/shaders/shaders-docs.factor b/basis/opengl/shaders/shaders-docs.factor index 7051364386..7b314f92ed 100644 --- a/basis/opengl/shaders/shaders-docs.factor +++ b/basis/opengl/shaders/shaders-docs.factor @@ -6,6 +6,7 @@ HELP: (gl-program) { $values { "shaders" sequence } { "quot" quotation } + { "program" "a new " { $link gl-program } } } { $description "Creates a gl program and attaches the shaders to it. Then applies the quotation to the program and finally links it." } diff --git a/basis/stack-checker/dependencies/dependencies-docs.factor b/basis/stack-checker/dependencies/dependencies-docs.factor index d80880ad70..2f5167eb8a 100644 --- a/basis/stack-checker/dependencies/dependencies-docs.factor +++ b/basis/stack-checker/dependencies/dependencies-docs.factor @@ -11,7 +11,7 @@ HELP: +definition+ { $description "Word that indicates that the dependency is a definition dependency. It is a dependency among two words in which one word depends on the definition of the another. For example, if two words are defined as " { $snippet ": o ( -- ) i ;" } " and " { $snippet ": i ( -- ) ; inline" } ", then 'o' has a definition dependency to 'i' because 'i' is inline. If the definition of 'i' changes 'o' must be recompiled." } ; HELP: add-depends-on-class -{ $values { "obj" classoid } } +{ $values { "classoid" classoid } } { $description "Adds a " { $link +conditional+ } " dependency from the word to the classes mentioned in the classoid." } ; HELP: conditional-dependencies diff --git a/basis/suffix-arrays/suffix-arrays-docs.factor b/basis/suffix-arrays/suffix-arrays-docs.factor index de8b0f2366..455756bd7d 100644 --- a/basis/suffix-arrays/suffix-arrays-docs.factor +++ b/basis/suffix-arrays/suffix-arrays-docs.factor @@ -7,7 +7,7 @@ IN: suffix-arrays HELP: >suffix-array { $values { "seq" sequence } - { "array" array } } + { "suffix-array" array } } { $description "Creates a suffix array from the input sequence. Suffix arrays are arrays of slices." } ; HELP: SA{ diff --git a/basis/typed/typed-docs.factor b/basis/typed/typed-docs.factor index 8f2e0e6f36..262a0a03e0 100644 --- a/basis/typed/typed-docs.factor +++ b/basis/typed/typed-docs.factor @@ -32,13 +32,13 @@ HELP: TYPED:: { $example "USING: kernel math math.libm prettyprint typed ; IN: scratchpad - +<< TYPED:: quadratic-roots ( a: float b: float c: float -- q1: float q2: float ) b neg b sq 4.0 a * c * - fsqrt [ + ] [ - ] 2bi [ 2.0 a * / ] bi@ ; - +>> 1 0 -9/4 quadratic-roots [ . ] bi@" "1.5 -1.5" } } ; diff --git a/basis/ui/backend/gtk/gtk-docs.factor b/basis/ui/backend/gtk/gtk-docs.factor index 83e214dd4f..2e436341cb 100644 --- a/basis/ui/backend/gtk/gtk-docs.factor +++ b/basis/ui/backend/gtk/gtk-docs.factor @@ -12,14 +12,14 @@ HELP: icon-data HELP: key-sym { $values - { "event" GdkEventKey } - { "sym/f" { $maybe string } } + { "keyval" GdkEventKey } + { "string/f" { $maybe string } } { "action?" boolean } } { $description "Gets the key symbol and action indicator from a " { $link GdkEventKey } " struct. If 'action?' is " { $link t } ", then the key is one of the special keys in " { $link codes } "." } ; HELP: on-configure { $values - { "win" alien } + { "window" alien } { "event" alien } { "user-data" alien } { "?" boolean } diff --git a/basis/vocabs/metadata/metadata-docs.factor b/basis/vocabs/metadata/metadata-docs.factor index 3fe93916b6..9081619e6c 100644 --- a/basis/vocabs/metadata/metadata-docs.factor +++ b/basis/vocabs/metadata/metadata-docs.factor @@ -39,7 +39,7 @@ ARTICLE: "vocabs.metadata" "Vocabulary metadata" ABOUT: "vocabs.metadata" HELP: vocab-file-lines -{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "lines" { $maybe { $sequence "lines" } } } } +{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "lines/f" { $maybe { $sequence "lines" } } } } { $description "Outputs the lines of the file named " { $snippet "name" } " from the vocabulary's directory, or " { $link f } " if the file does not exist." } ; HELP: set-vocab-file-lines diff --git a/basis/wrap/words/words-docs.factor b/basis/wrap/words/words-docs.factor index e3a77e127a..3c54dc4ffd 100644 --- a/basis/wrap/words/words-docs.factor +++ b/basis/wrap/words/words-docs.factor @@ -14,7 +14,7 @@ ARTICLE: "wrap.words" "Word object wrapping" } ; HELP: wrap-words -{ $values { "words" { "a sequence of " { $instance wrapping-word } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } } +{ $values { "words" { "a sequence of " { $instance wrapping-word } "s" } } { "width" integer } { "lines" "a sequence of sequences of words" } } { $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given maximum. The returned set of lines is optimized to minimize the square of the deviation of each line from the ideal width. It is not guaranteed to be the minimal number of lines. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ; HELP: wrapping-word diff --git a/basis/wrap/wrap-docs.factor b/basis/wrap/wrap-docs.factor index 0f6b7f5a94..fd4e345750 100644 --- a/basis/wrap/wrap-docs.factor +++ b/basis/wrap/wrap-docs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: help.syntax help.markup strings math kernel ; +USING: arrays help.markup help.syntax kernel math strings ; IN: wrap ABOUT: "wrap" @@ -19,5 +19,5 @@ HELP: element } ; HELP: wrap -{ $values { "elements" { $sequence element } } { "width" real } } +{ $values { "elements" { $sequence element } } { "width" real } { "array" array } } { $description "Break the " { $snippet "elements" } " into lines such that the total width of each line tries to be less than " { $snippet "width" } " while attempting to minimize the raggedness represented by the amount of space at the end of each line. Returns an array of lines." } ; diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 2d4caa5736..16a38fac40 100644 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -95,7 +95,7 @@ HELP: c-ptr { $class-description "Class of objects consisting of aliens, byte arrays and " { $link f } ". These objects all can be used as values of " { $link pointer } " C types." } ; HELP: alien-invoke -{ $values { "args..." "zero or more objects passed to the C function" } { "return" "a C return type" } { "library" "a logical library name" } { "function" "a C function name" } { "parameters" "a sequence of C parameter types" } { "return..." "the return value of the function, if not " { $link void } } } +{ $values { "args..." "zero or more objects passed to the C function" } { "return" "a C return type" } { "library" "a logical library name" } { "function" "a C function name" } { "parameters" "a sequence of C parameter types" } { "varargs?" boolean } { "return..." "the return value of the function, if not " { $link void } } } { $description "Calls a C library function with the given name. Input parameters are taken from the data stack, and the return value is pushed on the data stack after the function returns. A return type of " { $link void } " indicates that no value is to be expected." } { $notes "C type names are documented in " { $link "c-types-specs" } "." } { $errors "Throws an " { $link callsite-not-compiled } " if the word calling " { $link alien-invoke } " was not compiled with the optimizing compiler." } ; diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index 4ee30d1d8b..b1d20a04d6 100644 --- a/core/classes/tuple/tuple-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -455,7 +455,7 @@ HELP: bad-superclass { $error-description "Thrown if an attempt is made to subclass a class that is not a tuple class, or a tuple class declared " { $link POSTPONE: final } "." } ; HELP: ?offset-of-slot -{ $values { "name" string } { "tuple" tuple } { "n" { $maybe integer } } } +{ $values { "name" string } { "tuple" tuple } { "n/f" { $maybe integer } } } { $description "Returns the offset of a tuple slot accessed by " { $snippet "name" } ", or " { $link f } " if no slot with that name." } ; HELP: offset-of-slot diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 3f290bdea7..ad0009e95f 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -794,7 +794,7 @@ HELP: curried { curry curried compose prepose composed } related-words HELP: 2curry -{ $values { "obj1" object } { "obj2" object } { "quot" callable } { "curry" curried } } +{ $values { "obj1" object } { "obj2" object } { "quot" callable } { "curried" curried } } { $description "Outputs a " { $link callable } " which pushes " { $snippet "obj1" } " and " { $snippet "obj2" } " and then calls " { $snippet "quot" } "." } { $notes "This operation is efficient and does not copy the quotation." } { $examples @@ -802,12 +802,12 @@ HELP: 2curry } ; HELP: 3curry -{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quot" callable } { "curry" curried } } +{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quot" callable } { "curried" curried } } { $description "Outputs a " { $link callable } " which pushes " { $snippet "obj1" } ", " { $snippet "obj2" } " and " { $snippet "obj3" } ", and then calls " { $snippet "quot" } "." } { $notes "This operation is efficient and does not copy the quotation." } ; HELP: with -{ $values { "param" object } { "obj" object } { "quot" { $quotation ( param elt -- ... ) } } { "curry" curried } } +{ $values { "param" object } { "obj" object } { "quot" { $quotation ( param elt -- ... ) } } { "curried" curried } } { $description "Partial application on the left. The following two lines are equivalent:" { $code "swap [ swap A ] curry B" } { $code "[ A ] with B" } @@ -825,7 +825,7 @@ HELP: 2with { "param2" object } { "obj" object } { "quot" { $quotation ( param1 param2 elt -- ... ) } } - { "curry" curried } + { "curried" curried } } { $description "Partial application on the left of two parameters." } ; @@ -842,7 +842,7 @@ HELP: compose } ; HELP: prepose -{ $values { "quot1" callable } { "quot2" callable } { "compose" composed } } +{ $values { "quot1" callable } { "quot2" callable } { "composed" composed } } { $description "Quotation composition. Outputs a " { $link callable } " which calls " { $snippet "quot2" } " followed by " { $snippet "quot1" } "." } { $notes "See " { $link compose } " for details." } ; diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index c37e788efa..236ba6f4cc 100644 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -277,7 +277,7 @@ HELP: if-zero HELP: when-zero { $values - { "n" number } { "quot" "the first quotation of an " { $link if-zero } } } + { "n" number } { "quot" "the first quotation of an " { $link if-zero } } { "x" object } } { $description "Makes an implicit check if the number is zero. A zero is dropped and the " { $snippet "quot" } " is called." } { $examples "This word is equivalent to " { $link if-zero } " with an empty second quotation:" { $example diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 1c8dcf80c0..fbb65a9133 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -1210,12 +1210,12 @@ HELP: supremum { min max supremum infimum } related-words HELP: shortest -{ $values { "seq" sequence } { "elt" object } } -{ $description "Outputs the shortest element of " { $snippet "seq" } "." } ; +{ $values { "seqs" sequence } { "elt" object } } +{ $description "Outputs the shortest sequence from " { $snippet "seqs" } "." } ; HELP: longest -{ $values { "seq" sequence } { "elt" object } } -{ $description "Outputs the longest element of " { $snippet "seq" } "." } ; +{ $values { "seqs" sequence } { "elt" object } } +{ $description "Outputs the longest sequence from " { $snippet "seqs" } "." } ; { shortest longest } related-words diff --git a/extra/ctags/ctags-docs.factor b/extra/ctags/ctags-docs.factor index 64a645df64..c4312dcf48 100644 --- a/extra/ctags/ctags-docs.factor +++ b/extra/ctags/ctags-docs.factor @@ -20,7 +20,7 @@ HELP: write-ctags } ; HELP: ctags -{ $values { "alist" "ctags" } } +{ $values { "ctags" "alist" } } { $description "Make a sequence of ctags from " { $link all-words } ", sorted by word name." } ; ABOUT: "ctags" diff --git a/extra/fuel/help/help-docs.factor b/extra/fuel/help/help-docs.factor index 6cbdcc27cc..0aff60a5c7 100644 --- a/extra/fuel/help/help-docs.factor +++ b/extra/fuel/help/help-docs.factor @@ -6,7 +6,7 @@ HELP: article-parents { $description "All the parent articles for the article and ensures that the ancestor always is 'handbook'." } ; HELP: get-article -{ $values { "name" string } { "str" string } } +{ $values { "name" string } { "element" string } } { $description "If an article and a vocab share name, we render the vocab instead." } ; HELP: find-word diff --git a/extra/gpu/shaders/shaders-docs.factor b/extra/gpu/shaders/shaders-docs.factor index e00defe626..f8d9d30aa2 100644 --- a/extra/gpu/shaders/shaders-docs.factor +++ b/extra/gpu/shaders/shaders-docs.factor @@ -31,6 +31,7 @@ HELP: { "vertex-buffer" "a vertex buffer" } { "program-instance" program-instance } { "format" vertex-format } + { "vertex-array" vertex-array } } { $description "Creates a new vertex array object." } ; diff --git a/extra/odbc/odbc-docs.factor b/extra/odbc/odbc-docs.factor index 52a9ee8c48..6f1c6448bc 100644 --- a/extra/odbc/odbc-docs.factor +++ b/extra/odbc/odbc-docs.factor @@ -77,7 +77,7 @@ HELP: odbc-number-of-columns HELP: odbc-describe-column { $values { "statement" "an ODBC statement handle" } - { "n" "a column number starting from one" } + { "columnNumber" "a column number starting from one" } { "column" "a column object" } } { $description @@ -88,7 +88,7 @@ HELP: odbc-describe-column HELP: odbc-get-field { $values { "statement" "an ODBC statement handle" } - { "column" "a column number starting from one or a object" } + { "column!" "a column number starting from one or a object" } { "field" "a object" } } { $description diff --git a/extra/successor/successor-docs.factor b/extra/successor/successor-docs.factor index fad0a23d11..025ff47f38 100644 --- a/extra/successor/successor-docs.factor +++ b/extra/successor/successor-docs.factor @@ -6,7 +6,7 @@ USING: help.markup help.syntax successor strings ; IN: succesor HELP: successor -{ $values { "str" string } } +{ $values { "str" string } { "str'" string } } { $description "Returns the successor to " { $snippet "str" } ". The successor is calculated by incrementing characters starting from the rightmost alphanumeric (or the rightmost character if there are no alphanumerics) in the string. Incrementing a digit always results in another digit, and incrementing a letter results in another letter of the same case. " $nl diff --git a/extra/trees/trees-docs.factor b/extra/trees/trees-docs.factor index 5df07e4ef3..0a9efeaab1 100644 --- a/extra/trees/trees-docs.factor +++ b/extra/trees/trees-docs.factor @@ -177,14 +177,14 @@ HELP: first-key HELP: pop-tree-left { $values { "tree" tree } - { "pair/f" { $maybe pair } } + { "node/f" { $maybe pair } } } { $description "Removes and returns a key-value mapping associated with the lowest key in this map, or " { $link f } " if the map is empty." } ; HELP: pop-tree-right { $values { "tree" tree } - { "pair/f" { $maybe pair } } + { "node/f" { $maybe pair } } } { $description "Removes and returns a key-value mapping associated with the highest key in this map, or " { $link f } " if the map is empty." } ; diff --git a/extra/ui/gadgets/charts/lines/lines-docs.factor b/extra/ui/gadgets/charts/lines/lines-docs.factor index 8fc9cf1f87..bde78cc9ee 100644 --- a/extra/ui/gadgets/charts/lines/lines-docs.factor +++ b/extra/ui/gadgets/charts/lines/lines-docs.factor @@ -57,6 +57,12 @@ $nl HELP: y-at { $description "Given two points on a straight line and an " { $snippet "x" } " coordinate, calculate the " { $snippet "y" } " coordinate at " { $snippet "x" } " on that line." } +{ $values + { "x" object } + { "point1" object } + { "point2" object } + { "y" object } +} { $examples { $example "USING: ui.gadgets.charts.lines.private prettyprint ;" @@ -77,6 +83,12 @@ HELP: y-at HELP: calc-x { $description "Given the " { $snippet "slope" } " of a line and a random " { $snippet "point" } " belonging to that line, calculate the " { $snippet "x" } " coordinate corresponding to the given " { $snippet "y" } "." } +{ $values + { "slope" object } + { "y" object } + { "point" object } + { "x" object } +} { $examples { $example "USING: ui.gadgets.charts.lines.private prettyprint ;" @@ -92,6 +104,12 @@ HELP: calc-x HELP: calc-y { $description "Given the " { $snippet "slope" } " of a line and a random " { $snippet "point" } " belonging to that line, calculate the " { $snippet "y" } " coordinate corresponding to the given " { $snippet "x" } "." } +{ $values + { "slope" object } + { "x" object } + { "point" object } + { "y" object } +} { $examples { $example "USING: ui.gadgets.charts.lines.private prettyprint ;" @@ -107,6 +125,11 @@ HELP: calc-y HELP: calc-line-slope { $description "Given the two points belonging to a straight line, calculate the " { $snippet "slope" } " of the line, assuming the line equation is " { $snippet "y(x) = slope * x + b" } "." +{ $values + { "point1" object } + { "point2" object } + { "slope" object } +} $nl "The formula for the calculation is " { $snippet "slope = (y1-y2) / (x1-x2)" } ", therefore it'll throw a division by zero error if both points have the same " { $snippet "x" } " coordinate." } { $examples From 7a00e44caddd4fd3e46b43e6d7ab1ee8830ea163 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 01:11:56 -0500 Subject: [PATCH 31/84] .travis.yml: Print out changed vocabularies again. Also do help-lint-all. --- .travis.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.travis.yml b/.travis.yml index 70fa7ffbcf..5fe890a316 100644 --- a/.travis.yml +++ b/.travis.yml @@ -48,6 +48,8 @@ script: - echo "CI_BRANCH=${CI_BRANCH}" - DEBUG=1 ./build.sh net-bootstrap < /dev/null - "./factor -e='USING: memory vocabs.hierarchy ; \"zealot\" load save'" + - './factor -run=zealot.cli-changed-vocabs' - './factor -run=tools.test `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`' + - './factor -run=help.lint `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`' # - ./factor -run=zealot.cli-changed-vocabs # - "./factor -e='USING: modern.paths tools.test sequences ; core-vocabs [ test ] each'" From 8c9b3bf7a41f361b83111cb567319ad485f62483 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 01:47:46 -0500 Subject: [PATCH 32/84] .travis.yml: Add the clean repositories. I also had to force push to these from factorcode's script that syncs factorcode to github. --- .travis.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.travis.yml b/.travis.yml index 5fe890a316..d7d1015527 100644 --- a/.travis.yml +++ b/.travis.yml @@ -41,6 +41,12 @@ before_install: ( cd udis86-1.7.2/ && ./autogen.sh && ./configure --enable-shared=yes && make && sudo make install ) && ( [[ "$TRAVIS_OS_NAME" != "osx" ]] && sudo ldconfig || true ) - git remote set-branches --add origin master + - git remote set-branches --add origin clean-windows-x86-64 + - git remote set-branches --add origin clean-windows-x86-32 + - git remote set-branches --add origin clean-linux-x86-64 + - git remote set-branches --add origin clean-linux-x86-32 + - git remote set-branches --add origin clean-macosx-x86-64 + - git remote set-branches --add origin clean-macosx-x86-32 - git fetch # so we can see which vocabs changed versus origin/master... script: - echo "TRAVIS_BRANCH=$TRAVIS_BRANCH, TRAVIS_PULL_REQUEST_BRANCH=$TRAVIS_PULL_REQUEST_BRANCH" From dadf462661edc3f3ea84cd7953a7bef8ae6f10ce Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 02:03:55 -0500 Subject: [PATCH 33/84] help.lint.coverage: Add yet another sanity test, clean up broken words after lint test. --- .../help/lint/coverage/coverage-tests.factor | 36 +++++++++++++++++-- 1 file changed, 33 insertions(+), 3 deletions(-) diff --git a/extra/help/lint/coverage/coverage-tests.factor b/extra/help/lint/coverage/coverage-tests.factor index 4c668b3889..2c4421a3f3 100644 --- a/extra/help/lint/coverage/coverage-tests.factor +++ b/extra/help/lint/coverage/coverage-tests.factor @@ -1,7 +1,7 @@ -USING: accessors english help.lint.coverage +USING: accessors english eval help.lint.coverage help.lint.coverage.private help.markup help.syntax kernel -literals math math.matrices sequences sorting tools.test vocabs -; +literals math math.matrices multiline sequences sorting +tools.test vocabs ; IN: help.lint.coverage.tests ! make sure this doesn't throw an error (would signify an issue with ignored-words) ! the contents of all-words is not important { } [ all-words [ ] map drop ] unit-test + + +! Lint system is written weirdly, there's no way to invoke it and get the output +! Instead, it writes to lint-failures. +{ } +[ + [[ + USING: assocs math kernel namespaces help.syntax help.lint help.lint.private ; + IN: help.lint.tests + << + : add-stuff ( x y -- z ) + ; + + HELP: add-stuff ; + >> + H{ } clone lint-failures [ \ add-stuff check-word lint-failures get ] with-variable + assoc-empty? [ "help-lint is broken" throw ] when + ]] eval( -- ) +] unit-test + + +! clean up broken words +[[ + USING: definitions ; + IN: help.lint.coverage.tests.private +<< +\ empty forget +\ nonexistent forget +\ defined forget +>> +]] eval( -- ) \ No newline at end of file From 54d36ec03ff25b785714c1e2db40f43dabbc2683 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 02:44:32 -0500 Subject: [PATCH 34/84] kernel: Test if one ``-1 f `` hangs travisci. Related to #2013. --- core/kernel/kernel-tests.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index a1942a4de8..2d1d044876 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -22,10 +22,12 @@ IN: kernel.tests } } [ 1 2 10 [ 3array ] 2with map ] unit-test + ! Don't leak extra roots if error is thrown { } [ 1000 [ [ 3 throw ] ignore-errors ] times ] unit-test -{ } [ 1000 [ [ -1 f ] ignore-errors ] times ] unit-test +[ -1 f ] must-fail +{ } [ 1000 [ [ -1 f ] ignore-errors ] times ] unit-test ! Travis CI fails ! Make sure we report the correct error on stack underflow [ clear drop ] [ From ebf9edb243a22a4721b47dbc840c1f259e030010 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 03:04:05 -0500 Subject: [PATCH 35/84] .travis.yml: Don't test on clean branches. --- .travis.yml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/.travis.yml b/.travis.yml index d7d1015527..6a89a48514 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,6 +11,14 @@ group: deprecated-2017Q4 services: - postgresql - redis-server +branches: + except: + - clean-windows-x86-64 + - clean-windows-x86-32 + - clean-linux-x86-64 + - clean-linux-x86-32 + - clean-macosx-x86-64 + - clean-macosx-x86-32 addons: apt: packages: From 93b5e59f72fd9f2921371dac711bbcb732725e73 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 03:15:09 -0500 Subject: [PATCH 36/84] kernel: Only test that it fails 10 times for TravisCI to pass. --- core/kernel/kernel-tests.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index 2d1d044876..d8ce2094e6 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -27,7 +27,8 @@ IN: kernel.tests { } [ 1000 [ [ 3 throw ] ignore-errors ] times ] unit-test [ -1 f ] must-fail -{ } [ 1000 [ [ -1 f ] ignore-errors ] times ] unit-test ! Travis CI fails +{ } [ 10 [ [ -1 f ] ignore-errors ] times ] unit-test +! { } [ 1000 [ [ -1 f ] ignore-errors ] times ] unit-test ! Travis CI fails ! Make sure we report the correct error on stack underflow [ clear drop ] [ From 7da7a1d70eaee15af045e29f5270016954298e47 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 03:35:09 -0500 Subject: [PATCH 37/84] .travis.yml: Test all of core/ because it stopped hanging. --- .travis.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 6a89a48514..2f262813a8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -65,5 +65,4 @@ script: - './factor -run=zealot.cli-changed-vocabs' - './factor -run=tools.test `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`' - './factor -run=help.lint `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`' -# - ./factor -run=zealot.cli-changed-vocabs -# - "./factor -e='USING: modern.paths tools.test sequences ; core-vocabs [ test ] each'" + - "./factor -e='USING: modern.paths tools.test sequences ; core-vocabs [ test ] each'" From 79db3ca594e71516b9ed543ac88aeefe307e23e0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 08:24:05 -0500 Subject: [PATCH 38/84] docs: fix docs for help-lint --- basis/cocoa/messages/messages-docs.factor | 4 ++-- extra/help/lint/coverage/coverage-tests.factor | 6 ++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/basis/cocoa/messages/messages-docs.factor b/basis/cocoa/messages/messages-docs.factor index a0eed26c5b..422bf5becd 100644 --- a/basis/cocoa/messages/messages-docs.factor +++ b/basis/cocoa/messages/messages-docs.factor @@ -2,13 +2,13 @@ USING: help.markup help.syntax strings alien ; IN: cocoa.messages HELP: send -{ $values { "receiver" alien } { "args..." "method arguments" } { "selector" string } { "return..." "value returned by method, if any" } } +{ $values { "receiver" alien } { "args..." "method arguments" } { "signature" "signature" } { "selector" string } { "return..." "value returned by method, if any" } } { $description "Sends an Objective C message named by " { $snippet "selector" } " to " { $snippet "receiver" } ". The arguments must be on the stack in left-to-right order." } { $errors "Throws an error if the receiver does not recognize the message, or if the arguments have inappropriate types." } { $notes "This word uses a special fast code path if " { $snippet "selector" } " is a literal and the word containing the call to " { $link send } " is compiled." } ; HELP: super-send -{ $values { "receiver" alien } { "args..." "method arguments" } { "selector" string } { "return..." "value returned by method, if any" } } +{ $values { "receiver" alien } { "args..." "method arguments" } { "selector" string } { "signature" "signature" } { "return..." "value returned by method, if any" } } { $description "Sends an Objective C message named by " { $snippet "selector" } " to the super class of " { $snippet "receiver" } ". Otherwise behaves identically to " { $link send } "." } ; HELP: objc-class diff --git a/extra/help/lint/coverage/coverage-tests.factor b/extra/help/lint/coverage/coverage-tests.factor index 2c4421a3f3..aa98ac3120 100644 --- a/extra/help/lint/coverage/coverage-tests.factor +++ b/extra/help/lint/coverage/coverage-tests.factor @@ -74,7 +74,8 @@ PRIVATE> { } [ [[ - USING: assocs math kernel namespaces help.syntax help.lint help.lint.private ; + USING: assocs definitions math kernel namespaces help.syntax + help.lint help.lint.private ; IN: help.lint.tests << : add-stuff ( x y -- z ) + ; @@ -83,6 +84,7 @@ PRIVATE> >> H{ } clone lint-failures [ \ add-stuff check-word lint-failures get ] with-variable assoc-empty? [ "help-lint is broken" throw ] when + << \ add-stuff forget >> ]] eval( -- ) ] unit-test @@ -96,4 +98,4 @@ PRIVATE> \ nonexistent forget \ defined forget >> -]] eval( -- ) \ No newline at end of file +]] eval( -- ) From e5bd5f6719760de2371a1797b34fd3a3e597e278 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 11:14:16 -0500 Subject: [PATCH 39/84] help.lint.checks: Save lint disposables in hash. --- basis/help/lint/checks/checks.factor | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index 47a4c6a43f..a10315bb4c 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -4,10 +4,10 @@ USING: accessors arrays assocs classes classes.struct classes.tuple combinators combinators.short-circuit combinators.smart continuations debugger definitions effects eval formatting fry grouping help help.markup help.topics io -io.streams.string kernel macros math namespaces parser.notes -prettyprint sequences sequences.deep sets splitting strings -summary tools.destructors unicode vocabs vocabs.loader words -words.constant words.symbol ; +io.streams.string kernel macros math math.statistics namespaces +parser.notes prettyprint sequences sequences.deep sets splitting +strings summary tools.destructors unicode vocabs vocabs.loader +words words.constant words.symbol ; IN: help.lint.checks ERROR: simple-lint-error message ; @@ -50,9 +50,13 @@ SYMBOL: vocab-articles ] keep last assert= ] vocabs-quot get call( quot -- ) - ] leaks members no-ui-disposables length [ - "%d disposable(s) leaked in example" sprintf simple-lint-error - ] unless-zero ; + ] leaks members no-ui-disposables + dup length 0 > [ + dup [ class-of ] histogram-by + [ "Leaked resources: " write ... ] with-string-writer simple-lint-error + ] [ + drop + ] if ; : check-examples ( element -- ) \ $example swap elements [ check-example ] each ; From 57ee2553b3894b58c6b396ae3d03bdb560f770c9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 11:14:57 -0500 Subject: [PATCH 40/84] grouping: Fix some spacing. --- basis/grouping/grouping-docs.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index 83b6dcbdb9..0126935806 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -123,7 +123,9 @@ HELP: circular-clump { $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements, wrapping around the end of the sequence, and collects the clumps into a new array." } { $notes "For an empty sequence, the result is an empty sequence." } { $examples - { $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 circular-clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } { 7 3 } }" } + { $example "USING: grouping prettyprint ;" + "{ 3 1 3 3 7 } 2 circular-clump ." + "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } { 7 3 } }" } } ; HELP: From f4ac9fcfca0fc5a35b88aac930dec71840c15ee8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 11:16:23 -0500 Subject: [PATCH 41/84] cocoa.messages: fix docs.. --- basis/cocoa/messages/messages-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/cocoa/messages/messages-docs.factor b/basis/cocoa/messages/messages-docs.factor index 422bf5becd..3ccf2c25f8 100644 --- a/basis/cocoa/messages/messages-docs.factor +++ b/basis/cocoa/messages/messages-docs.factor @@ -8,7 +8,7 @@ HELP: send { $notes "This word uses a special fast code path if " { $snippet "selector" } " is a literal and the word containing the call to " { $link send } " is compiled." } ; HELP: super-send -{ $values { "receiver" alien } { "args..." "method arguments" } { "selector" string } { "signature" "signature" } { "return..." "value returned by method, if any" } } +{ $values { "receiver" alien } { "args..." "method arguments" } { "signature" "signature" } { "selector" string } { "return..." "value returned by method, if any" } } { $description "Sends an Objective C message named by " { $snippet "selector" } " to the super class of " { $snippet "receiver" } ". Otherwise behaves identically to " { $link send } "." } ; HELP: objc-class From 3ac520a8ecb1af0849d4cc40c36b284b02bf40e9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 11:59:59 -0500 Subject: [PATCH 42/84] io.pathnames: Add canonicalize-path. The idea is to make a canonical representation of any path, taking into account . and .. and unicode-prefix on Windows. The use case is in a shell you have a current-directory and you can do crazy commands like ``cd ../foo/bar/baz/../.././././`` and get the canonical/shortened directory name. You can also use this word to compare if two paths are the same. --- basis/io/files/windows/windows.factor | 16 ++++- core/io/pathnames/pathnames-tests.factor | 81 +++++++++++++++++++++++- core/io/pathnames/pathnames.factor | 53 +++++++++++++++- 3 files changed, 142 insertions(+), 8 deletions(-) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 556bbfc4ee..2ed1926cdb 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -8,7 +8,7 @@ io.files.types io.pathnames io.ports io.streams.c io.streams.null io.timeouts kernel libc literals locals math math.bitwise namespaces sequences specialized-arrays system threads tr vectors windows windows.errors windows.handles windows.kernel32 windows.shell32 -windows.time windows.types windows.winsock ; +windows.time windows.types windows.winsock splitting ; SPECIALIZED-ARRAY: ushort IN: io.files.windows @@ -326,11 +326,14 @@ M: windows root-directory? ( path -- ? ) [ drop f ] } cond ; -: prepend-prefix ( string -- string' ) +: prepend-unicode-prefix ( string -- string' ) dup unicode-prefix head? [ unicode-prefix prepend ] unless ; +: remove-unicode-prefix ( string -- string' ) + unicode-prefix ?head drop ; + TR: normalize-separators "/" "\\" ; +M: windows canonicalize-path + remove-unicode-prefix canonicalize-path* ; + +M: object root-path remove-unicode-prefix root-path* ; + +M: object relative-path remove-unicode-prefix relative-path* ; + M: windows normalize-path ( string -- string' ) dup unc-path? [ normalize-separators ] [ absolute-path normalize-separators - prepend-prefix + prepend-unicode-prefix ] if ; pathname M: pathname absolute-path string>> absolute-path ; -M: pathname <=> [ string>> ] compare ; +M: pathname <=> [ string>> ] compare ; \ No newline at end of file From db9386d4c34e05af93ae3b99a7ad6cd7b5c5f22a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 12:09:02 -0500 Subject: [PATCH 43/84] io.pathnames: Fix using list. --- core/io/pathnames/pathnames.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index a722668981..d1aed3ad82 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators io.backend io.files.windows kernel -math math.order namespaces sequences splitting strings system ; +USING: accessors combinators io.backend kernel math math.order +namespaces sequences splitting strings system ; IN: io.pathnames SYMBOL: current-directory From 70537e86e456aeedc8d22de57aba4ab30172db7a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 12:26:27 -0500 Subject: [PATCH 44/84] fuel.help: Help test requires io.servers to be loaded, so load it. --- extra/fuel/help/help-tests.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/extra/fuel/help/help-tests.factor b/extra/fuel/help/help-tests.factor index f2c7dc56e2..10250e8a7d 100644 --- a/extra/fuel/help/help-tests.factor +++ b/extra/fuel/help/help-tests.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: fuel.help fuel.help.private help help.topics sequences tools.test ; +USE: io.servers ! required for a test to pass { { From 76f4678a963a1adb90861fea7cd8bf6dbb8d3db3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 12:33:08 -0500 Subject: [PATCH 45/84] gpu: Load all the links for the docs to not error with: ``Help article does not exist name "gpu.textures"`` There might be a better way. --- extra/gpu/gpu-docs.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/gpu/gpu-docs.factor b/extra/gpu/gpu-docs.factor index 6933ba1979..640aa6b1ad 100644 --- a/extra/gpu/gpu-docs.factor +++ b/extra/gpu/gpu-docs.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2009 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: gpu.private help.markup help.syntax ui.gadgets.worlds ; +USING: gpu.private help.markup help.syntax ui.gadgets.worlds +gpu.textures gpu.state gpu.framebuffers gpu.shaders gpu.render ; IN: gpu HELP: finish-gpu From 0b0ead51359afe821fa05cc13b265956a1fc7c78 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 12:47:45 -0500 Subject: [PATCH 46/84] yaml: Docs don't help-lint unless the yaml library is present. We need a better docs system, after .98 --- extra/yaml/yaml-docs.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/yaml/yaml-docs.factor b/extra/yaml/yaml-docs.factor index 6e20122faf..c3696e807d 100644 --- a/extra/yaml/yaml-docs.factor +++ b/extra/yaml/yaml-docs.factor @@ -156,7 +156,7 @@ ARTICLE: "yaml-keys" "Special mapping keys" "See " { $url "http://yaml.org/type/merge.html" } $nl "As per " { $url "http://sourceforge.net/p/yaml/mailman/message/12308050" } ", the merge key is implemented bottom up:" $nl -{ $example "USING: yaml prettyprint ; +{ $unchecked-example "USING: yaml prettyprint ; \" foo: 1 <<: @@ -167,7 +167,7 @@ foo: 1 "H{ { \"baz\" 3 } { \"foo\" 1 } { \"bar\" 2 } }" } { $heading "!!value" } "See " { $url "http://yaml.org/type/value.html" } $nl -{ $example "USING: yaml prettyprint ; +{ $unchecked-example "USING: yaml prettyprint ; \" --- # Old schema link with: @@ -205,7 +205,7 @@ ARTICLE: "yaml" "YAML serialization" } { $examples { $heading "Input" } - { $example "USING: prettyprint yaml ;" + { $unchecked-example "USING: prettyprint yaml ;" "\"- true - null - ! 42 @@ -218,7 +218,7 @@ ARTICLE: "yaml" "YAML serialization" "{ t f \"42\" \"42\" 42 42 42 42.0 42.0 }" } { $heading "Output -- human readable" } - { $example "USING: yaml yaml.config ;" + { $unchecked-example "USING: yaml yaml.config ;" "t implicit-tags set t implicit-start set t implicit-end set @@ -249,7 +249,7 @@ t emitter-unicode set " } { $heading "Output -- verbose" } - { $example "USING: yaml yaml.config ;" + { $unchecked-example "USING: yaml yaml.config ;" "f implicit-tags set f implicit-start set f implicit-end set From 7df8e8b1a9cc84d7a3f7321834f5baf5f91c43d2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 13:50:26 -0500 Subject: [PATCH 47/84] .travis.yml: The travisci macOS machines are slower, so only test half of the core-vocabs randomly on macOS. --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 2f262813a8..39cefda865 100644 --- a/.travis.yml +++ b/.travis.yml @@ -65,4 +65,4 @@ script: - './factor -run=zealot.cli-changed-vocabs' - './factor -run=tools.test `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`' - './factor -run=help.lint `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`' - - "./factor -e='USING: modern.paths tools.test sequences ; core-vocabs [ test ] each'" + - "./factor -e='USING: modern.paths tools.test sequences system kernel math random ; core-vocabs os macosx? [ dup length 2/ sample ] when [ test ] each'" From be2061e9cd7a974b697bc1ba1e720433d33bae16 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 14:46:32 -0500 Subject: [PATCH 48/84] .travis.yml: Fix rvm error hopefully. /Users/travis/build.sh: line 109: shell_session_update: command not found https://github.com/travis-ci/travis-ci/issues/6307 --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 39cefda865..6cabe1d5f5 100644 --- a/.travis.yml +++ b/.travis.yml @@ -44,6 +44,7 @@ before_install: - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew services start redis; fi - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew services start postgresql; fi - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew services start memcached; fi + - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rvm get stable; fi # https://github.com/travis-ci/travis-ci/issues/6307 - > wget https://github.com/vmt/udis86/archive/v1.7.2.tar.gz && tar xzvf v1.7.2.tar.gz && ( cd udis86-1.7.2/ && ./autogen.sh && ./configure --enable-shared=yes && make && sudo make install ) && From f0d06861148f43fe8724b33469c118a85add9034 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 14:49:17 -0500 Subject: [PATCH 49/84] .travis.yml: Still running out of time on macOS, test fewer. --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 6cabe1d5f5..265f8194ee 100644 --- a/.travis.yml +++ b/.travis.yml @@ -66,4 +66,4 @@ script: - './factor -run=zealot.cli-changed-vocabs' - './factor -run=tools.test `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`' - './factor -run=help.lint `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`' - - "./factor -e='USING: modern.paths tools.test sequences system kernel math random ; core-vocabs os macosx? [ dup length 2/ sample ] when [ test ] each'" + - "./factor -e='USING: modern.paths tools.test sequences system kernel math random ; core-vocabs os macosx? [ dup length 3 /i sample ] when [ test ] each'" From 06758e96334544ff6daa435d5c6468e2cfd13ecb Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 15:02:30 -0500 Subject: [PATCH 50/84] travis.yml: rvm sucks, travisci sucks... --- .travis.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 265f8194ee..0e8649d65b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -44,7 +44,10 @@ before_install: - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew services start redis; fi - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew services start postgresql; fi - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew services start memcached; fi - - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rvm get stable; fi # https://github.com/travis-ci/travis-ci/issues/6307 + - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rm -rf ~/.gnupg/; fi # https://github.com/rvm/rvm/issues/3110 + - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then curl -#LO https://rvm.io/mpapis.asc; fi + - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then gpg --import mpapis.asc; fi + - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then curl -sSL https://get.rvm.io | bash -s stable; fi # https://github.com/travis-ci/travis-ci/issues/6307 - > wget https://github.com/vmt/udis86/archive/v1.7.2.tar.gz && tar xzvf v1.7.2.tar.gz && ( cd udis86-1.7.2/ && ./autogen.sh && ./configure --enable-shared=yes && make && sudo make install ) && From f140d48e24aa8ed3a1ca57798f36a542db8bcfc7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 15:40:33 -0500 Subject: [PATCH 51/84] help.lint.coverage: Clean up test a bit. Hopefully this fixes an error on macOS in travisci. --- .../help/lint/coverage/coverage-tests.factor | 31 ++++++++++++------- 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/extra/help/lint/coverage/coverage-tests.factor b/extra/help/lint/coverage/coverage-tests.factor index aa98ac3120..ada199ab67 100644 --- a/extra/help/lint/coverage/coverage-tests.factor +++ b/extra/help/lint/coverage/coverage-tests.factor @@ -71,31 +71,38 @@ PRIVATE> ! Lint system is written weirdly, there's no way to invoke it and get the output ! Instead, it writes to lint-failures. -{ } +{ t } [ [[ USING: assocs definitions math kernel namespaces help.syntax - help.lint help.lint.private ; + help.lint help.lint.private continuations compiler.units ; IN: help.lint.tests << : add-stuff ( x y -- z ) + ; HELP: add-stuff ; >> - H{ } clone lint-failures [ \ add-stuff check-word lint-failures get ] with-variable - assoc-empty? [ "help-lint is broken" throw ] when - << \ add-stuff forget >> - ]] eval( -- ) + [ + H{ } clone lint-failures [ + \ add-stuff check-word lint-failures get + assoc-empty? [ "help-lint is broken" throw ] when + ] with-variable t + ] [ + [ \ add-stuff forget ] with-compilation-unit + ] [ + f + ] cleanup + ]] eval( -- ? ) ] unit-test ! clean up broken words [[ - USING: definitions ; + USING: definitions compiler.units ; IN: help.lint.coverage.tests.private -<< -\ empty forget -\ nonexistent forget -\ defined forget ->> +[ + \ empty forget + \ nonexistent forget + \ defined forget +] with-compilation-unit ]] eval( -- ) From 565ac276cd022ef4bf7f117a2e508ce04dcb2b57 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 7 Jul 2018 17:32:06 -0500 Subject: [PATCH 52/84] help.lint.checks: Ignore linux-monitors as not real leaks. Fixes #2014. --- basis/help/lint/checks/checks.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index a10315bb4c..af7880d9b3 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -26,6 +26,7 @@ SYMBOL: vocab-articles "line" ! core-text "layout" ! ui.text.pango "script-string" ! windows.uniscribe + "linux-monitor" ! github issue #2014, race condition in disposing of child monitors } member? ] reject ; From 97097fae2cd4dde7835d2176a10fa3e503d71714 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 8 Jul 2018 22:46:18 -0500 Subject: [PATCH 53/84] system-info: Add computer-name --- basis/system-info/linux/linux.factor | 1 + basis/system-info/macosx/macosx.factor | 2 ++ basis/system-info/system-info.factor | 1 + basis/system-info/windows/windows.factor | 2 +- 4 files changed, 5 insertions(+), 1 deletion(-) diff --git a/basis/system-info/linux/linux.factor b/basis/system-info/linux/linux.factor index 09f2a91bc8..721daa43ac 100644 --- a/basis/system-info/linux/linux.factor +++ b/basis/system-info/linux/linux.factor @@ -26,3 +26,4 @@ M: linux cpus parse-proc-cpuinfo sort-cpus cpu-counts 2drop ; : hyperthreads ( -- n ) parse-proc-cpuinfo sort-cpus cpu-counts 2nip ; M: linux cpu-mhz parse-proc-cpuinfo first cpu-mhz>> 1,000,000 * ; M: linux physical-mem parse-proc-meminfo mem-total>> ; +M: linux computer-name nodename ; \ No newline at end of file diff --git a/basis/system-info/macosx/macosx.factor b/basis/system-info/macosx/macosx.factor index ccdec7877e..1fb1fdb86c 100644 --- a/basis/system-info/macosx/macosx.factor +++ b/basis/system-info/macosx/macosx.factor @@ -101,3 +101,5 @@ M: macosx cpu-mhz ( -- n ) { 6 15 } sysctl-query-uint ; : tb-frequency ( -- n ) { 6 23 } sysctl-query-uint ; M: macosx physical-mem ( -- n ) { 6 24 } sysctl-query-ulonglong ; : available-cpus ( -- n ) { 6 25 } sysctl-query-uint ; + +M: macosx computer-name { 1 10 } sysctl-query-string "." split1 drop ; diff --git a/basis/system-info/system-info.factor b/basis/system-info/system-info.factor index 156d20ed8e..7c2d9bdbe3 100644 --- a/basis/system-info/system-info.factor +++ b/basis/system-info/system-info.factor @@ -15,6 +15,7 @@ HOOK: available-page-file os ( -- n ) HOOK: total-virtual-mem os ( -- n ) HOOK: available-virtual-mem os ( -- n ) HOOK: available-virtual-extended-mem os ( -- n ) +HOOK: computer-name os ( -- string ) : write-unit ( x n str -- ) [ 2^ /f number>string write bl ] [ write ] bi* ; diff --git a/basis/system-info/windows/windows.factor b/basis/system-info/windows/windows.factor index 67fd38211e..1e7bc07d69 100644 --- a/basis/system-info/windows/windows.factor +++ b/basis/system-info/windows/windows.factor @@ -96,7 +96,7 @@ M: windows total-virtual-mem ( -- n ) M: windows available-virtual-mem ( -- n ) memory-status ullAvailVirtual>> ; -: computer-name ( -- string ) +M: windows computer-name ( -- string ) MAX_COMPUTERNAME_LENGTH 1 + [ dup ] keep uint GetComputerName win32-error=0/f alien>native-string ; From 9b97da06580505c1fcccd3378f3d2da4a75f8c2d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 8 Jul 2018 22:57:24 -0500 Subject: [PATCH 54/84] calendar.format: Add a word to format time to a string for convenience. --- basis/calendar/format/format.factor | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index 1c4c685248..853bd32c2c 100644 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays calendar calendar.english combinators io -io.streams.string kernel macros math math.order math.parser -math.parser.private present quotations sequences typed words ; +USING: accessors arrays calendar calendar.english combinators +fry io io.streams.string kernel macros math math.order +math.parser math.parser.private present quotations sequences +typed words ; IN: calendar.format MACRO: formatted ( spec -- quot ) @@ -14,6 +15,9 @@ MACRO: formatted ( spec -- quot ) } cond ] map [ cleave ] curry ; +: formatted>string ( spec -- string ) + '[ _ formatted ] with-string-writer ; inline + : pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ; : pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-head ; From 8a8399e6337434324acd17087e229f9343121062 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 9 Jul 2018 01:33:26 -0500 Subject: [PATCH 55/84] tools.directory-to-file: Add a command-line program to make a directory into a file and restore it. --- basis/tools/directory-to-file/authors.txt | 1 + .../directory-to-file.factor | 40 +++++++++++++++++++ basis/tools/file-to-directory/authors.txt | 1 + .../file-to-directory.factor | 34 ++++++++++++++++ 4 files changed, 76 insertions(+) create mode 100644 basis/tools/directory-to-file/authors.txt create mode 100644 basis/tools/directory-to-file/directory-to-file.factor create mode 100644 basis/tools/file-to-directory/authors.txt create mode 100644 basis/tools/file-to-directory/file-to-directory.factor diff --git a/basis/tools/directory-to-file/authors.txt b/basis/tools/directory-to-file/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/tools/directory-to-file/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/tools/directory-to-file/directory-to-file.factor b/basis/tools/directory-to-file/directory-to-file.factor new file mode 100644 index 0000000000..eab46ddb8a --- /dev/null +++ b/basis/tools/directory-to-file/directory-to-file.factor @@ -0,0 +1,40 @@ +! Copyright (C) 2018 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: assocs base64 command-line escape-strings fry io.backend +io.directories io.directories.search io.encodings.binary +io.encodings.utf8 io.files io.files.info io.pathnames kernel +math namespaces sequences sequences.extras splitting ; +IN: tools.directory-to-file + +: file-is-binary? ( path -- ? ) + binary file-contents [ 127 <= ] all? ; + +: directory-to-string ( path -- string ) + normalize-path + [ path-separator = ] trim-tail "/" append + [ recursive-directory-files [ file-info directory? ] reject ] keep + dup '[ + [ _ ?head drop ] map + [ + dup file-is-binary? [ + utf8 file-contents escape-string + ] [ + binary file-contents >base64 "" like escape-string + "base64" prepend + ] if + ] map-zip + ] with-directory + [ + first2 + [ escape-string "FILE: " prepend ] dip " " glue + ] map "\n\n" join ; + +: directory-to-file ( path -- ) + [ directory-to-string ] keep ".modern" append + utf8 set-file-contents ; + +: directory-to-file-main ( -- ) + command-line get dup length 1 = [ "oops" throw ] unless first + directory-to-file ; + +MAIN: directory-to-file-main diff --git a/basis/tools/file-to-directory/authors.txt b/basis/tools/file-to-directory/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/tools/file-to-directory/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/tools/file-to-directory/file-to-directory.factor b/basis/tools/file-to-directory/file-to-directory.factor new file mode 100644 index 0000000000..ead612c0f9 --- /dev/null +++ b/basis/tools/file-to-directory/file-to-directory.factor @@ -0,0 +1,34 @@ +! Copyright (C) 2018 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: base64 command-line fry io.directories +io.encodings.binary io.encodings.utf8 io.files io.pathnames +kernel modern modern.out namespaces sequences splitting strings ; +IN: tools.file-to-directory + +ERROR: expected-one-path got ; +ERROR: expected-modern-path got ; + +: write-directory-files ( path -- ) + [ ".modern" ?tail drop dup make-directories ] + [ path>literals ] bi + '[ + _ [ + second first2 [ third >string ] dip + + [ third ] [ + first "base64" head? + [ [ >string ] [ base64> ] bi* swap binary ] + [ [ >string ] bi@ swap utf8 ] if + ] bi + [ dup parent-directory make-directories ] dip set-file-contents + ] each + ] with-directory ; + +: get-file-to-directory-path ( array -- path ) + dup length 1 = [ expected-one-path ] unless + first dup ".modern" tail? [ expected-modern-path ] unless ; + +: file-to-directory ( -- ) + command-line get get-file-to-directory-path write-directory-files ; + +MAIN: file-to-directory From e17a352af3c3efbc4cfffcb999e71182cedafce2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 9 Jul 2018 09:10:27 -0500 Subject: [PATCH 56/84] system-info.macosx: Fix using --- basis/system-info/macosx/macosx.factor | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/basis/system-info/macosx/macosx.factor b/basis/system-info/macosx/macosx.factor index 1fb1fdb86c..925d669b47 100644 --- a/basis/system-info/macosx/macosx.factor +++ b/basis/system-info/macosx/macosx.factor @@ -1,12 +1,10 @@ ! Copyright (C) 2008 Doug Coleman, John Benediktsson. ! See http://factorcode.org/license.txt for BSD license. - -USING: alien alien.c-types alien.data alien.strings alien.syntax -arrays assocs byte-arrays combinators core-foundation io.binary -io.encodings.utf8 libc kernel math namespaces sequences -specialized-arrays system system-info unix ; +USING: alien.c-types alien.data alien.strings alien.syntax +arrays assocs byte-arrays core-foundation io.binary +io.encodings.utf8 kernel libc sequences specialized-arrays +splitting system system-info ; SPECIALIZED-ARRAY: int - IN: system-info.macosx Date: Tue, 10 Jul 2018 02:06:54 -0500 Subject: [PATCH 57/84] Revert "gpu: Load all the links for the docs to not error with: ``Help article does not exist name "gpu.textures"``" This reverts commit 76f4678a963a1adb90861fea7cd8bf6dbb8d3db3. This breaks ``"cuda" load`` with circularity. --- extra/gpu/gpu-docs.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/gpu/gpu-docs.factor b/extra/gpu/gpu-docs.factor index 640aa6b1ad..6933ba1979 100644 --- a/extra/gpu/gpu-docs.factor +++ b/extra/gpu/gpu-docs.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2009 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: gpu.private help.markup help.syntax ui.gadgets.worlds -gpu.textures gpu.state gpu.framebuffers gpu.shaders gpu.render ; +USING: gpu.private help.markup help.syntax ui.gadgets.worlds ; IN: gpu HELP: finish-gpu From cb4ca7cca410fcd9c3a76b633f47e5475e442024 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 11 Jul 2018 21:41:46 -0500 Subject: [PATCH 58/84] editors: Add a MAIN-WINDOW: to editors to easily reload editors. --- basis/editors/editors.factor | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index 5efafdbb7e..741357a2a6 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -1,9 +1,11 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs calendar continuations debugger -definitions io io.launcher io.pathnames kernel namespaces +definitions fry io io.launcher io.pathnames kernel namespaces prettyprint sequences source-files.errors splitting strings -threads tools.crossref vocabs vocabs.files vocabs.hierarchy +threads tools.crossref ui ui.gadgets ui.gadgets.borders +ui.gadgets.buttons ui.gadgets.packs ui.gadgets.scrollers +ui.tools.listener vocabs vocabs.files vocabs.hierarchy vocabs.loader vocabs.metadata words ; IN: editors @@ -126,3 +128,13 @@ M: word edit-tests vocabulary>> edit-tests ; : edit-summary ( vocab -- ) dup vocab-summary-path vocab-append-path 1 edit-location ; + +: ( editor -- button ) + dup '[ drop [ _ reload ] \ run call-listener ] ; + +: ( -- gadget ) + { 2 2 } >>gap available-editors + [ add-gadget ] each ; + +MAIN-WINDOW: editor-window { { title "Editors" } } + { 2 2 } >>gadgets ; From cd2b8eee425eb664db23cbf986cd0d1e7f3bd89b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 11 Jul 2018 21:51:26 -0500 Subject: [PATCH 59/84] Revert "editors: Add a MAIN-WINDOW: to editors to easily reload editors." This reverts commit cb4ca7cca410fcd9c3a76b633f47e5475e442024. --- basis/editors/editors.factor | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index 741357a2a6..5efafdbb7e 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -1,11 +1,9 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs calendar continuations debugger -definitions fry io io.launcher io.pathnames kernel namespaces +definitions io io.launcher io.pathnames kernel namespaces prettyprint sequences source-files.errors splitting strings -threads tools.crossref ui ui.gadgets ui.gadgets.borders -ui.gadgets.buttons ui.gadgets.packs ui.gadgets.scrollers -ui.tools.listener vocabs vocabs.files vocabs.hierarchy +threads tools.crossref vocabs vocabs.files vocabs.hierarchy vocabs.loader vocabs.metadata words ; IN: editors @@ -128,13 +126,3 @@ M: word edit-tests vocabulary>> edit-tests ; : edit-summary ( vocab -- ) dup vocab-summary-path vocab-append-path 1 edit-location ; - -: ( editor -- button ) - dup '[ drop [ _ reload ] \ run call-listener ] ; - -: ( -- gadget ) - { 2 2 } >>gap available-editors - [ add-gadget ] each ; - -MAIN-WINDOW: editor-window { { title "Editors" } } - { 2 2 } >>gadgets ; From b21f9ed3eb27abe57d730bd214871dfcbbd20db9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 11 Jul 2018 21:52:17 -0500 Subject: [PATCH 60/84] editors.ui: Make the editors ui its own thing. --- basis/editors/ui/ui.factor | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 basis/editors/ui/ui.factor diff --git a/basis/editors/ui/ui.factor b/basis/editors/ui/ui.factor new file mode 100644 index 0000000000..b69a17991b --- /dev/null +++ b/basis/editors/ui/ui.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2018 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors editors fry kernel sequences ui ui.gadgets +ui.gadgets.borders ui.gadgets.buttons ui.gadgets.packs +ui.gadgets.scrollers ui.tools.listener vocabs.loader ; +IN: editors.ui + +: ( editor -- button ) + dup '[ drop [ _ reload ] \ run call-listener ] ; + +: ( -- gadget ) + { 2 2 } >>gap available-editors + [ add-gadget ] each ; + +MAIN-WINDOW: editor-window { { title "Editors" } } + { 2 2 } >>gadgets ; From 7298918029d54814f8d7ca4dbde380634c16de91 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Wed, 11 Jul 2018 16:58:08 +0700 Subject: [PATCH 61/84] windows.registry: add change-registry-value and delete-value --- basis/windows/advapi32/advapi32.factor | 9 +++- basis/windows/registry/authors.txt | 1 + basis/windows/registry/registry-tests.factor | 22 ++++++++- basis/windows/registry/registry.factor | 48 ++++++++++++++++---- 4 files changed, 69 insertions(+), 11 deletions(-) diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor index 7f3e878005..0981c55524 100755 --- a/basis/windows/advapi32/advapi32.factor +++ b/basis/windows/advapi32/advapi32.factor @@ -1317,7 +1317,14 @@ FUNCTION: LONG RegDeleteKeyExW ( ALIAS: RegDeleteKeyEx RegDeleteKeyExW ! : RegDeleteValueA ; -! : RegDeleteValueW ; + +FUNCTION: LONG RegDeleteValueW ( + HKEY hKey, + LPCWSTR lpValueName + ) + +ALIAS: RegDeleteValue RegDeleteValueW + ! : RegDisablePredefinedCache ; ! : RegEnumKeyA ; ! : RegEnumKeyExA ; diff --git a/basis/windows/registry/authors.txt b/basis/windows/registry/authors.txt index 7c1b2f2279..d652f68ac8 100644 --- a/basis/windows/registry/authors.txt +++ b/basis/windows/registry/authors.txt @@ -1 +1,2 @@ Doug Coleman +Alexander Ilin diff --git a/basis/windows/registry/registry-tests.factor b/basis/windows/registry/registry-tests.factor index 17662bf75a..839f2eecd3 100644 --- a/basis/windows/registry/registry-tests.factor +++ b/basis/windows/registry/registry-tests.factor @@ -1,7 +1,27 @@ ! Copyright (C) 2010 Doug Coleman. +! Copyright (C) 2018 Alexander Ilin. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel tools.test windows.advapi32 windows.registry ; +USING: byte-arrays io.encodings.string io.encodings.utf16n +kernel sequences tools.test windows.advapi32 windows.kernel32 +windows.registry ; IN: windows.registry.tests [ ] [ HKEY_CURRENT_USER "SOFTWARE\\\\Microsoft" read-registry drop ] unit-test + +[ t ] +[ + HKEY_CURRENT_USER "Environment" KEY_SET_VALUE [ + "factor-test" "value" utf16n encode dup length set-reg-sz + ] with-open-registry-key + HKEY_CURRENT_USER "Environment" "factor-test" [ + "test-string" ";" glue + ] change-registry-value + HKEY_CURRENT_USER "Environment" KEY_QUERY_VALUE [ + "factor-test" f f MAX_PATH reg-query-value-ex + utf16n decode "value;test-string\0" = + ] with-open-registry-key + HKEY_CURRENT_USER "Environment" KEY_SET_VALUE [ + "factor-test" delete-value + ] with-open-registry-key +] unit-test diff --git a/basis/windows/registry/registry.factor b/basis/windows/registry/registry.factor index 465d617a3d..03d2228abf 100644 --- a/basis/windows/registry/registry.factor +++ b/basis/windows/registry/registry.factor @@ -1,9 +1,11 @@ ! Copyright (C) 2010 Doug Coleman. +! Copyright (C) 2018 Alexander Ilin. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types byte-arrays kernel locals sequences -windows.advapi32 windows.errors math windows -windows.kernel32 windows.time accessors alien.data -windows.types classes.struct continuations ; +USING: accessors alien.c-types alien.data byte-arrays +classes.struct continuations io.encodings.string +io.encodings.utf16n kernel literals locals math sequences sets +splitting windows windows.advapi32 windows.errors +windows.kernel32 windows.time windows.types ; IN: windows.registry ERROR: open-key-failed key subkey mode error-string ; @@ -66,22 +68,31 @@ CONSTANT: registry-value-max-length 16384 : grow-buffer ( byte-array -- byte-array' ) length 2 * ; -:: reg-query-value-ex ( key subkey ptr1 ptr2 buffer -- buffer ) +PRIVATE> + +:: reg-query-value-ex ( key value-name ptr1 lpType buffer -- buffer ) buffer length uint :> pdword - key subkey ptr1 ptr2 buffer pdword [ RegQueryValueEx ] 2keep + key value-name ptr1 lpType buffer pdword [ RegQueryValueEx ] 2keep rot :> ret ret ERROR_SUCCESS = [ uint deref head ] [ ret ERROR_MORE_DATA = [ 2drop - key subkey ptr1 ptr2 buffer + key value-name ptr1 lpType buffer grow-buffer reg-query-value-ex ] [ ret n>win32-error-string throw ] if ] if ; +: delete-value ( key value-name -- ) + RegDeleteValue dup ERROR_SUCCESS = [ + drop + ] [ + n>win32-error-string throw + ] if ; + TUPLE: registry-info key class-name @@ -184,11 +195,30 @@ TUPLE: registry-enum-key ; : set-reg-sz ( hkey value lpdata cbdata -- ) [ REG_SZ ] 2dip set-reg-key ; -PRIVATE> - : windows-performance-data ( -- byte-array ) HKEY_PERFORMANCE_DATA "Global" f f 21 2^ reg-query-value-ex ; : read-registry ( key subkey -- registry-info ) KEY_READ [ reg-query-info-key ] with-open-registry-key ; + +:: change-registry-value ( key subkey value-name quot: ( value -- value' ) -- ) + 0 DWORD :> type + key subkey KEY_QUERY_VALUE KEY_SET_VALUE bitor [ + dup :> hkey value-name f type MAX_PATH + reg-query-value-ex + type DWORD deref ${ REG_SZ REG_EXPAND_SZ REG_MULTI_SZ } in? + dup :> string-type? [ + utf16n decode type DWORD deref REG_MULTI_SZ = [ + "\0" split 2 + ] [ 1 ] if head* + ] when + quot call( x -- x' ) + string-type? [ + type DWORD deref REG_MULTI_SZ = [ + "\0" join 2 + ] [ 1 ] if [ CHAR: \0 suffix ] times utf16n encode + ] when + [ hkey value-name type DWORD deref ] dip dup length + set-reg-key + ] with-open-registry-key ; From 0939974c65d6e4da0cd12b63b7b0cedfc3cbeaf3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 12 Jul 2018 23:59:02 -0500 Subject: [PATCH 62/84] contexts.cpp: Don't warn on unused variables. --- vm/contexts.cpp | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/vm/contexts.cpp b/vm/contexts.cpp index d0e528722e..48afadaa27 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -38,6 +38,10 @@ void context::fill_stack_seg(cell top_ptr, segment* seg, cell pattern) { cell clear_start = top_ptr + sizeof(cell); cell clear_size = seg->end - clear_start; memset_cell((void*)clear_start, pattern, clear_size); +#else + (void)top_ptr; + (void)seg; + (void)pattern; #endif } From 2a409c79e0f591d30f08314ba6abb993dd17c922 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 13 Jul 2018 00:48:58 -0500 Subject: [PATCH 63/84] vm: Fix unused variable warnings on Windows. --- vm/callstack.cpp | 2 ++ vm/code_blocks.hpp | 2 +- vm/code_heap.cpp | 6 ++++++ vm/compaction.cpp | 4 ++++ vm/cpu-x86.hpp | 2 +- vm/debug.cpp | 1 + vm/free_list.hpp | 2 +- vm/image.cpp | 2 ++ vm/main-windows.cpp | 4 ++++ vm/objects.cpp | 1 + vm/os-windows.cpp | 6 ++++-- vm/sampling_profiler.cpp | 3 +++ vm/slot_visitor.hpp | 5 ++++- 13 files changed, 34 insertions(+), 6 deletions(-) diff --git a/vm/callstack.cpp b/vm/callstack.cpp index bd0d6c67cc..2d183e8028 100644 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -56,6 +56,8 @@ void factor_vm::primitive_callstack_to_array() { cell size, code_block* owner, cell addr) { + (void)frame_top; + (void)size; data_root executing_quot(owner->owner_quot(), this); data_root executing(owner->owner, this); data_root scan(owner->scan(this, addr), this); diff --git a/vm/code_blocks.hpp b/vm/code_blocks.hpp index 09b0dc4a47..baa0faa6c9 100644 --- a/vm/code_blocks.hpp +++ b/vm/code_blocks.hpp @@ -62,7 +62,7 @@ struct code_block { header = (header & 0xFFFFFF) | (frame_size << 20); } - template cell size(Fixup fixup) const { return size(); } + template cell size(Fixup fixup) const { (void)fixup; return size(); } cell entry_point() const { return (cell)(this + 1); } diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 23a28c07f3..ad507c2e78 100644 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -71,6 +71,8 @@ void code_heap::sweep() { void code_heap::verify_all_blocks_set() { auto all_blocks_set_verifier = [&](code_block* block, cell size) { + (void)block; + (void)size; FACTOR_ASSERT(all_blocks.find((cell)block) != all_blocks.end()); }; allocator->iterate(all_blocks_set_verifier, no_fixup()); @@ -102,6 +104,7 @@ cell code_heap::frame_predecessor(cell frame_top) { void code_heap::initialize_all_blocks_set() { all_blocks.clear(); auto all_blocks_set_inserter = [&](code_block* block, cell size) { + (void)size; all_blocks.insert((cell)block); }; allocator->iterate(all_blocks_set_inserter, no_fixup()); @@ -115,6 +118,7 @@ void code_heap::initialize_all_blocks_set() { // If generic words were redefined, inline caches need to be reset. void factor_vm::update_code_heap_words(bool reset_inline_caches) { auto word_updater = [&](code_block* block, cell size) { + (void)size; update_word_references(block, reset_inline_caches); }; each_code_block(word_updater); @@ -182,6 +186,7 @@ void factor_vm::primitive_code_room() { void factor_vm::primitive_strip_stack_traces() { auto stack_trace_stripper = [](code_block* block, cell size) { + (void)size; block->owner = false_object; }; each_code_block(stack_trace_stripper); @@ -191,6 +196,7 @@ void factor_vm::primitive_strip_stack_traces() { void factor_vm::primitive_code_blocks() { std::vector objects; auto code_block_accumulator = [&](code_block* block, cell size) { + (void)size; objects.push_back(block->owner); objects.push_back(block->parameters); objects.push_back(block->relocation); diff --git a/vm/compaction.cpp b/vm/compaction.cpp index 027be093bd..7a2aed6172 100644 --- a/vm/compaction.cpp +++ b/vm/compaction.cpp @@ -109,6 +109,8 @@ void factor_vm::collect_compact_impl() { // Slide everything in tenured space up, and update data and code heap // pointers inside objects. auto compact_object_func = [&](object* old_addr, object* new_addr, cell size) { + (void)old_addr; + (void)size; forwarder.visit_slots(new_addr); forwarder.visit_object_code_block(new_addr); tenured->starts.record_object_start_offset(new_addr); @@ -120,6 +122,7 @@ void factor_vm::collect_compact_impl() { auto compact_code_func = [&](code_block* old_addr, code_block* new_addr, cell size) { + (void)size; forwarder.visit_code_block_objects(new_addr); cell old_entry_point = old_addr->entry_point(); forwarder.visit_instruction_operands(new_addr, old_entry_point); @@ -136,6 +139,7 @@ void factor_vm::collect_compact_impl() { // the code heap. Since the code heap has now been compacted, those // pointers are invalid and we need to update them. auto callback_updater = [&](code_block* stub, cell size) { + (void)size; callbacks->update(stub); }; callbacks->allocator->iterate(callback_updater, no_fixup()); diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp index e077bf0cd7..a0d83b5d78 100644 --- a/vm/cpu-x86.hpp +++ b/vm/cpu-x86.hpp @@ -3,7 +3,7 @@ namespace factor { #define CALLSTACK_BOTTOM(ctx) \ (ctx->callstack_seg->end - sizeof(cell) * 5) -inline static void flush_icache(cell start, cell len) {} +inline static void flush_icache(cell start, cell len) { (void)start; (void)len; } // In the instruction sequence: diff --git a/vm/debug.cpp b/vm/debug.cpp index 7552fd4e79..da02aa5fad 100644 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -62,6 +62,7 @@ void factor_vm::print_alien(ostream& out, alien* alien, cell nesting) { } void factor_vm::print_byte_array(ostream& out, byte_array* array, cell nesting) { + (void)nesting; cell length = array->capacity; cell i; bool trimmed; diff --git a/vm/free_list.hpp b/vm/free_list.hpp index d19dea5b15..a996ee834a 100644 --- a/vm/free_list.hpp +++ b/vm/free_list.hpp @@ -263,7 +263,7 @@ void free_list_allocator::sweep(Iterator& iter) { } template void free_list_allocator::sweep() { - auto null_sweep = [](Block* free_block, cell size) { }; + auto null_sweep = [](Block* free_block, cell size) { (void)free_block; (void)size; }; sweep(null_sweep); } diff --git a/vm/image.cpp b/vm/image.cpp index 55bac23afa..f29ca779a3 100644 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -177,6 +177,7 @@ void factor_vm::fixup_heaps(cell data_offset, cell code_offset) { visitor.visit_all_roots(); auto start_object_updater = [&](object *obj, cell size) { + (void)size; data->tenured->starts.record_object_start_offset(obj); visitor.visit_slots(obj); switch (obj->type()) { @@ -201,6 +202,7 @@ void factor_vm::fixup_heaps(cell data_offset, cell code_offset) { data->tenured->iterate(start_object_updater, fixup); auto updater = [&](code_block* compiled, cell size) { + (void)size; visitor.visit_code_block_objects(compiled); cell rel_base = compiled->entry_point() - fixup.code_offset; visitor.visit_instruction_operands(compiled, rel_base); diff --git a/vm/main-windows.cpp b/vm/main-windows.cpp index e0a1d0ae5f..4d6eddedd8 100644 --- a/vm/main-windows.cpp +++ b/vm/main-windows.cpp @@ -16,6 +16,10 @@ VM_C_API int wmain(int argc, wchar_t** argv) { int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow) { + (void)hInstance; + (void)hPrevInstance; + (void)lpCmdLine; + (void)nCmdShow; int argc; wchar_t** argv = CommandLineToArgvW(GetCommandLine(), &argc); wmain(argc, argv); diff --git a/vm/objects.cpp b/vm/objects.cpp index 1f821cbe39..bc85899465 100644 --- a/vm/objects.cpp +++ b/vm/objects.cpp @@ -111,6 +111,7 @@ void factor_vm::primitive_become() { each_object(object_become_func); auto code_block_become_func = [&](code_block* compiled, cell size) { + (void)size; visitor.visit_code_block_objects(compiled); visitor.visit_embedded_literals(compiled); code->write_barrier(compiled); diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index 08651a1bd5..d5ecad1d09 100644 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -194,6 +194,8 @@ typedef enum _EXCEPTION_DISPOSITION { LONG factor_vm::exception_handler(PEXCEPTION_RECORD e, void* frame, PCONTEXT c, void* dispatch) { + (void)frame; + (void)dispatch; switch (e->ExceptionCode) { case EXCEPTION_ACCESS_VIOLATION: set_memory_protection_error(e->ExceptionInformation[1], c->EIP); @@ -242,7 +244,7 @@ VM_C_API LONG exception_handler(PEXCEPTION_RECORD e, void* frame, PCONTEXT c, // On Unix SIGINT (ctrl-c) automatically interrupts blocking io system // calls. It doesn't on Windows, so we need to manually send some // cancellation requests to unblock the thread. -VOID CALLBACK dummy_cb (ULONG_PTR dwParam) { } +VOID CALLBACK dummy_cb(ULONG_PTR dwParam) { (void)dwParam; } // CancelSynchronousIo is not in Windows XP #if _WIN32_WINNT >= 0x0600 @@ -261,7 +263,7 @@ static void wake_up_thread(HANDLE thread) { } } #else -static void wake_up_thread(HANDLE thread) {} +static void wake_up_thread(HANDLE thread) { (void)thread; } #endif static BOOL WINAPI ctrl_handler(DWORD dwCtrlType) { diff --git a/vm/sampling_profiler.cpp b/vm/sampling_profiler.cpp index 30680b73f0..4a36ccb7c1 100644 --- a/vm/sampling_profiler.cpp +++ b/vm/sampling_profiler.cpp @@ -73,6 +73,9 @@ void factor_vm::record_sample(bool prolog_p) { bool skip_p = prolog_p; auto recorder = [&](cell frame_top, cell size, code_block* owner, cell addr) { + (void)frame_top; + (void)size; + (void)addr; if (skip_p) skip_p = false; else { diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp index 1d6b9255c7..79bc3eb367 100644 --- a/vm/slot_visitor.hpp +++ b/vm/slot_visitor.hpp @@ -206,6 +206,7 @@ template void slot_visitor::visit_all_roots() { } auto callback_slot_visitor = [&](code_block* stub, cell size) { + (void)size; visit_handle(&stub->owner); }; parent->callbacks->allocator->iterate(callback_slot_visitor, no_fixup()); @@ -245,6 +246,7 @@ template struct call_frame_slot_visitor { // [size] void operator()(cell frame_top, cell size, code_block* owner, cell addr) { + (void)size; cell return_address = owner->offset(addr); code_block* compiled = @@ -359,7 +361,8 @@ template struct call_frame_code_block_visitor { call_frame_code_block_visitor(Fixup fixup) : fixup(fixup) {} void operator()(cell frame_top, cell size, code_block* owner, cell addr) { - code_block* compiled = + (void)size; + code_block* compiled = Fixup::translated_code_block_map ? owner : fixup.fixup_code(owner); cell fixed_addr = compiled->address_for_offset(owner->offset(addr)); From 4b614cc15b84afbb00b5cf4d4438dd619b57dbe2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 9 Jul 2018 01:58:04 -0500 Subject: [PATCH 64/84] factor: Make source files/resources 644 instead of 755. --- basis/alien/libraries/libraries-tests.factor | 0 basis/alien/libraries/libraries.factor | 0 basis/alien/parser/parser.factor | 0 basis/alien/syntax/syntax.factor | 0 basis/bootstrap/image/image.factor | 0 basis/cache/cache-tests.factor | 0 basis/cache/cache.factor | 0 basis/compiler/codegen/codegen.factor | 0 basis/compiler/tests/alien.factor | 0 basis/compression/lzw/lzw.factor | 0 basis/concurrency/count-downs/count-downs.factor | 0 .../concurrency/mailboxes/debugger/debugger.factor | 0 basis/concurrency/mailboxes/mailboxes.factor | 0 basis/cpu/x86/32/32.factor | 0 basis/debugger/debugger.factor | 0 basis/formatting/formatting-docs.factor | 0 basis/formatting/formatting-tests.factor | 0 basis/game/input/dinput/dinput.factor | 0 basis/globs/globs-tests.factor | 0 .../gobject-introspection.factor | 0 basis/io/backend/unix/unix.factor | 0 basis/io/backend/windows/windows.factor | 0 basis/io/files/info/windows/windows.factor | 0 basis/io/files/windows/windows.factor | 0 basis/io/launcher/launcher.factor | 0 basis/io/launcher/windows/windows.factor | 0 basis/io/monitors/linux/linux.factor | 0 basis/io/monitors/recursive/recursive.factor | 0 basis/io/servers/servers.factor | 0 basis/io/sockets/windows/windows.factor | 0 basis/math/floats/env/env-tests.factor | 0 basis/math/floats/env/x86/x86-tests.factor | 0 basis/random/windows/windows.factor | 0 basis/tools/deploy/deploy-docs.factor | 0 basis/tools/deploy/shaker/shaker.factor | 0 basis/tools/deploy/windows/ico/ico.factor | 0 basis/tools/deploy/windows/windows.factor | 0 basis/ui/backend/windows/windows.factor | 0 basis/windows/advapi32/advapi32.factor | 0 basis/windows/com/syntax/syntax.factor | 0 basis/windows/ddk/hid/hid.factor | 0 basis/windows/ddk/setupapi/setupapi.factor | 0 basis/windows/ddk/winusb/winusb.factor | 0 .../directx/dinput/constants/constants.factor | 0 basis/windows/directx/dwrite/dwrite.factor | 0 basis/windows/directx/dxfile/dxfile.factor | 0 basis/windows/directx/xinput/xinput.factor | 0 basis/windows/dwmapi/dwmapi.factor | 0 basis/windows/errors/errors.factor | 0 basis/windows/uniscribe/uniscribe.factor | 0 core/alien/alien.factor | 0 core/bootstrap/primitives.factor | 0 core/destructors/destructors.factor | 0 core/vocabs/loader/loader-docs.factor | 0 extra/alien/fortran/fortran.factor | 0 extra/game/loop/loop.factor | 0 extra/gdbm/ffi/ffi.factor | 0 extra/gpu/gpu.factor | 0 extra/gpu/render/render.factor | 0 extra/gpu/shaders/shaders.factor | 0 extra/gpu/state/state.factor | 0 extra/images/ppm/ppm.factor | 0 extra/images/testing/tiff/rgb.tiff | Bin extra/images/tiff/tiff.factor | 0 extra/mason/mason.factor | 0 extra/morse/morse.factor | 0 extra/openal/alut/alut.factor | 0 extra/openal/alut/backend/backend.factor | 0 extra/openal/alut/macosx/macosx.factor | 0 extra/openal/alut/other/other.factor | 0 extra/openal/example/example.factor | 0 extra/openal/openal.factor | 0 extra/roms/space-invaders/space-invaders.factor | 0 extra/rosetta-code/metronome/metronome.factor | 0 extra/slots/syntax/syntax-docs.factor | 0 extra/slots/syntax/syntax-tests.factor | 0 extra/slots/syntax/syntax.factor | 0 extra/snake-game/_resources/background.png | Bin extra/snake-game/_resources/body.png | Bin extra/snake-game/_resources/food.png | Bin extra/snake-game/_resources/head.png | Bin extra/snake-game/_resources/tail.png | Bin extra/synth/example/example.factor | 0 extra/synth/synth.factor | 0 extra/windows/fullscreen/fullscreen.factor | 0 85 files changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 basis/alien/libraries/libraries-tests.factor mode change 100755 => 100644 basis/alien/libraries/libraries.factor mode change 100755 => 100644 basis/alien/parser/parser.factor mode change 100755 => 100644 basis/alien/syntax/syntax.factor mode change 100755 => 100644 basis/bootstrap/image/image.factor mode change 100755 => 100644 basis/cache/cache-tests.factor mode change 100755 => 100644 basis/cache/cache.factor mode change 100755 => 100644 basis/compiler/codegen/codegen.factor mode change 100755 => 100644 basis/compiler/tests/alien.factor mode change 100755 => 100644 basis/compression/lzw/lzw.factor mode change 100755 => 100644 basis/concurrency/count-downs/count-downs.factor mode change 100755 => 100644 basis/concurrency/mailboxes/debugger/debugger.factor mode change 100755 => 100644 basis/concurrency/mailboxes/mailboxes.factor mode change 100755 => 100644 basis/cpu/x86/32/32.factor mode change 100755 => 100644 basis/debugger/debugger.factor mode change 100755 => 100644 basis/formatting/formatting-docs.factor mode change 100755 => 100644 basis/formatting/formatting-tests.factor mode change 100755 => 100644 basis/game/input/dinput/dinput.factor mode change 100755 => 100644 basis/globs/globs-tests.factor mode change 100755 => 100644 basis/gobject-introspection/gobject-introspection.factor mode change 100755 => 100644 basis/io/backend/unix/unix.factor mode change 100755 => 100644 basis/io/backend/windows/windows.factor mode change 100755 => 100644 basis/io/files/info/windows/windows.factor mode change 100755 => 100644 basis/io/files/windows/windows.factor mode change 100755 => 100644 basis/io/launcher/launcher.factor mode change 100755 => 100644 basis/io/launcher/windows/windows.factor mode change 100755 => 100644 basis/io/monitors/linux/linux.factor mode change 100755 => 100644 basis/io/monitors/recursive/recursive.factor mode change 100755 => 100644 basis/io/servers/servers.factor mode change 100755 => 100644 basis/io/sockets/windows/windows.factor mode change 100755 => 100644 basis/math/floats/env/env-tests.factor mode change 100755 => 100644 basis/math/floats/env/x86/x86-tests.factor mode change 100755 => 100644 basis/random/windows/windows.factor mode change 100755 => 100644 basis/tools/deploy/deploy-docs.factor mode change 100755 => 100644 basis/tools/deploy/shaker/shaker.factor mode change 100755 => 100644 basis/tools/deploy/windows/ico/ico.factor mode change 100755 => 100644 basis/tools/deploy/windows/windows.factor mode change 100755 => 100644 basis/ui/backend/windows/windows.factor mode change 100755 => 100644 basis/windows/advapi32/advapi32.factor mode change 100755 => 100644 basis/windows/com/syntax/syntax.factor mode change 100755 => 100644 basis/windows/ddk/hid/hid.factor mode change 100755 => 100644 basis/windows/ddk/setupapi/setupapi.factor mode change 100755 => 100644 basis/windows/ddk/winusb/winusb.factor mode change 100755 => 100644 basis/windows/directx/dinput/constants/constants.factor mode change 100755 => 100644 basis/windows/directx/dwrite/dwrite.factor mode change 100755 => 100644 basis/windows/directx/dxfile/dxfile.factor mode change 100755 => 100644 basis/windows/directx/xinput/xinput.factor mode change 100755 => 100644 basis/windows/dwmapi/dwmapi.factor mode change 100755 => 100644 basis/windows/errors/errors.factor mode change 100755 => 100644 basis/windows/uniscribe/uniscribe.factor mode change 100755 => 100644 core/alien/alien.factor mode change 100755 => 100644 core/bootstrap/primitives.factor mode change 100755 => 100644 core/destructors/destructors.factor mode change 100755 => 100644 core/vocabs/loader/loader-docs.factor mode change 100755 => 100644 extra/alien/fortran/fortran.factor mode change 100755 => 100644 extra/game/loop/loop.factor mode change 100755 => 100644 extra/gdbm/ffi/ffi.factor mode change 100755 => 100644 extra/gpu/gpu.factor mode change 100755 => 100644 extra/gpu/render/render.factor mode change 100755 => 100644 extra/gpu/shaders/shaders.factor mode change 100755 => 100644 extra/gpu/state/state.factor mode change 100755 => 100644 extra/images/ppm/ppm.factor mode change 100755 => 100644 extra/images/testing/tiff/rgb.tiff mode change 100755 => 100644 extra/images/tiff/tiff.factor mode change 100755 => 100644 extra/mason/mason.factor mode change 100755 => 100644 extra/morse/morse.factor mode change 100755 => 100644 extra/openal/alut/alut.factor mode change 100755 => 100644 extra/openal/alut/backend/backend.factor mode change 100755 => 100644 extra/openal/alut/macosx/macosx.factor mode change 100755 => 100644 extra/openal/alut/other/other.factor mode change 100755 => 100644 extra/openal/example/example.factor mode change 100755 => 100644 extra/openal/openal.factor mode change 100755 => 100644 extra/roms/space-invaders/space-invaders.factor mode change 100755 => 100644 extra/rosetta-code/metronome/metronome.factor mode change 100755 => 100644 extra/slots/syntax/syntax-docs.factor mode change 100755 => 100644 extra/slots/syntax/syntax-tests.factor mode change 100755 => 100644 extra/slots/syntax/syntax.factor mode change 100755 => 100644 extra/snake-game/_resources/background.png mode change 100755 => 100644 extra/snake-game/_resources/body.png mode change 100755 => 100644 extra/snake-game/_resources/food.png mode change 100755 => 100644 extra/snake-game/_resources/head.png mode change 100755 => 100644 extra/snake-game/_resources/tail.png mode change 100755 => 100644 extra/synth/example/example.factor mode change 100755 => 100644 extra/synth/synth.factor mode change 100755 => 100644 extra/windows/fullscreen/fullscreen.factor diff --git a/basis/alien/libraries/libraries-tests.factor b/basis/alien/libraries/libraries-tests.factor old mode 100755 new mode 100644 diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor old mode 100755 new mode 100644 diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor old mode 100755 new mode 100644 diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor old mode 100755 new mode 100644 diff --git a/basis/cache/cache-tests.factor b/basis/cache/cache-tests.factor old mode 100755 new mode 100644 diff --git a/basis/cache/cache.factor b/basis/cache/cache.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor old mode 100755 new mode 100644 diff --git a/basis/compression/lzw/lzw.factor b/basis/compression/lzw/lzw.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/count-downs/count-downs.factor b/basis/concurrency/count-downs/count-downs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/mailboxes/debugger/debugger.factor b/basis/concurrency/mailboxes/debugger/debugger.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor old mode 100755 new mode 100644 diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor old mode 100755 new mode 100644 diff --git a/basis/formatting/formatting-docs.factor b/basis/formatting/formatting-docs.factor old mode 100755 new mode 100644 diff --git a/basis/formatting/formatting-tests.factor b/basis/formatting/formatting-tests.factor old mode 100755 new mode 100644 diff --git a/basis/game/input/dinput/dinput.factor b/basis/game/input/dinput/dinput.factor old mode 100755 new mode 100644 diff --git a/basis/globs/globs-tests.factor b/basis/globs/globs-tests.factor old mode 100755 new mode 100644 diff --git a/basis/gobject-introspection/gobject-introspection.factor b/basis/gobject-introspection/gobject-introspection.factor old mode 100755 new mode 100644 diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor old mode 100755 new mode 100644 diff --git a/basis/io/backend/windows/windows.factor b/basis/io/backend/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor old mode 100755 new mode 100644 diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/io/monitors/linux/linux.factor b/basis/io/monitors/linux/linux.factor old mode 100755 new mode 100644 diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor old mode 100755 new mode 100644 diff --git a/basis/io/servers/servers.factor b/basis/io/servers/servers.factor old mode 100755 new mode 100644 diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/math/floats/env/env-tests.factor b/basis/math/floats/env/env-tests.factor old mode 100755 new mode 100644 diff --git a/basis/math/floats/env/x86/x86-tests.factor b/basis/math/floats/env/x86/x86-tests.factor old mode 100755 new mode 100644 diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/deploy-docs.factor b/basis/tools/deploy/deploy-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/windows/ico/ico.factor b/basis/tools/deploy/windows/ico/ico.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor old mode 100755 new mode 100644 diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor old mode 100755 new mode 100644 diff --git a/basis/windows/ddk/hid/hid.factor b/basis/windows/ddk/hid/hid.factor old mode 100755 new mode 100644 diff --git a/basis/windows/ddk/setupapi/setupapi.factor b/basis/windows/ddk/setupapi/setupapi.factor old mode 100755 new mode 100644 diff --git a/basis/windows/ddk/winusb/winusb.factor b/basis/windows/ddk/winusb/winusb.factor old mode 100755 new mode 100644 diff --git a/basis/windows/directx/dinput/constants/constants.factor b/basis/windows/directx/dinput/constants/constants.factor old mode 100755 new mode 100644 diff --git a/basis/windows/directx/dwrite/dwrite.factor b/basis/windows/directx/dwrite/dwrite.factor old mode 100755 new mode 100644 diff --git a/basis/windows/directx/dxfile/dxfile.factor b/basis/windows/directx/dxfile/dxfile.factor old mode 100755 new mode 100644 diff --git a/basis/windows/directx/xinput/xinput.factor b/basis/windows/directx/xinput/xinput.factor old mode 100755 new mode 100644 diff --git a/basis/windows/dwmapi/dwmapi.factor b/basis/windows/dwmapi/dwmapi.factor old mode 100755 new mode 100644 diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor old mode 100755 new mode 100644 diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor old mode 100755 new mode 100644 diff --git a/core/alien/alien.factor b/core/alien/alien.factor old mode 100755 new mode 100644 diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor old mode 100755 new mode 100644 diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor old mode 100755 new mode 100644 diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor old mode 100755 new mode 100644 diff --git a/extra/alien/fortran/fortran.factor b/extra/alien/fortran/fortran.factor old mode 100755 new mode 100644 diff --git a/extra/game/loop/loop.factor b/extra/game/loop/loop.factor old mode 100755 new mode 100644 diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor old mode 100755 new mode 100644 diff --git a/extra/gpu/gpu.factor b/extra/gpu/gpu.factor old mode 100755 new mode 100644 diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor old mode 100755 new mode 100644 diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor old mode 100755 new mode 100644 diff --git a/extra/gpu/state/state.factor b/extra/gpu/state/state.factor old mode 100755 new mode 100644 diff --git a/extra/images/ppm/ppm.factor b/extra/images/ppm/ppm.factor old mode 100755 new mode 100644 diff --git a/extra/images/testing/tiff/rgb.tiff b/extra/images/testing/tiff/rgb.tiff old mode 100755 new mode 100644 diff --git a/extra/images/tiff/tiff.factor b/extra/images/tiff/tiff.factor old mode 100755 new mode 100644 diff --git a/extra/mason/mason.factor b/extra/mason/mason.factor old mode 100755 new mode 100644 diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor old mode 100755 new mode 100644 diff --git a/extra/openal/alut/alut.factor b/extra/openal/alut/alut.factor old mode 100755 new mode 100644 diff --git a/extra/openal/alut/backend/backend.factor b/extra/openal/alut/backend/backend.factor old mode 100755 new mode 100644 diff --git a/extra/openal/alut/macosx/macosx.factor b/extra/openal/alut/macosx/macosx.factor old mode 100755 new mode 100644 diff --git a/extra/openal/alut/other/other.factor b/extra/openal/alut/other/other.factor old mode 100755 new mode 100644 diff --git a/extra/openal/example/example.factor b/extra/openal/example/example.factor old mode 100755 new mode 100644 diff --git a/extra/openal/openal.factor b/extra/openal/openal.factor old mode 100755 new mode 100644 diff --git a/extra/roms/space-invaders/space-invaders.factor b/extra/roms/space-invaders/space-invaders.factor old mode 100755 new mode 100644 diff --git a/extra/rosetta-code/metronome/metronome.factor b/extra/rosetta-code/metronome/metronome.factor old mode 100755 new mode 100644 diff --git a/extra/slots/syntax/syntax-docs.factor b/extra/slots/syntax/syntax-docs.factor old mode 100755 new mode 100644 diff --git a/extra/slots/syntax/syntax-tests.factor b/extra/slots/syntax/syntax-tests.factor old mode 100755 new mode 100644 diff --git a/extra/slots/syntax/syntax.factor b/extra/slots/syntax/syntax.factor old mode 100755 new mode 100644 diff --git a/extra/snake-game/_resources/background.png b/extra/snake-game/_resources/background.png old mode 100755 new mode 100644 diff --git a/extra/snake-game/_resources/body.png b/extra/snake-game/_resources/body.png old mode 100755 new mode 100644 diff --git a/extra/snake-game/_resources/food.png b/extra/snake-game/_resources/food.png old mode 100755 new mode 100644 diff --git a/extra/snake-game/_resources/head.png b/extra/snake-game/_resources/head.png old mode 100755 new mode 100644 diff --git a/extra/snake-game/_resources/tail.png b/extra/snake-game/_resources/tail.png old mode 100755 new mode 100644 diff --git a/extra/synth/example/example.factor b/extra/synth/example/example.factor old mode 100755 new mode 100644 diff --git a/extra/synth/synth.factor b/extra/synth/synth.factor old mode 100755 new mode 100644 diff --git a/extra/windows/fullscreen/fullscreen.factor b/extra/windows/fullscreen/fullscreen.factor old mode 100755 new mode 100644 From ae74a794e1ef8e76a1fbf6fe07b649662dc17874 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 13 Jul 2018 20:36:07 -0500 Subject: [PATCH 65/84] lists: Add list literals. Fixes #2019. --- basis/lists/lists.factor | 6 +++++- basis/prettyprint/backend/backend.factor | 7 +++++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/basis/lists/lists.factor b/basis/lists/lists.factor index 8bb8b73ea6..206752f7ca 100644 --- a/basis/lists/lists.factor +++ b/basis/lists/lists.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 James Cash, Daniel Ehrenberg, Chris Double. ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators.short-circuit kernel locals math -sequences ; +parser sequences ; IN: lists ! List Protocol @@ -102,3 +102,7 @@ INSTANCE: +nil+ list GENERIC: >list ( object -- list ) M: list >list ; + +M: sequence >list sequence>list ; + +SYNTAX: L{ \ } [ sequence>list ] parse-literal ; \ No newline at end of file diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 0fd99e7e0b..aed2b6344f 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -3,8 +3,8 @@ USING: accessors arrays assocs byte-arrays byte-vectors classes classes.algebra.private classes.maybe classes.private classes.tuple combinators continuations effects generic -hash-sets hashtables io.pathnames io.styles kernel make math -math.order math.parser namespaces prettyprint.config +hash-sets hashtables io.pathnames io.styles kernel lists make +math math.order math.parser namespaces prettyprint.config prettyprint.custom prettyprint.sections prettyprint.stylesheet quotations sbufs sequences strings vectors words ; QUALIFIED: sets @@ -213,6 +213,7 @@ M: array pprint-delims drop \ { \ } ; M: byte-array pprint-delims drop \ B{ \ } ; M: byte-vector pprint-delims drop \ BV{ \ } ; M: vector pprint-delims drop \ V{ \ } ; +M: list pprint-delims drop \ L{ \ } ; M: hashtable pprint-delims drop \ H{ \ } ; M: tuple pprint-delims drop \ T{ \ } ; M: wrapper pprint-delims drop \ W{ \ } ; @@ -227,6 +228,7 @@ M: object >pprint-sequence ; M: vector >pprint-sequence ; M: byte-vector >pprint-sequence ; M: callable >pprint-sequence ; +M: list >pprint-sequence list>array ; M: hashtable >pprint-sequence >alist ; M: wrapper >pprint-sequence wrapped>> 1array ; M: callstack >pprint-sequence callstack>array ; @@ -268,6 +270,7 @@ M: byte-vector pprint* pprint-object ; nesting-limit [ dup [ 1 + ] [ f ] if* ] change [ nesting-limit set ] curry [ ] cleanup ; inline +M: list pprint* pprint-object ; M: hashtable pprint* [ pprint-object ] with-extra-nesting-level ; M: curried pprint* pprint-object ; From 47408528d0374dd9b015a0b8d06b5d7157652890 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 13 Jul 2018 22:58:18 -0500 Subject: [PATCH 66/84] lists: Add list literal doc example. --- basis/lists/lists-docs.factor | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/basis/lists/lists-docs.factor b/basis/lists/lists-docs.factor index 28cd82c639..67e36787f2 100644 --- a/basis/lists/lists-docs.factor +++ b/basis/lists/lists-docs.factor @@ -28,6 +28,7 @@ ARTICLE: "lists-protocol" "The list protocol" ARTICLE: "lists-strict" "Constructing strict lists" "Strict lists are simply cons cells where the car and cdr have already been evaluated. These are the lists of Lisp. To construct a strict list, the following words are provided:" { $subsections + \ L{ cons swons sequence>list @@ -62,6 +63,15 @@ ARTICLE: "lists-manipulation" "Manipulating lists" lcut } ; +HELP: L{ +{ $syntax "L{ val1 val2... }" } +{ $values { "val1" object } { "val2" object } } +{ $example + "USING: lists prettyprint ; L{ 1 2 3 } ." + "L{ 1 2 3 }" +} +{ $description "Constructs a list literal from a sequence." } ; + HELP: cons { $values { "car" "the head of the list cell" } { "cdr" "the tail of the list cell" } { "cons-state" list } } { $description "Constructs a cons cell." } ; From 39cbe60fd226c6fed26ab9a5f8e91b2fc09e13b7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 15 Jul 2018 22:30:03 -0500 Subject: [PATCH 67/84] vocabs.platforms: Add sections that ignore code for the wrong platform. --- basis/vocabs/platforms/authors.txt | 1 + basis/vocabs/platforms/platforms.factor | 36 +++++++++++++++++++++++++ 2 files changed, 37 insertions(+) create mode 100644 basis/vocabs/platforms/authors.txt create mode 100644 basis/vocabs/platforms/platforms.factor diff --git a/basis/vocabs/platforms/authors.txt b/basis/vocabs/platforms/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/vocabs/platforms/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/vocabs/platforms/platforms.factor b/basis/vocabs/platforms/platforms.factor new file mode 100644 index 0000000000..4cab775310 --- /dev/null +++ b/basis/vocabs/platforms/platforms.factor @@ -0,0 +1,36 @@ +! Copyright (C) 2018 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors compiler.units kernel multiline parser +sequences splitting system vocabs.parser ; +IN: vocabs.platforms + +: with-vocabulary ( quot suffix -- ) + [ + [ [ current-vocab name>> ] dip ?tail drop ] + [ append ] bi set-current-vocab + call + ] [ + [ current-vocab name>> ] dip ?tail drop set-current-vocab + ] bi ; inline + +: parse-platform-section ( string suffix -- ) + [ + [ [ string-lines parse-lines ] curry with-nested-compilation-unit ] + curry + ] dip with-vocabulary drop ; inline + +SYNTAX: " parse-multiline-string + os unix? [ ".unix" parse-platform-section ] [ drop ] if ; + +SYNTAX: " parse-multiline-string + os macosx? [ ".macosx" parse-platform-section ] [ drop ] if ; + +SYNTAX: " parse-multiline-string + os linux? [ ".linux" parse-platform-section ] [ drop ] if ; + +SYNTAX: " parse-multiline-string + os windows? [ ".windows" parse-platform-section ] [ drop ] if ; From 279acbc53e8195c970c9d3496cfcf5a5af4d7ab1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 16 Jul 2018 21:02:11 -0500 Subject: [PATCH 68/84] io.launcher: Add process-lines word. --- basis/io/launcher/launcher.factor | 3 +++ basis/io/launcher/windows/windows-tests.factor | 2 +- extra/cli/git/git.factor | 5 +---- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index a56a97294a..f82929fd15 100644 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -236,6 +236,9 @@ PRIVATE> : with-process-reader ( desc encoding quot -- ) with-process-reader* check-success ; inline +: process-lines ( desc -- lines ) + utf8 stream-lines ; + >command [ "err2" ".txt" unique-file ] with-temp-directory [ err-path set-global ] keep >>stderr - utf8 stream-lines first + process-lines first ] with-directory ] unit-test diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor index 03c8cbeabb..f91ad6aa23 100644 --- a/extra/cli/git/git.factor +++ b/extra/cli/git/git.factor @@ -12,9 +12,6 @@ cli-git-num-parallel [ cpus 2 * ] initialize : git-command>string ( quot -- string ) utf8 stream-contents [ blank? ] trim-tail ; -: git-command>lines ( quot -- string ) - utf8 stream-lines ; - : git-clone-as ( uri path -- process ) [ { "git" "clone" } ] 2dip 2array append run-process ; : git-clone ( uri -- process ) [ { "git" "clone" } ] dip suffix run-process ; : git-pull* ( -- process ) { "git" "pull" } run-process ; @@ -36,7 +33,7 @@ cli-git-num-parallel [ cpus 2 * ] initialize : git-rev-parse* ( branch -- string ) [ { "git" "rev-parse" } ] dip suffix git-command>string ; : git-rev-parse ( path branch -- string ) '[ _ git-rev-parse* ] with-directory ; : git-diff-name-only* ( from to -- lines ) - [ { "git" "diff" "--name-only" } ] 2dip 2array append git-command>lines ; + [ { "git" "diff" "--name-only" } ] 2dip 2array append process-lines ; : git-diff-name-only ( path from to -- lines ) '[ _ _ git-diff-name-only* ] with-directory ; From 12918ae2a59894cd0107a656ea4855bb26ef00ec Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 21 Jul 2018 15:18:29 -0500 Subject: [PATCH 69/84] escape-strings: Add a tag-payload word to make a string payload and tag. --- basis/escape-strings/escape-strings.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/basis/escape-strings/escape-strings.factor b/basis/escape-strings/escape-strings.factor index 423b4051fe..9502fb1da0 100644 --- a/basis/escape-strings/escape-strings.factor +++ b/basis/escape-strings/escape-strings.factor @@ -28,6 +28,9 @@ IN: escape-strings : escape-strings ( strs -- str ) [ escape-string ] map concat escape-string ; +: tag-payload ( str tag -- str' ) + [ escape-string ] dip prepend ; + : escape-simplest ( str -- str' ) dup { CHAR: ' CHAR: " CHAR: \r CHAR: \n CHAR: \s } counts { { [ dup { CHAR: ' CHAR: \r CHAR: \n CHAR: \s } values-of sum 0 = ] [ drop "'" prepend ] } From 0655ed4e001312e2483c40dd6545adb159b7e2c0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 21 Jul 2018 15:26:37 -0500 Subject: [PATCH 70/84] ci: Start new vocabs. Add ci.docker for running commands in docker. Add ci.run-process for running commands and capturing everything from their run. USE: ci.docker USE: ci.run-process { "run" "hello-world" } "docker" find-in-standard-login-path prefix ci-run-process>autopsy autopsy. --- extra/ci/docker/authors.txt | 1 + extra/ci/docker/docker.factor | 78 +++++++++++++++++++++++++ extra/ci/run-process/authors.txt | 1 + extra/ci/run-process/run-process.factor | 74 +++++++++++++++++++++++ 4 files changed, 154 insertions(+) create mode 100644 extra/ci/docker/authors.txt create mode 100644 extra/ci/docker/docker.factor create mode 100644 extra/ci/run-process/authors.txt create mode 100644 extra/ci/run-process/run-process.factor diff --git a/extra/ci/docker/authors.txt b/extra/ci/docker/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/ci/docker/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/ci/docker/docker.factor b/extra/ci/docker/docker.factor new file mode 100644 index 0000000000..d66eb6e5de --- /dev/null +++ b/extra/ci/docker/docker.factor @@ -0,0 +1,78 @@ +! Copyright (C) 2018 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: io.files.links io.launcher io.standard-paths json.reader +kernel literals namespaces sequences strings system ; +IN: ci.docker + +SYMBOL: docker-username +SYMBOL: docker-password + +: docker-path ( -- path ) + "docker" find-in-standard-login-path ; + +: docker-machine-path ( -- path ) + "docker-machine" find-in-standard-login-path ; + +: vboxmanage-path ( -- path ) + "VBoxManage" find-in-standard-login-path ; + +: sudo-linux ( seq -- seq' ) + os linux? [ "sudo" prefix ] when ; + +: docker-lines ( seq -- lines ) + docker-path prefix sudo-linux process-lines ; + +: docker-machine-lines ( seq -- lines ) + docker-machine-path prefix process-lines ; + + +: docker-command ( seq -- ) + docker-path prefix sudo-linux try-output-process ; + +: docker-machine-command ( seq -- ) + docker-machine-path prefix try-output-process ; + + +: docker-version ( -- string ) + { "version" } docker-lines ; + +: docker-machine-version ( -- string ) + { "version" } docker-machine-lines ?first ; + + + +: docker-machine-inspect ( string -- json ) + { "inspect" } swap suffix docker-machine-lines "" join json> ; + + +: docker-machines ( -- seq ) + { "ls" "-q" } docker-machine-lines ; + +: docker-machine-status ( string -- status ) + { "status" } swap suffix docker-machine-lines ; + + +: docker-image-names ( -- seq ) + { "image" "ls" "-q" } docker-lines ; + +: docker-image-ls ( -- seq ) + { "image" "ls" } docker-lines ; + +: docker-login ( -- ) + ${ + "sudo" + docker-path "login" + "-p" docker-password get-global + "-u" docker-username get-global + } run-process drop ; + +GENERIC: docker-pull ( obj -- ) + +M: string docker-pull ( string -- ) + { "pull" } swap suffix docker-command ; + +M: sequence docker-pull ( seq -- ) + [ docker-pull ] each ; + +: docker-hello-world ( -- ) + { "run" "hello-world" } docker-command ; diff --git a/extra/ci/run-process/authors.txt b/extra/ci/run-process/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/ci/run-process/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/ci/run-process/run-process.factor b/extra/ci/run-process/run-process.factor new file mode 100644 index 0000000000..425afdf18f --- /dev/null +++ b/extra/ci/run-process/run-process.factor @@ -0,0 +1,74 @@ +! Copyright (C) 2018 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs calendar combinators environment +escape-strings fry io io.pathnames io.streams.string kernel math +math.parser namespaces prettyprint prettyprint.config sequences +tools.deploy.backend tools.time unix.groups unix.users uuid ; +IN: ci.run-process + +TUPLE: process-autopsy + timestamp os-envs + cwd uid euid gid egid out elapsed os-envs-after process ; + +: ci-run-process ( process -- timestamp os-envs cwd uid euid gid egid out elapsed os-envs' process ) + [ + [ + gmt os-envs current-directory get + real-user-id effective-user-id + real-group-id effective-group-id + ] dip [ + '[ _ run-with-output ] with-string-writer + ] benchmark os-envs + ] keep ; + +: ci-run-process>autopsy ( process -- autopsy ) + ci-run-process process-autopsy boa ; + +: unparse-full ( obj -- str ) + [ unparse ] without-limits ; + +: autopsy. ( autopsy -- ) + { + [ drop "> timestamp>unix-time >float number>string + "unix-time" tag-payload print nl + ] + [ + bl bl elapsed>> number>string "elapsed-nanos" tag-payload print nl + ] + [ + bl bl cwd>> "cwd" tag-payload print nl + ] + [ + bl bl uid>> number>string "uid" tag-payload print nl + ] + [ + bl bl euid>> number>string "euid" tag-payload print nl + ] + [ + bl bl gid>> number>string "gid" tag-payload print nl + ] + [ + bl bl egid>> number>string "egid" tag-payload print nl + ] + [ + bl bl os-envs>> unparse-full "os-envs" tag-payload print nl + ] + [ + bl bl os-envs>> unparse-full "os-envs-after" tag-payload print nl + ] + [ + bl bl [ os-envs-after>> ] [ os-envs>> ] bi assoc-diff unparse-full "os-envs-diff" tag-payload print nl + ] + [ + bl bl [ os-envs>> ] [ os-envs-after>> ] bi assoc-diff unparse-full "os-envs-swap-diff" tag-payload print nl + ] + [ + bl bl process>> unparse-full "process" tag-payload print nl + ] + [ + bl bl out>> "out" tag-payload print nl + ] + [ drop ";AUTOPSY>" print ] + } cleave ; \ No newline at end of file From 102fe6154e9deec5dff38ee70519f7bbe506f6ce Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 21 Jul 2018 15:28:43 -0500 Subject: [PATCH 71/84] ci.run-process platforms: getting uid/gid, so unix only for now --- extra/ci/run-process/platforms.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 extra/ci/run-process/platforms.txt diff --git a/extra/ci/run-process/platforms.txt b/extra/ci/run-process/platforms.txt new file mode 100644 index 0000000000..509143d863 --- /dev/null +++ b/extra/ci/run-process/platforms.txt @@ -0,0 +1 @@ +unix From 2b4d2a4a1314d3efd42f092f5af12ae839d8058b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Jul 2018 11:32:02 -0500 Subject: [PATCH 72/84] system: Make the git version code more robust. Really confusing sequence errors if Factor vm isn't compiled with proper git label. e.g. good: -DFACTOR_GIT_LABEL="heads/master-102fe6154e9deec5dff38ee70519f7bbe506f6ce" bad: -DFACTOR_GIT_LABEL="" before this patch gave an integer comparison error comparing ``f 16 <`` --- core/system/system.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/core/system/system.factor b/core/system/system.factor index a694d074ff..4fcdefc024 100644 --- a/core/system/system.factor +++ b/core/system/system.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007, 2010 slava pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs continuations init io kernel kernel.private make -math math.parser namespaces sequences ; +USING: accessors assocs continuations init io kernel +kernel.private make math.parser namespaces sequences splitting ; IN: system PRIMITIVE: (exit) ( n -- * ) @@ -27,10 +27,10 @@ UNION: unix macosx linux ; : vm-git-label ( -- string ) \ vm-git-label get-global ; : vm-git-ref ( -- string ) - vm-git-label CHAR: - over last-index head ; + vm-git-label "-" split1-last drop ; : vm-git-id ( -- string ) - vm-git-label CHAR: - over last-index 1 + tail ; + vm-git-label "-" split1-last nip ; : vm-compiler ( -- string ) \ vm-compiler get-global ; From 3a5533dc442ae8f5e90abf152f89cfd813f2b6b8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 22 Jul 2018 11:34:29 -0500 Subject: [PATCH 73/84] layouts: Add 32bit? and 64bit? words. --- basis/compiler/tree/cleanup/cleanup-tests.factor | 2 +- basis/compiler/tree/propagation/propagation-tests.factor | 2 +- core/layouts/layouts.factor | 4 ++++ 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 53a4ce8fda..1e6f85f92e 100644 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -225,7 +225,7 @@ M: float detect-float ; { shift fixnum-shift } inlined? ] unit-test -cell-bits 32 = [ +32bit? [ [ t ] [ [ { fixnum fixnum } declare 1 swap 31 bitand shift ] \ shift inlined? diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index a63364f10e..37460dffc0 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -492,7 +492,7 @@ IN: compiler.tree.propagation.tests [ { fixnum } declare 1 swap 7 bitand >bignum shift ] final-classes ] unit-test -cell-bits 32 = [ +32bit? [ [ V{ integer } ] [ [ { fixnum } declare 1 swap 31 bitand shift ] final-classes diff --git a/core/layouts/layouts.factor b/core/layouts/layouts.factor index 9f5b7b95ba..f72bb3bcd4 100644 --- a/core/layouts/layouts.factor +++ b/core/layouts/layouts.factor @@ -48,6 +48,10 @@ SYMBOL: header-bits : cell-bits ( -- n ) 8 cells ; inline +: 32bit? ( -- ? ) cell-bits 32 = ; inline + +: 64bit? ( -- ? ) cell-bits 64 = ; inline + : bootstrap-cell ( -- n ) \ cell get cell or ; inline : bootstrap-cells ( m -- n ) bootstrap-cell * ; inline From 339be707a21059b856f5b4b52a44c1e71a9a0a90 Mon Sep 17 00:00:00 2001 From: Benjamin Pollack Date: Thu, 26 Jul 2018 16:59:27 -0400 Subject: [PATCH 74/84] build: allow any GCC version The existing test didn't work on modern GCC; a clean fix didn't work on modern macOS due to its aliasing gcc to clang; and the test being done is for a version of GCC from 2013 that doesn't ship on any modern Linux system. (RHEL7 is on GCC 4, but hasn't shipped the buggy version either ever or since 2015, depending on which source material I look at.) Closes #2023 --- build.sh | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/build.sh b/build.sh index 97a4a719ea..bfe47359da 100755 --- a/build.sh +++ b/build.sh @@ -132,23 +132,6 @@ semver_into() { fi } -# issue 1440 -gcc_version_ok() { - GCC_VERSION=`gcc -dumpversion` - local GCC_MAJOR local GCC_MINOR local GCC_PATCH local GCC_SPECIAL - semver_into $GCC_VERSION GCC_MAJOR GCC_MINOR GCC_PATCH GCC_SPECIAL - - if [[ $GCC_MAJOR -lt 4 - || ( $GCC_MAJOR -eq 4 && $GCC_MINOR -lt 7 ) - || ( $GCC_MAJOR -eq 4 && $GCC_MINOR -eq 7 && $GCC_PATCH -lt 3 ) - || ( $GCC_MAJOR -eq 4 && $GCC_MINOR -eq 8 && $GCC_PATCH -eq 0 ) - ]] ; then - echo "gcc version required >= 4.7.3, != 4.8.0, >= 4.8.1, got $GCC_VERSION" - return 1 - fi - return 0 -} - clang_version_ok() { CLANG_VERSION=`clang --version | head -n1` CLANG_VERSION_RE='^[a-zA-Z0-9 ]* version (.*)$' # 3.3-5 @@ -177,7 +160,7 @@ set_cc() { fi test_programs_installed gcc g++ - if [[ $? -ne 0 ]] && gcc_version_ok ; then + if [[ $? -ne 0 ]] ; then [ -z "$CC" ] && CC=gcc [ -z "$CXX" ] && CXX=g++ return From e6e7655cbd0c7eb2654b01a1654d7d2b7438e96c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 27 Jul 2018 21:35:55 -0500 Subject: [PATCH 75/84] vm: Fix some really minor warnings. --- vm/ffi_test.c | 13 +++++++++---- vm/ffi_test.h | 8 ++++---- vm/quotations.hpp | 1 - 3 files changed, 13 insertions(+), 9 deletions(-) diff --git a/vm/ffi_test.c b/vm/ffi_test.c index 4bf5e70f3e..1927a8d988 100644 --- a/vm/ffi_test.c +++ b/vm/ffi_test.c @@ -84,7 +84,10 @@ FACTOR_STDCALL(struct bar) ffi_test_19(long x, long y, long z) { } void ffi_test_20(double x1, double x2, double x3, double y1, double y2, - double y3, double z1, double z2, double z3) {} + double y3, double z1, double z2, double z3) { + (void) x1, (void) x2, (void) x3, (void) y1, (void) y2, + (void) y3, (void) z1, (void) z2, (void) z3; +} long long ffi_test_21(long x, long y) { return (long long) x * (long long) y; } @@ -309,7 +312,7 @@ unsigned long long ffi_test_60(unsigned long long x) { /* C99 features */ #ifndef _MSC_VER -struct bool_and_ptr ffi_test_61() { +struct bool_and_ptr ffi_test_61(void) { struct bool_and_ptr bap; bap.b = true; bap.ptr = NULL; @@ -318,14 +321,14 @@ struct bool_and_ptr ffi_test_61() { #endif -struct uint_pair ffi_test_62() { +struct uint_pair ffi_test_62(void) { struct uint_pair uip; uip.a = 0xabcdefab; uip.b = 0x12345678; return uip; } -struct ulonglong_pair ffi_test_63() { +struct ulonglong_pair ffi_test_63(void) { struct ulonglong_pair ullp; ullp.a = 0xabcdefabcdefabcd; ullp.b = 0x1234567891234567; @@ -360,6 +363,8 @@ void* bug1021_test_1(void* x, int y) { } int bug1021_test_2(int x, char *y, void *z) { + (void) x; + (void) z; return y[0]; } diff --git a/vm/ffi_test.h b/vm/ffi_test.h index c359811e65..1c7ae7ddb3 100644 --- a/vm/ffi_test.h +++ b/vm/ffi_test.h @@ -161,7 +161,7 @@ struct test_struct_16 { FACTOR_EXPORT struct test_struct_16 ffi_test_43(float x, int a); -FACTOR_EXPORT struct test_struct_14 ffi_test_44(); +FACTOR_EXPORT struct test_struct_14 ffi_test_44(void); /* C99 features */ #ifndef _MSC_VER @@ -211,7 +211,7 @@ struct bool_and_ptr { void* ptr; }; -FACTOR_EXPORT struct bool_and_ptr ffi_test_61(); +FACTOR_EXPORT struct bool_and_ptr ffi_test_61(void); #endif @@ -220,14 +220,14 @@ struct uint_pair { unsigned int b; }; -FACTOR_EXPORT struct uint_pair ffi_test_62(); +FACTOR_EXPORT struct uint_pair ffi_test_62(void); struct ulonglong_pair { unsigned long long a; unsigned long long b; }; -FACTOR_EXPORT struct ulonglong_pair ffi_test_63(); +FACTOR_EXPORT struct ulonglong_pair ffi_test_63(void); FACTOR_EXPORT int ffi_test_64(int n, ...); FACTOR_EXPORT double ffi_test_65(int n, ...); diff --git a/vm/quotations.hpp b/vm/quotations.hpp index dd80c94882..3c659126dc 100644 --- a/vm/quotations.hpp +++ b/vm/quotations.hpp @@ -10,7 +10,6 @@ struct quotation_jit : public jit { elements(false_object, vm), compiling(compiling), relocate(relocate) {} - ; cell nth(cell index); void init_quotation(cell quot); From 6810fc42b09083ec21fe501d5413c18249e41467 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 30 Jul 2018 12:01:28 -0500 Subject: [PATCH 76/84] Revert "lists: Add list literals." This reverts commit ae74a794e1ef8e76a1fbf6fe07b649662dc17874. The listener forces lazy lists, which is not what we want. We need a different approach for prettyprinting lazy lists. --- basis/lists/lists.factor | 6 +----- basis/prettyprint/backend/backend.factor | 7 ++----- 2 files changed, 3 insertions(+), 10 deletions(-) diff --git a/basis/lists/lists.factor b/basis/lists/lists.factor index 206752f7ca..8bb8b73ea6 100644 --- a/basis/lists/lists.factor +++ b/basis/lists/lists.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 James Cash, Daniel Ehrenberg, Chris Double. ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators.short-circuit kernel locals math -parser sequences ; +sequences ; IN: lists ! List Protocol @@ -102,7 +102,3 @@ INSTANCE: +nil+ list GENERIC: >list ( object -- list ) M: list >list ; - -M: sequence >list sequence>list ; - -SYNTAX: L{ \ } [ sequence>list ] parse-literal ; \ No newline at end of file diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index aed2b6344f..0fd99e7e0b 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -3,8 +3,8 @@ USING: accessors arrays assocs byte-arrays byte-vectors classes classes.algebra.private classes.maybe classes.private classes.tuple combinators continuations effects generic -hash-sets hashtables io.pathnames io.styles kernel lists make -math math.order math.parser namespaces prettyprint.config +hash-sets hashtables io.pathnames io.styles kernel make math +math.order math.parser namespaces prettyprint.config prettyprint.custom prettyprint.sections prettyprint.stylesheet quotations sbufs sequences strings vectors words ; QUALIFIED: sets @@ -213,7 +213,6 @@ M: array pprint-delims drop \ { \ } ; M: byte-array pprint-delims drop \ B{ \ } ; M: byte-vector pprint-delims drop \ BV{ \ } ; M: vector pprint-delims drop \ V{ \ } ; -M: list pprint-delims drop \ L{ \ } ; M: hashtable pprint-delims drop \ H{ \ } ; M: tuple pprint-delims drop \ T{ \ } ; M: wrapper pprint-delims drop \ W{ \ } ; @@ -228,7 +227,6 @@ M: object >pprint-sequence ; M: vector >pprint-sequence ; M: byte-vector >pprint-sequence ; M: callable >pprint-sequence ; -M: list >pprint-sequence list>array ; M: hashtable >pprint-sequence >alist ; M: wrapper >pprint-sequence wrapped>> 1array ; M: callstack >pprint-sequence callstack>array ; @@ -270,7 +268,6 @@ M: byte-vector pprint* pprint-object ; nesting-limit [ dup [ 1 + ] [ f ] if* ] change [ nesting-limit set ] curry [ ] cleanup ; inline -M: list pprint* pprint-object ; M: hashtable pprint* [ pprint-object ] with-extra-nesting-level ; M: curried pprint* pprint-object ; From 7999e72aecc3c5bc4019d43dc4697f49678cc3b4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 30 Jul 2018 12:02:42 -0500 Subject: [PATCH 77/84] Revert "lists: Add list literal doc example." This reverts commit 47408528d0374dd9b015a0b8d06b5d7157652890. --- basis/lists/lists-docs.factor | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/basis/lists/lists-docs.factor b/basis/lists/lists-docs.factor index 67e36787f2..28cd82c639 100644 --- a/basis/lists/lists-docs.factor +++ b/basis/lists/lists-docs.factor @@ -28,7 +28,6 @@ ARTICLE: "lists-protocol" "The list protocol" ARTICLE: "lists-strict" "Constructing strict lists" "Strict lists are simply cons cells where the car and cdr have already been evaluated. These are the lists of Lisp. To construct a strict list, the following words are provided:" { $subsections - \ L{ cons swons sequence>list @@ -63,15 +62,6 @@ ARTICLE: "lists-manipulation" "Manipulating lists" lcut } ; -HELP: L{ -{ $syntax "L{ val1 val2... }" } -{ $values { "val1" object } { "val2" object } } -{ $example - "USING: lists prettyprint ; L{ 1 2 3 } ." - "L{ 1 2 3 }" -} -{ $description "Constructs a list literal from a sequence." } ; - HELP: cons { $values { "car" "the head of the list cell" } { "cdr" "the tail of the list cell" } { "cons-state" list } } { $description "Constructs a cons cell." } ; From 01d2381696195712ac98882d17b12fbf8d46164c Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 31 Jul 2018 10:19:09 -0700 Subject: [PATCH 78/84] Factor.app: update copyrights. --- Factor.app/Contents/Info.plist | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Factor.app/Contents/Info.plist b/Factor.app/Contents/Info.plist index b4b1325ce7..fd962df08d 100644 --- a/Factor.app/Contents/Info.plist +++ b/Factor.app/Contents/Info.plist @@ -34,7 +34,7 @@ CFBundleVersion 0.98 NSHumanReadableCopyright - Copyright © 2003-2017 Factor developers + Copyright © 2003-2018 Factor developers NSServices From a463214d1086885e3e97ab8c8d426f5a5feb4243 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 31 Jul 2018 12:40:12 -0700 Subject: [PATCH 79/84] Version bump to 0.99 (-dev). --- Factor.app/Contents/Info.plist | 2 +- GNUmakefile | 2 +- Nmakefile | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Factor.app/Contents/Info.plist b/Factor.app/Contents/Info.plist index fd962df08d..48581e7554 100644 --- a/Factor.app/Contents/Info.plist +++ b/Factor.app/Contents/Info.plist @@ -32,7 +32,7 @@ CFBundlePackageType APPL CFBundleVersion - 0.98 + 0.99 NSHumanReadableCopyright Copyright © 2003-2018 Factor developers NSServices diff --git a/GNUmakefile b/GNUmakefile index 1d4ebaabcf..0cf1d9fd4c 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -1,5 +1,5 @@ ifdef CONFIG - VERSION = 0.98 + VERSION = 0.99 GIT_LABEL = $(shell echo `git describe --all`-`git rev-parse HEAD`) BUNDLE = Factor.app diff --git a/Nmakefile b/Nmakefile index 310358a60b..0b0ce66777 100644 --- a/Nmakefile +++ b/Nmakefile @@ -1,4 +1,4 @@ -VERSION = 0.98 +VERSION = 0.99 # Crazy hack to do shell commands # We do it in Nmakefile because that way we don't have to invoke build through build.cmd From dbb9bb42cae3e9c0b6b92d580fa66afe15f2b614 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 31 Jul 2018 18:12:54 -0700 Subject: [PATCH 80/84] odbc: add windows platform.txt. --- extra/odbc/platforms.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 extra/odbc/platforms.txt diff --git a/extra/odbc/platforms.txt b/extra/odbc/platforms.txt new file mode 100644 index 0000000000..8e1a55995e --- /dev/null +++ b/extra/odbc/platforms.txt @@ -0,0 +1 @@ +windows From 5e9b804d665e516eecb18023d2d3d1633c964cb0 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 1 Aug 2018 12:52:33 -0700 Subject: [PATCH 81/84] tools.cat: significant performance improvement using binary. Before (using strings): 77MiB/s After (using byte-arrays): 3.06GiB/s --- extra/tools/cat/cat.factor | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/extra/tools/cat/cat.factor b/extra/tools/cat/cat.factor index ea90e42a38..0798d757e0 100644 --- a/extra/tools/cat/cat.factor +++ b/extra/tools/cat/cat.factor @@ -1,16 +1,15 @@ ! Copyright (C) 2010 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: command-line formatting kernel io io.encodings.binary -io.files namespaces sequences strings ; +USING: accessors command-line formatting fry io io.encodings +io.encodings.binary io.files kernel namespaces sequences ; IN: tools.cat -: cat-lines ( -- ) - [ print flush ] each-line ; - : cat-stream ( -- ) - [ >string write flush ] each-block ; + input-stream get dup decoder? [ stream>> ] when + output-stream get dup encoder? [ stream>> ] when + '[ _ stream-write ] each-stream-block ; : cat-file ( path -- ) dup exists? [ @@ -18,9 +17,9 @@ IN: tools.cat ] [ "%s: not found\n" printf flush ] if ; : cat-files ( paths -- ) - [ dup "-" = [ drop cat-lines ] [ cat-file ] if ] each ; + [ dup "-" = [ drop cat-stream ] [ cat-file ] if ] each ; : run-cat ( -- ) - command-line get [ cat-lines ] [ cat-files ] if-empty ; + command-line get [ cat-stream ] [ cat-files ] if-empty ; MAIN: run-cat From ed9df3303dacca89e7fc842e054c1a1b24c72fce Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 1 Aug 2018 14:25:25 -0700 Subject: [PATCH 82/84] tools.cat: use re-encode/re-decode. --- extra/tools/cat/cat.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/tools/cat/cat.factor b/extra/tools/cat/cat.factor index 0798d757e0..45694598df 100644 --- a/extra/tools/cat/cat.factor +++ b/extra/tools/cat/cat.factor @@ -1,14 +1,14 @@ ! Copyright (C) 2010 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: accessors command-line formatting fry io io.encodings +USING: command-line formatting fry io io.encodings io.encodings.binary io.files kernel namespaces sequences ; IN: tools.cat : cat-stream ( -- ) - input-stream get dup decoder? [ stream>> ] when - output-stream get dup encoder? [ stream>> ] when + input-stream get binary re-decode + output-stream get binary re-encode '[ _ stream-write ] each-stream-block ; : cat-file ( path -- ) From 62fd7e3bbd1e7a910de8c7865903d38edcb1ef9f Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 1 Aug 2018 21:03:40 -0700 Subject: [PATCH 83/84] tools.wc: use re-decode here also. --- extra/tools/wc/wc.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/tools/wc/wc.factor b/extra/tools/wc/wc.factor index c0535df1bd..94d8d3f1df 100644 --- a/extra/tools/wc/wc.factor +++ b/extra/tools/wc/wc.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2016 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: accessors alien.data command-line formatting io -io.encodings io.encodings.binary io.files kernel math -math.bitwise math.vectors math.vectors.simd namespaces sequences +USING: alien.data command-line formatting io io.encodings +io.encodings.binary io.files kernel math math.bitwise +math.vectors math.vectors.simd namespaces sequences specialized-arrays ; SPECIALIZED-ARRAY: uchar-16 @@ -27,7 +27,7 @@ IN: tools.wc ] each-block-slice ; inline : wc-stdin ( -- n ) - input-stream get dup decoder? [ stream>> ] when + input-stream get binary re-decode [ count-lines ] with-input-stream* ; PRIVATE> From dc25fe3688ac08c1c9f2948b6873de6f7417651a Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 1 Aug 2018 21:08:43 -0700 Subject: [PATCH 84/84] ui.tools.listener: minor cleanup to completion stuff. --- basis/ui/tools/listener/completion/completion.factor | 4 ++-- basis/ui/tools/listener/listener.factor | 8 ++------ 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor index 6ace39a4ba..82e5b16f18 100644 --- a/basis/ui/tools/listener/completion/completion.factor +++ b/basis/ui/tools/listener/completion/completion.factor @@ -193,6 +193,6 @@ completion-popup H{ [ [ nip ] [ gesture>operation ] 2bi ] [ drop f ] if ; M: completion-popup handle-gesture ( gesture completion -- ? ) - 2dup completion-gesture dup [ + 2dup completion-gesture [ [ nip hide-glass ] [ invoke-command ] 2bi* f - ] [ 2drop call-next-method ] if ; + ] [ drop call-next-method ] if* ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 9939d0d19e..89fe0cd74a 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -46,6 +46,8 @@ M: interactor manifest>> GENERIC: (word-at-caret) ( token completion-mode -- obj ) +M: object (word-at-caret) 2drop f ; + M: vocab-completion (word-at-caret) drop [ dup vocab-exists? [ >vocab-link ] [ drop f ] if ] @@ -59,12 +61,6 @@ M: word-completion (word-at-caret) M: vocab-word-completion (word-at-caret) vocab-name>> lookup-word ; -M: char-completion (word-at-caret) 2drop f ; - -M: path-completion (word-at-caret) 2drop f ; - -M: color-completion (word-at-caret) 2drop f ; - : word-at-caret ( token interactor -- obj ) completion-mode (word-at-caret) ;