From c60baf123260f4199f534a55de2c4a80be4e0ba8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 13 May 2008 23:36:55 -0500 Subject: [PATCH] sift and harvest words added --- core/bootstrap/primitives.factor | 5 -- core/bootstrap/stage2.factor | 2 +- core/cpu/x86/64/64.factor | 2 +- core/inference/backend/backend.factor | 4 +- core/parser/parser.factor | 4 +- core/prettyprint/sections/sections.factor | 2 +- core/sequences/sequences.factor | 6 ++ core/slots/deprecated/deprecated.factor | 2 +- core/vocabs/vocabs.factor | 2 +- extra/bunny/bunny.factor | 2 +- extra/bunny/model/model.factor | 2 +- extra/ftp/client/client.factor | 2 +- extra/hardware-info/linux/linux.factor | 4 +- extra/help/handbook/handbook.factor | 2 +- extra/help/help.factor | 2 +- extra/html/parser/analyzer/analyzer.factor | 4 +- extra/http/client/client-tests.factor | 25 +++++-- extra/http/client/client.factor | 16 +---- extra/http/http.factor | 82 ++++++++++++++++++---- extra/http/server/server.factor | 2 +- extra/koszul/koszul.factor | 2 +- extra/logging/server/server.factor | 2 +- extra/peg/search/search.factor | 4 +- extra/sequences/lib/lib.factor | 2 +- extra/tools/vocabs/browser/browser.factor | 2 +- extra/ui/gadgets/tracks/tracks.factor | 2 +- extra/ui/tools/tools-tests.factor | 2 +- extra/unicode/breaks/breaks.factor | 3 +- extra/unicode/data/data.factor | 2 +- extra/unicode/script/script.factor | 2 +- extra/windows/com/syntax/syntax.factor | 3 +- extra/wrap/wrap.factor | 2 +- 32 files changed, 128 insertions(+), 72 deletions(-) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 4aebef3e0d..6fc8ca7685 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -160,11 +160,6 @@ bootstrapping? on "tuple-layout" "classes.tuple.private" create register-builtin ! Catch-all class for providing a default method. -! "object" "kernel" create -! [ f builtins get [ ] filter f union-class define-class ] -! [ [ drop t ] "predicate" set-word-prop ] -! bi - "object" "kernel" create [ f f { } intersection-class define-class ] [ [ drop t ] "predicate" set-word-prop ] diff --git a/core/bootstrap/stage2.factor b/core/bootstrap/stage2.factor index 2e087ff5bd..f94cc0ed37 100755 --- a/core/bootstrap/stage2.factor +++ b/core/bootstrap/stage2.factor @@ -23,7 +23,7 @@ SYMBOL: bootstrap-time : load-components ( -- ) "include" "exclude" - [ get-global " " split [ empty? not ] filter ] bi@ + [ get-global " " split harvest ] bi@ diff [ "bootstrap." prepend require ] each ; diff --git a/core/cpu/x86/64/64.factor b/core/cpu/x86/64/64.factor index 9c44a6a656..ebaa6056ff 100755 --- a/core/cpu/x86/64/64.factor +++ b/core/cpu/x86/64/64.factor @@ -184,7 +184,7 @@ stack-params "__stack_value" c-type set-c-type-reg-class >> : split-struct ( pairs -- seq ) [ [ 8 mod zero? [ t , ] when , ] assoc-each - ] { } make { t } split [ empty? not ] filter ; + ] { } make { t } split harvest ; : flatten-large-struct ( type -- ) heap-size cell align diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor index 5896429ccf..c49e7fda8a 100755 --- a/core/inference/backend/backend.factor +++ b/core/inference/backend/backend.factor @@ -261,7 +261,7 @@ TUPLE: cannot-unify-specials ; : balanced? ( in out -- ? ) [ dup [ length - ] [ 2drop f ] if ] 2map - [ ] filter all-equal? ; + sift all-equal? ; TUPLE: unbalanced-branches-error quots in out ; @@ -281,7 +281,7 @@ TUPLE: unbalanced-branches-error quots in out ; 2dup balanced? [ over supremum -rot [ >r dupd r> unify-inputs ] 2map - [ ] filter unify-stacks + sift unify-stacks rot drop ] [ unbalanced-branches-error diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 76c831cf13..f08ba8fbc2 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -207,7 +207,7 @@ SYMBOL: in : add-use ( seq -- ) [ use+ ] each ; : set-use ( seq -- ) - [ vocab-words ] map [ ] filter >vector use set ; + [ vocab-words ] V{ } map-as sift use set ; : check-vocab-string ( name -- name ) dup string? @@ -278,7 +278,7 @@ M: no-word-error summary dup forward-reference? [ drop use get - [ at ] with map [ ] filter + [ at ] with map sift [ forward-reference? not ] find nip ] [ nip diff --git a/core/prettyprint/sections/sections.factor b/core/prettyprint/sections/sections.factor index 11fa4da28e..73d3620107 100644 --- a/core/prettyprint/sections/sections.factor +++ b/core/prettyprint/sections/sections.factor @@ -309,7 +309,7 @@ M: f section-end-group? drop f ; 2dup 1+ swap ?nth next set swap nth dup split-before dup , split-after ] with each - ] { } make { t } split [ empty? not ] filter ; + ] { } make { t } split harvest ; : break-group? ( seq -- ? ) [ first section-fits? ] [ peek section-fits? not ] bi and ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 8d0e3eec18..cbddfa7d28 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -445,6 +445,12 @@ PRIVATE> : remove ( obj seq -- newseq ) [ = not ] with filter ; +: sift ( seq -- newseq ) + [ ] filter ; + +: harvest ( seq -- newseq ) + [ empty? not ] filter ; + : cache-nth ( i seq quot -- elt ) 2over ?nth dup [ >r 3drop r> diff --git a/core/slots/deprecated/deprecated.factor b/core/slots/deprecated/deprecated.factor index 90f468a185..3e2f899774 100755 --- a/core/slots/deprecated/deprecated.factor +++ b/core/slots/deprecated/deprecated.factor @@ -86,7 +86,7 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ; { [ over string? ] [ >r dupd r> short-slot ] } { [ over array? ] [ long-slot ] } } cond - ] 2map [ ] filter nip ; + ] 2map sift nip ; : slot-of-reader ( reader specs -- spec/f ) [ slot-spec-reader eq? ] with find nip ; diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index edd82b2596..57951e8642 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -76,7 +76,7 @@ SYMBOL: load-vocab-hook ! ( name -- ) : words-named ( str -- seq ) dictionary get values [ vocab-words at ] with map - [ ] filter ; + sift ; : child-vocab? ( prefix name -- ? ) 2dup = pick empty? or diff --git a/extra/bunny/bunny.factor b/extra/bunny/bunny.factor index d546f9ea41..6ebd598dc6 100755 --- a/extra/bunny/bunny.factor +++ b/extra/bunny/bunny.factor @@ -33,7 +33,7 @@ M: bunny-gadget graft* ( gadget -- ) [ ] [ ] [ ] tri 3array - [ ] filter >>draw-seq + sift >>draw-seq 0 >>draw-n drop ; diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 239603755d..95b5fe401d 100755 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -6,7 +6,7 @@ float-arrays continuations namespaces sequences.lib accessors ; IN: bunny.model : numbers ( str -- seq ) - " " split [ string>number ] map [ ] filter ; + " " split [ string>number ] map sift ; : (parse-model) ( vs is -- vs is ) readln [ diff --git a/extra/ftp/client/client.factor b/extra/ftp/client/client.factor index 13cb21d7e4..88b83b7d66 100644 --- a/extra/ftp/client/client.factor +++ b/extra/ftp/client/client.factor @@ -130,7 +130,7 @@ TUPLE: remote-file : parse-list ( ftp-response -- ftp-response ) dup strings>> - [ " " split [ empty? not ] filter ] map + [ " " split harvest ] map dup length { { 9 [ parse-list-9 ] } { 8 [ parse-list-8 ] } diff --git a/extra/hardware-info/linux/linux.factor b/extra/hardware-info/linux/linux.factor index 5d9ca6eaa7..89f42b4384 100644 --- a/extra/hardware-info/linux/linux.factor +++ b/extra/hardware-info/linux/linux.factor @@ -7,7 +7,7 @@ IN: hardware-info.linux : uname ( -- seq ) 65536 "char" [ (uname) io-error ] keep - "\0" split [ empty? not ] filter [ >string ] map + "\0" split harvest [ >string ] map 6 "" pad-right ; : sysname ( -- string ) uname first ; @@ -18,4 +18,4 @@ IN: hardware-info.linux : domainname ( -- string ) uname 5 swap nth ; : kernel-version ( -- seq ) - release ".-" split [ ] filter 5 "" pad-right ; + release ".-" split harvest 5 "" pad-right ; diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index a8271a0e3b..dd4106239d 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -238,7 +238,7 @@ ARTICLE: "error-index" "Error index" { $index [ all-errors ] } ; ARTICLE: "type-index" "Type index" -{ $index [ builtins get [ ] filter ] } ; +{ $index [ builtins get sift ] } ; ARTICLE: "class-index" "Class index" { $index [ classes ] } ; diff --git a/extra/help/help.factor b/extra/help/help.factor index 2d56251392..75a14e645b 100755 --- a/extra/help/help.factor +++ b/extra/help/help.factor @@ -135,7 +135,7 @@ M: word set-article-parent swap "help-parent" set-word-prop ; ":vars - list all variables at error time" print ; : :help ( -- ) - error get delegates [ error-help ] map [ ] filter + error get delegates [ error-help ] map sift { { [ dup empty? ] [ (:help-none) ] } { [ dup length 1 = ] [ first help ] } diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index e9906f3f2a..9a3ff8c7a7 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -77,12 +77,12 @@ IN: html.parser.analyzer : find-by-attribute-key ( key vector -- vector ) >r >lower r> [ tag-attributes at ] with filter - [ ] filter ; + sift ; : find-by-attribute-key-value ( value key vector -- vector ) >r >lower r> [ tag-attributes at over = ] with filter nip - [ ] filter ; + sift ; : find-first-attribute-key-value ( value key vector -- i/f tag/f ) >r >lower r> diff --git a/extra/http/client/client-tests.factor b/extra/http/client/client-tests.factor index 1d947b99e5..9ad805b81b 100755 --- a/extra/http/client/client-tests.factor +++ b/extra/http/client/client-tests.factor @@ -1,9 +1,7 @@ USING: http.client http.client.private http tools.test tuple-syntax namespaces ; -[ "localhost" 80 ] [ "localhost" parse-host ] unit-test +[ "localhost" f ] [ "localhost" parse-host ] unit-test [ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test -[ "/foo" "localhost" 8888 ] [ "http://localhost:8888/foo" parse-url ] unit-test -[ "/" "localhost" 8888 ] [ "http://localhost:8888" parse-url ] unit-test [ "foo.txt" ] [ "http://www.paulgraham.com/foo.txt" download-name ] unit-test [ "foo.txt" ] [ "http://www.arc.com/foo.txt?xxx" download-name ] unit-test @@ -12,10 +10,11 @@ tuple-syntax namespaces ; [ TUPLE{ request + protocol: http method: "GET" host: "www.apple.com" - path: "/index.html" port: 80 + path: "/index.html" version: "1.1" cookies: V{ } header: H{ { "connection" "close" } } @@ -26,3 +25,21 @@ tuple-syntax namespaces ; ] with-scope ] unit-test + +[ + TUPLE{ request + protocol: https + method: "GET" + host: "www.amazon.com" + port: 443 + path: "/index.html" + version: "1.1" + cookies: V{ } + header: H{ { "connection" "close" } } + } +] [ + [ + "https://www.amazon.com/index.html" + + ] with-scope +] unit-test diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor index 17882277a3..cec1bb931a 100755 --- a/extra/http/client/client.factor +++ b/extra/http/client/client.factor @@ -19,22 +19,8 @@ DEFER: http-request r >>path r> dup [ query>assoc ] when >>query ; - -: request-with-url ( request url -- request ) - parse-url >r >r store-path r> >>host r> >>port ; - SYMBOL: redirects -: absolute-url? ( url -- ? ) - [ "http://" head? ] [ "https://" head? ] bi or ; - : do-redirect ( response data -- response data ) over code>> 300 399 between? [ drop @@ -42,7 +28,7 @@ SYMBOL: redirects redirects get max-redirects < [ request get swap "location" header dup absolute-url? - [ request-with-url ] [ store-path ] if + [ request-with-url ] [ request-with-path ] if "GET" >>method http-request ] [ too-many-redirects diff --git a/extra/http/http.factor b/extra/http/http.factor index 968d4d88ca..bbbebda53a 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -7,7 +7,7 @@ strings vectors hashtables quotations arrays byte-arrays math.parser calendar calendar.format io io.streams.string io.encodings.utf8 io.encodings.string -io.sockets +io.sockets io.sockets.secure unicode.case unicode.categories qualified ; @@ -15,9 +15,31 @@ EXCLUDE: fry => , ; IN: http -: http-port 80 ; inline +SINGLETON: http -: https-port 443 ; inline +SINGLETON: https + +GENERIC: http-port ( protocol -- port ) + +M: http http-port drop 80 ; + +M: https http-port drop 443 ; + +GENERIC: protocol>string ( protocol -- string ) + +M: http protocol>string drop "http" ; + +M: https protocol>string drop "https" ; + +: string>protocol ( string -- protocol ) + { + { "http" [ http ] } + { "https" [ https ] } + [ "Unknown protocol: " swap append throw ] + } case ; + +: absolute-url? ( url -- ? ) + [ "http://" head? ] [ "https://" head? ] bi or ; : url-quotable? ( ch -- ? ) #! In a URL, can this character be used without @@ -212,6 +234,7 @@ TUPLE: cookie name value path domain expires max-age http-only ; [ unparse-cookie ] map concat "; " join ; TUPLE: request +protocol host port method @@ -229,7 +252,7 @@ cookies ; : request new "1.1" >>version - http-port >>port + http >>protocol H{ } clone >>header H{ } clone >>query V{ } clone >>cookies @@ -242,6 +265,7 @@ cookies ; pick query>> set-at ; : chop-hostname ( str -- str' ) + ":" split1 nip CHAR: / over index over length or tail dup empty? [ drop "/" ] when ; @@ -249,7 +273,9 @@ cookies ; #! Technically, only proxies are meant to support hostnames #! in HTTP requests, but IE sends these sometimes so we #! just chop the hostname part. - url-decode "http://" ?head [ chop-hostname ] when ; + url-decode + dup { "http://" "https://" } [ head? ] with contains? + [ chop-hostname ] when ; : read-method ( request -- request ) " " read-until [ "Bad request: method" throw ] unless @@ -298,10 +324,11 @@ SYMBOL: max-post-request : parse-host ( string -- host port ) "." ?tail drop ":" split1 - [ string>number ] [ http-port ] if* ; + dup [ string>number ] when ; : extract-host ( request -- request ) - dup "host" header parse-host >r >>host r> >>port ; + dup [ "host" header parse-host ] keep protocol>> http-port or + [ >>host ] [ >>port ] bi* ; : extract-post-data-type ( request -- request ) dup "content-type" header >>post-data-type ; @@ -314,7 +341,7 @@ SYMBOL: max-post-request dup "cookie" header [ parse-cookies >>cookies ] when* ; : parse-content-type-attributes ( string -- attributes ) - " " split [ empty? not ] filter [ "=" split1 >r >lower r> ] { } map>assoc ; + " " split harvest [ "=" split1 >r >lower r> ] { } map>assoc ; : parse-content-type ( content-type -- type encoding ) ";" split1 parse-content-type-attributes "charset" swap at ; @@ -353,12 +380,20 @@ SYMBOL: max-post-request "application/x-www-form-urlencoded" >>post-data-type ] if ; +GENERIC: protocol-addr ( request protocol -- addr ) + +M: object protocol-addr + drop [ host>> ] [ port>> ] bi ; + +M: https protocol-addr + call-next-method ; + : request-addr ( request -- addr ) - [ host>> ] [ port>> ] bi ; + dup protocol>> protocol-addr ; : request-host ( request -- string ) - [ host>> ] [ port>> ] bi - dup 80 = [ drop ] [ ":" swap number>string 3append ] if ; + [ host>> ] [ port>> ] bi dup http http-port = + [ drop ] [ ":" swap number>string 3append ] if ; : write-request-header ( request -- request ) dup header>> >hashtable @@ -381,13 +416,32 @@ SYMBOL: max-post-request flush drop ; +: request-with-path ( request path -- request ) + [ "/" prepend ] [ "/" ] if* + "?" split1 [ >>path ] [ dup [ query>assoc ] when >>query ] bi* ; + +: request-with-url ( request url -- request ) + ":" split1 + [ string>protocol >>protocol ] + [ + "//" ?head [ "Invalid URL" throw ] unless + "/" split1 + [ + parse-host [ >>host ] [ >>port ] bi* + dup protocol>> http-port '[ , or ] change-port + ] + [ request-with-path ] + bi* + ] bi* ; + : request-url ( request -- url ) [ [ dup host>> [ - [ "http://" write host>> url-encode write ] - [ ":" write port>> number>string write ] - bi + [ protocol>> protocol>string write "://" write ] + [ host>> url-encode write ":" write ] + [ port>> number>string write ] + tri ] [ drop ] if ] [ path>> "/" head? [ "/" write ] unless ] diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index 70c1e9a1f5..4e561220f9 100755 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -240,7 +240,7 @@ SYMBOL: exit-continuation '[ exit-continuation set @ ] callcc1 exit-continuation off ; : split-path ( string -- path ) - "/" split [ empty? not ] filter ; + "/" split harvest ; : init-request ( -- ) H{ } clone base-paths set diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor index aecae1cf88..4194ff6609 100755 --- a/extra/koszul/koszul.factor +++ b/extra/koszul/koszul.factor @@ -148,7 +148,7 @@ DEFER: (d) : nth-basis-elt ( generators n -- elt ) over length [ 3dup bit? [ nth ] [ 2drop f ] if - ] map [ ] filter 2nip ; + ] map sift 2nip ; : basis ( generators -- seq ) natural-sort dup length 2^ [ nth-basis-elt ] with map ; diff --git a/extra/logging/server/server.factor b/extra/logging/server/server.factor index 3bc8637f90..a832b10a18 100755 --- a/extra/logging/server/server.factor +++ b/extra/logging/server/server.factor @@ -37,7 +37,7 @@ SYMBOL: log-files write bl write ": " write print ; : write-message ( msg word-name level -- ) - rot [ empty? not ] filter { + rot harvest { { [ dup empty? ] [ 3drop ] } { [ dup length 1 = ] [ first -rot f (write-message) ] } [ diff --git a/extra/peg/search/search.factor b/extra/peg/search/search.factor index 3da676dcb2..7ab7e83d12 100755 --- a/extra/peg/search/search.factor +++ b/extra/peg/search/search.factor @@ -17,14 +17,14 @@ MEMO: any-char-parser ( -- parser ) : search ( string parser -- seq ) any-char-parser [ drop f ] action 2array choice repeat0 parse dup [ - parse-result-ast [ ] filter + parse-result-ast sift ] [ drop { } ] if ; : (replace) ( string parser -- seq ) - any-char-parser 2array choice repeat0 parse parse-result-ast [ ] filter ; + any-char-parser 2array choice repeat0 parse parse-result-ast sift ; : replace ( string parser -- result ) [ (replace) [ tree-write ] each ] with-string-writer ; diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 0dc5601cd0..b703bb55a0 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -216,7 +216,7 @@ USE: continuations >r dup length swap r> [ = [ ] [ drop f ] if ] curry 2map - [ ] filter ; + sift ; vocab-author : vocab-xref ( vocab quot -- vocabs ) >r dup vocab-name swap words r> map [ [ word? ] filter [ word-vocabulary ] map ] map>set - remove [ ] filter [ vocab ] map ; inline + remove sift [ vocab ] map ; inline : vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ; diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor index 56a0fbc3ee..cf97bedb8d 100644 --- a/extra/ui/gadgets/tracks/tracks.factor +++ b/extra/ui/gadgets/tracks/tracks.factor @@ -8,7 +8,7 @@ TUPLE: track sizes ; : normalized-sizes ( track -- seq ) track-sizes - [ [ ] filter sum ] keep [ dup [ over / ] when ] map nip ; + [ sift sum ] keep [ dup [ over / ] when ] map nip ; : ( orientation -- track ) V{ } clone diff --git a/extra/ui/tools/tools-tests.factor b/extra/ui/tools/tools-tests.factor index 6d22083096..47b0d51705 100755 --- a/extra/ui/tools/tools-tests.factor +++ b/extra/ui/tools/tools-tests.factor @@ -17,7 +17,7 @@ IN: ui.tools.tests [ ] [ "w" get com-scroll-down ] unit-test [ t ] [ "w" get workspace-book gadget-children - [ tool-scroller ] map [ ] filter [ scroller? ] all? + [ tool-scroller ] map sift [ scroller? ] all? ] unit-test [ ] [ "w" get hide-popup ] unit-test [ ] [ "w" get show-popup ] unit-test diff --git a/extra/unicode/breaks/breaks.factor b/extra/unicode/breaks/breaks.factor index dfac27f7a4..53f81ccbf9 100755 --- a/extra/unicode/breaks/breaks.factor +++ b/extra/unicode/breaks/breaks.factor @@ -24,8 +24,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ; [ blank? ] right-trim ; : process-other-extend ( lines -- set ) - [ "#" split1 drop ";" split1 drop trim-blank ] map - [ empty? not ] filter + [ "#" split1 drop ";" split1 drop trim-blank ] map harvest [ ".." split1 [ dup ] unless* [ hex> ] bi@ [a,b] ] map concat unique ; diff --git a/extra/unicode/data/data.factor b/extra/unicode/data/data.factor index 52706647a9..b411e4e209 100755 --- a/extra/unicode/data/data.factor +++ b/extra/unicode/data/data.factor @@ -89,7 +89,7 @@ IN: unicode.data ] assoc-map >hashtable ; : multihex ( hexstring -- string ) - " " split [ hex> ] map [ ] filter ; + " " split [ hex> ] map sift ; TUPLE: code-point lower title upper ; diff --git a/extra/unicode/script/script.factor b/extra/unicode/script/script.factor index 846f797f71..2d07ba2caa 100755 --- a/extra/unicode/script/script.factor +++ b/extra/unicode/script/script.factor @@ -10,7 +10,7 @@ SYMBOL: interned : parse-script ( stream -- assoc ) ! assoc is code point/range => name - lines [ "#" split1 drop ] map [ empty? not ] filter [ + lines [ "#" split1 drop ] map harvest [ ";" split1 [ [ blank? ] trim ] bi@ ] H{ } map>assoc ; diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor index b3c803be2d..b63a5c3337 100755 --- a/extra/windows/com/syntax/syntax.factor +++ b/extra/windows/com/syntax/syntax.factor @@ -45,8 +45,7 @@ unless ; : parse-com-functions ( -- functions ) - ";" parse-tokens { ")" } split - [ empty? not ] filter + ";" parse-tokens { ")" } split harvest [ (parse-com-function) ] map ; : (iid-word) ( definition -- word ) diff --git a/extra/wrap/wrap.factor b/extra/wrap/wrap.factor index 9b1eeede96..29a8bbf10f 100644 --- a/extra/wrap/wrap.factor +++ b/extra/wrap/wrap.factor @@ -8,7 +8,7 @@ IN: wrap SYMBOL: width : line-chunks ( string -- words-lines ) - "\n" split [ " \t" split [ empty? not ] filter ] map ; + "\n" split [ " \t" split harvest ] map ; : (split-chunk) ( words -- ) -1 over [ length + 1+ dup width get > ] find drop nip