: sample-hash ( -- hash )
5 <hash2>
- dup 2 3 "foo" roll set-hash2
- dup 4 2 "bar" roll set-hash2
- dup 4 7 "other" roll set-hash2 ;
+ [ [ 2 3 "foo" ] dip set-hash2 ] keep
+ [ [ 4 2 "bar" ] dip set-hash2 ] keep
+ [ [ 4 7 "other" ] dip set-hash2 ] keep ;
[ "foo" ] [ 2 3 sample-hash hash2 ] unit-test
[ "bar" ] [ 4 2 sample-hash hash2 ] unit-test
-USING: kernel sequences arrays math vectors ;
+! Copyright (C) 2007 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences arrays math vectors locals ;
IN: hash2
! Little ad-hoc datastructure used to map two numbers
: assoc2 ( a b alist -- value )
(assoc2) dup [ third ] when ; inline
-: set-assoc2 ( value a b alist -- alist )
- [ rot 3array ] dip ?push ; inline
+:: set-assoc2 ( value a b alist -- alist )
+ { a b value } alist ?push ; inline
: hash2@ ( a b hash2 -- a b bucket hash2 )
[ 2dup hashcode2 ] dip [ length mod ] keep ; inline
: hash2 ( a b hash2 -- value/f )
hash2@ nth dup [ assoc2 ] [ 3drop f ] if ;
-: set-hash2 ( a b value hash2 -- )
- [ -rot ] dip hash2@ [ set-assoc2 ] change-nth ;
+:: set-hash2 ( a b value hash2 -- )
+ value a b hash2 hash2@ [ set-assoc2 ] change-nth ;
: alist>hash2 ( alist size -- hash2 )
<hash2> [ over [ first3 ] dip set-hash2 ] reduce ; inline
[ V{ "abc" "def" } ] [ "abc def" tokenize-command ] unit-test
[ V{ "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test
[ V{ "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test
-[ V{ "abc\\ def" } ] [ "'abc\\\\ def'" tokenize-command ] unit-test
-[ V{ "abc\\ def" } ] [ " 'abc\\\\ def'" tokenize-command ] unit-test
-[ V{ "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test
-[ V{ "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test
-[ "'abc def' \"hey" tokenize-command ] must-fail
-[ "'abc def" tokenize-command ] must-fail
-[ V{ "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\" " tokenize-command ] unit-test
+[ V{ "abc\\ def" } ] [ "\"abc\\\\ def\"" tokenize-command ] unit-test
+[ V{ "abc\\ def" } ] [ " \"abc\\\\ def\"" tokenize-command ] unit-test
+[ V{ "abc\\ def" "hey" } ] [ "\"abc\\\\ def\" hey" tokenize-command ] unit-test
+[ V{ "abc def" "hey" } ] [ "\"abc def\" \"hey\"" tokenize-command ] unit-test
+[ "\"abc def\" \"hey" tokenize-command ] must-fail
+[ "\"abc def" tokenize-command ] must-fail
+[ V{ "abc def" "h\"ey" } ] [ "\"abc def\" \"h\\\"ey\" " tokenize-command ] unit-test
[
V{
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: peg peg.parsers kernel sequences strings words ;
+USING: peg peg.ebnf arrays sequences strings kernel ;
IN: io.launcher.unix.parser
! Our command line parser. Supported syntax:
! foo bar baz -- simple tokens
! foo\ bar -- escaping the space
-! 'foo bar' -- quotation
! "foo bar" -- quotation
-: 'escaped-char' ( -- parser )
- "\\" token any-char 2seq [ second ] action ;
-
-: 'quoted-char' ( delimiter -- parser' )
- 'escaped-char'
- swap [ member? not ] curry satisfy
- 2choice ; inline
-
-: 'quoted' ( delimiter -- parser )
- dup 'quoted-char' repeat0 swap dup surrounded-by ;
-
-: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ;
-
-: 'argument' ( -- parser )
- "\"" 'quoted'
- "'" 'quoted'
- 'unquoted' 3choice
- [ >string ] action ;
-
-PEG: tokenize-command ( command -- ast/f )
- 'argument' " " token repeat1 list-of
- " " token repeat0 tuck pack
- just ;
+EBNF: tokenize-command
+space = " "
+escaped-char = "\" .:ch => [[ ch ]]
+quoted = '"' (escaped-char | [^"])*:a '"' => [[ a ]]
+unquoted = (escaped-char | [^ "])+
+argument = (quoted | unquoted) => [[ >string ]]
+command = space* (argument:a space* => [[ a ]])+:c !(.) => [[ c ]]
+;EBNF
] with-destructors ;
: <client> ( remote encoding -- stream local )
- [ (client) -rot ] dip <encoder-duplex> swap ;
+ [ (client) ] dip swap [ <encoder-duplex> ] dip ;
SYMBOL: local-address
: deep-sequence>cons ( sequence -- cons )
[ <reversed> ] keep nil
- [ tuck same? [ deep-sequence>cons ] when swons ] with reduce ;
+ [ [ nip ] [ same? ] 2bi [ deep-sequence>cons ] when swons ]
+ with reduce ;
<PRIVATE
:: (lmap>vector) ( acc list quot: ( elt -- elt' ) -- acc )
} cond ;
: match-replace ( object pattern1 pattern2 -- result )
- -rot
- match [ "Pattern does not match" throw ] unless*
+ [ match [ "Pattern does not match" throw ] unless* ] dip swap
[ replace-patterns ] bind ;
: ?1-tail ( seq -- tail/f )
: encode-header ( string -- string' )
dup aux>> [
- "=?utf-8?B?"
- swap utf8 encode >base64
- "?=" 3append
+ utf8 encode >base64
+ "=?utf-8?B?" "?=" surround
] when ;
ERROR: invalid-header-string string ;
now timestamp>rfc822 "Date" set
message-id "Message-Id" set
"1.0" "MIME-Version" set
- "base64" "Content-Transfer-Encoding" set
+ "quoted-printable" "Content-Transfer-Encoding" set
{
[ from>> "From" set ]
[ to>> ", " join "To" set ]
USING: accessors kernel arrays sequences math namespaces
strings io fry vectors words assocs combinators sorting
unicode.case unicode.categories math.order vocabs
-tools.vocabs unicode.data ;
+tools.vocabs unicode.data locals ;
IN: tools.completion
-: (fuzzy) ( accum ch i full -- accum i ? )
- index-from
- [
- [ swap push ] 2keep 1+ t
+:: (fuzzy) ( accum i full ch -- accum i full ? )
+ ch i full index-from [
+ :> i i accum push
+ accum i 1+ full t
] [
- drop f -1 f
+ f -1 full f
] if* ;
: fuzzy ( full short -- indices )
- dup length <vector> -rot 0 -rot
- [ -rot [ (fuzzy) ] keep swap ] all? 3drop ;
+ dup [ length <vector> 0 ] curry 2dip
+ [ (fuzzy) ] all? 3drop ;
: (runs) ( runs n seq -- runs n )
[
USING: accessors arrays hashtables kernel models math namespaces
make sequences quotations math.vectors combinators sorting
binary-search vectors dlists deques models threads
-concurrency.flags math.order math.rectangles fry ;
+concurrency.flags math.order math.rectangles fry locals ;
IN: ui.gadgets
! Values for orientation slot
: ((fast-children-on)) ( gadget dim axis -- <=> )
[ swap loc>> v- ] dip v. 0 <=> ;
-: (fast-children-on) ( dim axis children -- i )
- -rot '[ _ _ ((fast-children-on)) ] search drop ;
+:: (fast-children-on) ( dim axis children -- i )
+ children [ dim axis ((fast-children-on)) ] search drop ;
PRIVATE>