]> gitweb.factorcode.org Git - factor.git/commitdiff
Remove some usages of -rot and tuck
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sun, 19 Apr 2009 02:53:22 +0000 (21:53 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sun, 19 Apr 2009 02:53:22 +0000 (21:53 -0500)
basis/hash2/hash2-tests.factor
basis/hash2/hash2.factor
basis/io/launcher/unix/parser/parser-tests.factor
basis/io/launcher/unix/parser/parser.factor
basis/io/sockets/sockets.factor
basis/lists/lists.factor
basis/match/match.factor
basis/smtp/smtp.factor
basis/tools/completion/completion.factor
basis/ui/gadgets/gadgets.factor

index 15bbcb36ef518acc702e601fdb87aa7a50357d76..682680bc508e97667a1a172b03047d51fae2b21a 100644 (file)
@@ -6,9 +6,9 @@ IN: hash2.tests
 
 : 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
index ffe6926130bc6dbfba7817b77217a3e55cf57868..aadc0d45a2299dee35d782f3820d9f41a3918d97 100644 (file)
@@ -1,4 +1,6 @@
-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
@@ -22,8 +24,8 @@ IN: hash2
 : 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
@@ -31,8 +33,8 @@ IN: hash2
 : 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
index 07502e87a42f5fe2481bcb7d3dc8dbedbc8a5e6d..90504ccac2a1a4c460dfcf7c014057f0071b0c40 100644 (file)
@@ -10,13 +10,13 @@ USING: io.launcher.unix.parser tools.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" } ] [ "  '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{
index 97e6dee95fc2a2cd1edddf8dbad169520706a0d3..bcc5f965e9e2340e1f8e5432c3614685d48b3a4b 100644 (file)
@@ -1,33 +1,17 @@
 ! 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
index 8dce5275531aa0f218122220a4d70c2dfb1e55e9..a0beb1f421b3ac20602737ef597a49b859cd7c52 100644 (file)
@@ -192,7 +192,7 @@ M: object (client) ( remote -- client-in client-out local )
     ] with-destructors ;
 
 : <client> ( remote encoding -- stream local )
-    [ (client) -rot ] dip <encoder-duplex> swap ;
+    [ (client) ] dip swap [ <encoder-duplex> ] dip ;
 
 SYMBOL: local-address
 
index 4b0abb7f2d6d249b634c6d5702b60903ebe5f235..fecb76f1c0ac33e60bd7d85d6bfdda8b4e4500d3 100644 (file)
@@ -106,7 +106,8 @@ PRIVATE>
 
 : 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 )
index b21d8c6d733983bf237c6fc521dcdb16da43769a..ec0cb8c9e6bf70d1567026e37a07162c848a7355 100644 (file)
@@ -62,8 +62,7 @@ MACRO: match-cond ( assoc -- )
     } 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 )
index 822fc920903f9c595bbe2239ac3e848e849f37ac..605423820b2c15b0f7ec1d1ec1dd1bf3fa670b24 100644 (file)
@@ -164,9 +164,8 @@ M: plain-auth send-auth
 
 : 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 ;
@@ -205,7 +204,7 @@ 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 ]
index 14cec8e85fc32db68027a4a874f1913774a27d43..99def097a25977126796ac2d3417f8fce55d9069 100644 (file)
@@ -3,20 +3,20 @@
 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 )
     [
index bc07006d623d8c5efffb4a531b41c105b23cdd0f..32d6c0c8a65cd7d1f9ed5cc082f5a0b452726ab6 100644 (file)
@@ -3,7 +3,7 @@
 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
@@ -66,8 +66,8 @@ M: gadget children-on nip children>> ;
 : ((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>