steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

extra: "1 tail" is rest.

db4
John Benediktsson 2014-11-29 17:44:43 -08:00
parent 921e995ed9
commit bcbd6c55e4
2 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/imap/imap.factor
View File

@ -57,7 +57,7 @@ CONSTANT: IMAP4_SSL_PORT 993
read-?crlf drop read-?crlf drop
] if-empty t ] if-empty t
] ]
[ nip first 1 tail values f ] if-empty ; [ nip first rest values f ] if-empty ;
: read-response ( tag -- lines ) : read-response ( tag -- lines )
"^%s (BAD|NO|OK) (.*)$" sprintf "^%s (BAD|NO|OK) (.*)$" sprintf
@ -81,7 +81,7 @@ CONSTANT: IMAP4_SSL_PORT 993
: parse-list-folders ( str -- folder ) : parse-list-folders ( str -- folder )
"\\* LIST \\(([^\\)]+)\\) \"([^\"]+)\" \"([^\"]+)\"" pcre:findall "\\* LIST \\(([^\\)]+)\\) \"([^\"]+)\" \"([^\"]+)\"" pcre:findall
first 1 tail values [ utf7imap4 decode ] map ; first rest values [ utf7imap4 decode ] map ;
: parse-select-folder ( seq -- count ) : parse-select-folder ( seq -- count )
[ "\\* (\\d+) EXISTS" pcre:findall ] map harvest [ "\\* (\\d+) EXISTS" pcre:findall ] map harvest
@ -98,7 +98,7 @@ CONSTANT: IMAP4_SSL_PORT 993
: parse-store-mail-line ( str -- pair/f ) : parse-store-mail-line ( str -- pair/f )
"\\(FLAGS \\(([^\\)]+)\\) UID (\\d+)\\)" pcre:findall [ f ] [ "\\(FLAGS \\(([^\\)]+)\\) UID (\\d+)\\)" pcre:findall [ f ] [
first 1 tail values first2 [ " " split ] dip string>number swap 2array first rest values first2 [ " " split ] dip string>number swap 2array
] if-empty ; ] if-empty ;
: parse-store-mail ( seq -- assoc ) : parse-store-mail ( seq -- assoc )

2
extra/python/syntax/syntax.factor
View File

@ -46,7 +46,7 @@ SYMBOL: current-context
call-word obj-word def>> effect make-function-quot effect define-inline ; call-word obj-word def>> effect make-function-quot effect define-inline ;
: make-method-quot ( name effect -- quot ) : make-method-quot ( name effect -- quot )
[ in>> 1 tail gather-args-quot ] [ out>> unpack-value-quot ] bi swapd [ in>> rest gather-args-quot ] [ out>> unpack-value-quot ] bi swapd
'[ @ rot _ getattr -rot call-object-full @ ] ; '[ @ rot _ getattr -rot call-object-full @ ] ;
: method-callable ( name effect -- ) : method-callable ( name effect -- )