Merge branch 'master' of git://factorcode.org/git/factor
U-C4\Administrator
commit
1e0ed4f4de
|
|
@ -259,8 +259,9 @@ M: long-long-type box-return ( type -- )
|
|||
[ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
|
||||
(( value -- c-ptr )) define-inline ;
|
||||
|
||||
: c-bool> ( int -- ? )
|
||||
0 = not ; inline
|
||||
: >c-bool ( ? -- int ) 1 0 ? ; inline
|
||||
|
||||
: c-bool> ( int -- ? ) 0 = not ; inline
|
||||
|
||||
: define-primitive-type ( type name -- )
|
||||
[ typedef ]
|
||||
|
|
@ -409,8 +410,8 @@ CONSTANT: primitive-types
|
|||
"uchar" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
[ alien-unsigned-1 zero? not ] >>getter
|
||||
[ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
|
||||
[ alien-unsigned-1 c-bool> ] >>getter
|
||||
[ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
|
||||
1 >>size
|
||||
1 >>align
|
||||
"box_boolean" >>boxer
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ IN: base64.tests
|
|||
|
||||
[ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
|
||||
] unit-test
|
||||
[ f ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
|
||||
[ "" ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
|
||||
[ "a" ] [ "a" ascii encode >base64 base64> ascii decode ] unit-test
|
||||
[ "ab" ] [ "ab" ascii encode >base64 base64> ascii decode ] unit-test
|
||||
[ "abc" ] [ "abc" ascii encode >base64 base64> ascii decode ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,11 +2,11 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs sequences kernel combinators make math
|
||||
math.order math.ranges system namespaces locals layouts words
|
||||
alien alien.c-types literals cpu.architecture cpu.ppc.assembler
|
||||
cpu.ppc.assembler.backend literals compiler.cfg.registers
|
||||
alien alien.accessors alien.c-types literals cpu.architecture
|
||||
cpu.ppc.assembler cpu.ppc.assembler.backend literals compiler.cfg.registers
|
||||
compiler.cfg.instructions compiler.constants compiler.codegen
|
||||
compiler.codegen.fixup compiler.cfg.intrinsics
|
||||
compiler.cfg.stack-frame ;
|
||||
compiler.cfg.stack-frame compiler.units ;
|
||||
IN: cpu.ppc
|
||||
|
||||
! PowerPC register assignments:
|
||||
|
|
@ -713,4 +713,14 @@ USE: vocabs.loader
|
|||
} cond
|
||||
|
||||
"complex-double" c-type t >>return-in-registers? drop
|
||||
"bool" c-type 4 >>size 4 >>align drop
|
||||
|
||||
[
|
||||
<c-type>
|
||||
[ alien-unsigned-4 c-bool> ] >>getter
|
||||
[ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter
|
||||
4 >>size
|
||||
4 >>align
|
||||
"box_boolean" >>boxer
|
||||
"to_boolean" >>unboxer
|
||||
"bool" define-primitive-type
|
||||
] with-compilation-unit
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@ IN: urls.encoding.tests
|
|||
USING: urls.encoding tools.test arrays kernel assocs present accessors ;
|
||||
|
||||
[ "~hello world" ] [ "%7ehello world" url-decode ] unit-test
|
||||
[ f ] [ "%XX%XX%XX" url-decode ] unit-test
|
||||
[ f ] [ "%XX%XX%X" url-decode ] unit-test
|
||||
[ "" ] [ "%XX%XX%XX" url-decode ] unit-test
|
||||
[ "" ] [ "%XX%XX%X" url-decode ] unit-test
|
||||
|
||||
[ "hello world" ] [ "hello%20world" url-decode ] unit-test
|
||||
[ " ! " ] [ "%20%21%20" url-decode ] unit-test
|
||||
|
|
|
|||
|
|
@ -25,12 +25,14 @@ TUPLE: url protocol username password host port path query anchor ;
|
|||
] if ;
|
||||
|
||||
: parse-host ( string -- host port )
|
||||
":" split1 [ url-decode ] [
|
||||
dup [
|
||||
string>number
|
||||
dup [ "Invalid port" throw ] unless
|
||||
] when
|
||||
] bi* ;
|
||||
[
|
||||
":" split1 [ url-decode ] [
|
||||
dup [
|
||||
string>number
|
||||
dup [ "Invalid port" throw ] unless
|
||||
] when
|
||||
] bi*
|
||||
] [ f f ] if* ;
|
||||
|
||||
GENERIC: >url ( obj -- url )
|
||||
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ C: <rsa> rsa
|
|||
CONSTANT: public-key 65537
|
||||
|
||||
: rsa-primes ( numbits -- p q )
|
||||
2/ 2 unique-primes first2 ;
|
||||
2/ 2 swap unique-primes first2 ;
|
||||
|
||||
: modulus-phi ( numbits -- n phi )
|
||||
#! Loop until phi is not divisible by the public key.
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Bruno Deferrari
|
||||
|
|
@ -0,0 +1 @@
|
|||
Bruno Deferrari
|
||||
|
|
@ -0,0 +1,138 @@
|
|||
! Copyright (C) 2009 Bruno Deferrari
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test redis.command-writer io.streams.string ;
|
||||
IN: redis.command-writer.tests
|
||||
|
||||
#! Connection
|
||||
[ "QUIT\r\n" ] [ [ quit ] with-string-writer ] unit-test
|
||||
|
||||
[ "PING\r\n" ] [ [ ping ] with-string-writer ] unit-test
|
||||
|
||||
[ "AUTH password\r\n" ] [ [ "password" auth ] with-string-writer ] unit-test
|
||||
|
||||
#! String values
|
||||
[ "SET key 3\r\nfoo\r\n" ] [ [ "foo" "key" set ] with-string-writer ] unit-test
|
||||
|
||||
[ "GET key\r\n" ] [ [ "key" get ] with-string-writer ] unit-test
|
||||
|
||||
[ "GETSET key 3\r\nfoo\r\n" ] [
|
||||
[ "foo" "key" getset ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "MGET key1 key2 key3\r\n" ] [
|
||||
[ { "key1" "key2" "key3" } mget ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "SETNX key 3\r\nfoo\r\n" ] [
|
||||
[ "foo" "key" setnx ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "INCR key\r\n" ] [ [ "key" incr ] with-string-writer ] unit-test
|
||||
|
||||
[ "INCRBY key 7\r\n" ] [ [ 7 "key" incrby ] with-string-writer ] unit-test
|
||||
|
||||
[ "DECR key\r\n" ] [ [ "key" decr ] with-string-writer ] unit-test
|
||||
|
||||
[ "DECRBY key 7\r\n" ] [ [ 7 "key" decrby ] with-string-writer ] unit-test
|
||||
|
||||
[ "EXISTS key\r\n" ] [ [ "key" exists ] with-string-writer ] unit-test
|
||||
|
||||
[ "DEL key\r\n" ] [ [ "key" del ] with-string-writer ] unit-test
|
||||
|
||||
[ "TYPE key\r\n" ] [ [ "key" type ] with-string-writer ] unit-test
|
||||
|
||||
#! Key space
|
||||
[ "KEYS pat*\r\n" ] [ [ "pat*" keys ] with-string-writer ] unit-test
|
||||
|
||||
[ "RANDOMKEY\r\n" ] [ [ randomkey ] with-string-writer ] unit-test
|
||||
|
||||
[ "RENAME key newkey\r\n" ] [
|
||||
[ "newkey" "key" rename ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "RENAMENX key newkey\r\n" ] [
|
||||
[ "newkey" "key" renamenx ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "DBSIZE\r\n" ] [ [ dbsize ] with-string-writer ] unit-test
|
||||
|
||||
[ "EXPIRE key 7\r\n" ] [ [ 7 "key" expire ] with-string-writer ] unit-test
|
||||
|
||||
#! Lists
|
||||
[ "RPUSH key 3\r\nfoo\r\n" ] [ [ "foo" "key" rpush ] with-string-writer ] unit-test
|
||||
|
||||
[ "LPUSH key 3\r\nfoo\r\n" ] [ [ "foo" "key" lpush ] with-string-writer ] unit-test
|
||||
|
||||
[ "LLEN key\r\n" ] [ [ "key" llen ] with-string-writer ] unit-test
|
||||
|
||||
[ "LRANGE key 5 9\r\n" ] [ [ 5 9 "key" lrange ] with-string-writer ] unit-test
|
||||
|
||||
[ "LTRIM key 5 9\r\n" ] [ [ 5 9 "key" ltrim ] with-string-writer ] unit-test
|
||||
|
||||
[ "LINDEX key 7\r\n" ] [ [ 7 "key" lindex ] with-string-writer ] unit-test
|
||||
|
||||
[ "LSET key 0 3\r\nfoo\r\n" ] [ [ "foo" 0 "key" lset ] with-string-writer ] unit-test
|
||||
|
||||
[ "LREM key 1 3\r\nfoo\r\n" ] [ [ "foo" 1 "key" lrem ] with-string-writer ] unit-test
|
||||
|
||||
[ "LPOP key\r\n" ] [ [ "key" lpop ] with-string-writer ] unit-test
|
||||
|
||||
[ "RPOP key\r\n" ] [ [ "key" rpop ] with-string-writer ] unit-test
|
||||
|
||||
#! Sets
|
||||
[ "SADD key 3\r\nfoo\r\n" ] [ [ "foo" "key" sadd ] with-string-writer ] unit-test
|
||||
|
||||
[ "SREM key 3\r\nfoo\r\n" ] [ [ "foo" "key" srem ] with-string-writer ] unit-test
|
||||
|
||||
[ "SMOVE srckey dstkey 3\r\nfoo\r\n" ] [
|
||||
[ "foo" "dstkey" "srckey" smove ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "SCARD key\r\n" ] [ [ "key" scard ] with-string-writer ] unit-test
|
||||
|
||||
[ "SISMEMBER key 3\r\nfoo\r\n" ] [
|
||||
[ "foo" "key" sismember ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "SINTER key1 key2 key3\r\n" ] [
|
||||
[ { "key1" "key2" "key3" } sinter ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "SINTERSTORE dstkey key1 key2 key3\r\n" ] [
|
||||
[ { "key1" "key2" "key3" } "dstkey" sinterstore ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "SUNION key1 key2 key3\r\n" ] [
|
||||
[ { "key1" "key2" "key3" } sunion ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "SUNIONSTORE dstkey key1 key2 key3\r\n" ] [
|
||||
[ { "key1" "key2" "key3" } "dstkey" sunionstore ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "SMEMBERS key\r\n" ] [ [ "key" smembers ] with-string-writer ] unit-test
|
||||
|
||||
#! Multiple db
|
||||
[ "SELECT 2\r\n" ] [ [ 2 select ] with-string-writer ] unit-test
|
||||
|
||||
[ "MOVE key 2\r\n" ] [ [ 2 "key" move ] with-string-writer ] unit-test
|
||||
|
||||
[ "FLUSHDB\r\n" ] [ [ flushdb ] with-string-writer ] unit-test
|
||||
|
||||
[ "FLUSHALL\r\n" ] [ [ flushall ] with-string-writer ] unit-test
|
||||
|
||||
#! Sorting
|
||||
|
||||
#! Persistence control
|
||||
[ "SAVE\r\n" ] [ [ save ] with-string-writer ] unit-test
|
||||
|
||||
[ "BGSAVE\r\n" ] [ [ bgsave ] with-string-writer ] unit-test
|
||||
|
||||
[ "LASTSAVE\r\n" ] [ [ lastsave ] with-string-writer ] unit-test
|
||||
|
||||
[ "SHUTDOWN\r\n" ] [ [ shutdown ] with-string-writer ] unit-test
|
||||
|
||||
#! Remote server control
|
||||
[ "INFO\r\n" ] [ [ info ] with-string-writer ] unit-test
|
||||
|
||||
[ "MONITOR\r\n" ] [ [ monitor ] with-string-writer ] unit-test
|
||||
|
|
@ -0,0 +1,104 @@
|
|||
! Copyright (C) 2009 Bruno Deferrari
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io io.crlf kernel math.parser sequences strings interpolate locals ;
|
||||
IN: redis.command-writer
|
||||
|
||||
<PRIVATE
|
||||
|
||||
GENERIC: write-value-with-length ( value -- )
|
||||
|
||||
M: string write-value-with-length
|
||||
[ length number>string write crlf ]
|
||||
[ write ] bi ;
|
||||
|
||||
: space ( -- ) CHAR: space write1 ;
|
||||
|
||||
: write-key/value ( value key -- )
|
||||
write space
|
||||
write-value-with-length ;
|
||||
|
||||
: write-key/integer ( integer key -- )
|
||||
write space
|
||||
number>string write ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
#! Connection
|
||||
: quit ( -- ) "QUIT" write crlf ;
|
||||
: ping ( -- ) "PING" write crlf ;
|
||||
: auth ( password -- ) "AUTH " write write crlf ;
|
||||
|
||||
#! String values
|
||||
: set ( value key -- ) "SET " write write-key/value crlf ;
|
||||
: get ( key -- ) "GET " write write crlf ;
|
||||
: getset ( value key -- ) "GETSET " write write-key/value crlf ;
|
||||
: mget ( keys -- ) "MGET " write " " join write crlf ;
|
||||
: setnx ( value key -- ) "SETNX " write write-key/value crlf ;
|
||||
: incr ( key -- ) "INCR " write write crlf ;
|
||||
: incrby ( integer key -- ) "INCRBY " write write-key/integer crlf ;
|
||||
: decr ( key -- ) "DECR " write write crlf ;
|
||||
: decrby ( integer key -- ) "DECRBY " write write-key/integer crlf ;
|
||||
: exists ( key -- ) "EXISTS " write write crlf ;
|
||||
: del ( key -- ) "DEL " write write crlf ;
|
||||
: type ( key -- ) "TYPE " write write crlf ;
|
||||
|
||||
#! Key space
|
||||
: keys ( pattern -- ) "KEYS " write write crlf ;
|
||||
: randomkey ( -- ) "RANDOMKEY" write crlf ;
|
||||
: rename ( newkey key -- ) "RENAME " write write space write crlf ;
|
||||
: renamenx ( newkey key -- ) "RENAMENX " write write space write crlf ;
|
||||
: dbsize ( -- ) "DBSIZE" write crlf ;
|
||||
: expire ( integer key -- ) "EXPIRE " write write-key/integer crlf ;
|
||||
|
||||
#! Lists
|
||||
: rpush ( value key -- ) "RPUSH " write write-key/value crlf ;
|
||||
: lpush ( value key -- ) "LPUSH " write write-key/value crlf ;
|
||||
: llen ( key -- ) "LLEN " write write crlf ;
|
||||
: lrange ( start end key -- )
|
||||
"LRANGE " write write [ space number>string write ] bi@ crlf ;
|
||||
: ltrim ( start end key -- )
|
||||
"LTRIM " write write [ space number>string write ] bi@ crlf ;
|
||||
: lindex ( integer key -- ) "LINDEX " write write-key/integer crlf ;
|
||||
: lset ( value index key -- )
|
||||
"LSET " write write-key/integer space write-value-with-length crlf ;
|
||||
: lrem ( value amount key -- )
|
||||
"LREM " write write-key/integer space write-value-with-length crlf ;
|
||||
: lpop ( key -- ) "LPOP " write write crlf ;
|
||||
: rpop ( key -- ) "RPOP " write write crlf ;
|
||||
|
||||
#! Sets
|
||||
: sadd ( member key -- )
|
||||
"SADD " write write space write-value-with-length crlf ;
|
||||
: srem ( member key -- )
|
||||
"SREM " write write space write-value-with-length crlf ;
|
||||
: smove ( member newkey key -- )
|
||||
"SMOVE " write write space write space write-value-with-length crlf ;
|
||||
: scard ( key -- ) "SCARD " write write crlf ;
|
||||
: sismember ( member key -- )
|
||||
"SISMEMBER " write write space write-value-with-length crlf ;
|
||||
: sinter ( keys -- ) "SINTER " write " " join write crlf ;
|
||||
: sinterstore ( keys destkey -- )
|
||||
"SINTERSTORE " write write space " " join write crlf ;
|
||||
: sunion ( keys -- ) "SUNION " write " " join write crlf ;
|
||||
: sunionstore ( keys destkey -- )
|
||||
"SUNIONSTORE " write write " " join space write crlf ;
|
||||
: smembers ( key -- ) "SMEMBERS " write write crlf ;
|
||||
|
||||
#! Multiple db
|
||||
: select ( integer -- ) "SELECT " write number>string write crlf ;
|
||||
: move ( integer key -- ) "MOVE " write write-key/integer crlf ;
|
||||
: flushdb ( -- ) "FLUSHDB" write crlf ;
|
||||
: flushall ( -- ) "FLUSHALL" write crlf ;
|
||||
|
||||
#! Sorting
|
||||
! sort
|
||||
|
||||
#! Persistence control
|
||||
: save ( -- ) "SAVE" write crlf ;
|
||||
: bgsave ( -- ) "BGSAVE" write crlf ;
|
||||
: lastsave ( -- ) "LASTSAVE" write crlf ;
|
||||
: shutdown ( -- ) "SHUTDOWN" write crlf ;
|
||||
|
||||
#! Remote server control
|
||||
: info ( -- ) "INFO" write crlf ;
|
||||
: monitor ( -- ) "MONITOR" write crlf ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Definitions of messages sent to Redis
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
! Copyright (C) 2009 Bruno Deferrari
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io redis.response-parser redis.command-writer ;
|
||||
IN: redis
|
||||
|
||||
#! Connection
|
||||
: redis-quit ( -- ) quit flush ;
|
||||
: redis-ping ( -- response ) ping flush read-response ;
|
||||
: redis-auth ( password -- response ) auth flush read-response ;
|
||||
|
||||
#! String values
|
||||
: redis-set ( value key -- response ) set flush read-response ;
|
||||
: redis-get ( key -- response ) get flush read-response ;
|
||||
: redis-getset ( value key -- response ) getset flush read-response ;
|
||||
: redis-mget ( keys -- response ) mget flush read-response ;
|
||||
: redis-setnx ( value key -- response ) setnx flush read-response ;
|
||||
: redis-incr ( key -- response ) incr flush read-response ;
|
||||
: redis-incrby ( integer key -- response ) incrby flush read-response ;
|
||||
: redis-decr ( key -- response ) decr flush read-response ;
|
||||
: redis-decrby ( integer key -- response ) decrby flush read-response ;
|
||||
: redis-exists ( key -- response ) exists flush read-response ;
|
||||
: redis-del ( key -- response ) del flush read-response ;
|
||||
: redis-type ( key -- response ) type flush read-response ;
|
||||
|
||||
#! Key space
|
||||
: redis-keys ( pattern -- response ) keys flush read-response ;
|
||||
: redis-randomkey ( -- response ) randomkey flush read-response ;
|
||||
: redis-rename ( newkey key -- response ) rename flush read-response ;
|
||||
: redis-renamenx ( newkey key -- response ) renamenx flush read-response ;
|
||||
: redis-dbsize ( -- response ) dbsize flush read-response ;
|
||||
: redis-expire ( integer key -- response ) expire flush read-response ;
|
||||
|
||||
#! Lists
|
||||
: redis-rpush ( value key -- response ) rpush flush read-response ;
|
||||
: redis-lpush ( value key -- response ) lpush flush read-response ;
|
||||
: redis-llen ( key -- response ) llen flush read-response ;
|
||||
: redis-lrange ( start end key -- response ) lrange flush read-response ;
|
||||
: redis-ltrim ( start end key -- response ) ltrim flush read-response ;
|
||||
: redis-lindex ( integer key -- response ) lindex flush read-response ;
|
||||
: redis-lset ( value index key -- response ) lset flush read-response ;
|
||||
: redis-lrem ( value amount key -- response ) lrem flush read-response ;
|
||||
: redis-lpop ( key -- response ) lpop flush read-response ;
|
||||
: redis-rpop ( key -- response ) rpop flush read-response ;
|
||||
|
||||
#! Sets
|
||||
: redis-sadd ( member key -- response ) sadd flush read-response ;
|
||||
: redis-srem ( member key -- response ) srem flush read-response ;
|
||||
: redis-smove ( member newkey key -- response ) smove flush read-response ;
|
||||
: redis-scard ( key -- response ) scard flush read-response ;
|
||||
: redis-sismember ( member key -- response ) sismember flush read-response ;
|
||||
: redis-sinter ( keys -- response ) sinter flush read-response ;
|
||||
: redis-sinterstore ( keys destkey -- response ) sinterstore flush read-response ;
|
||||
: redis-sunion ( keys -- response ) sunion flush read-response ;
|
||||
: redis-sunionstore ( keys destkey -- response ) sunionstore flush read-response ;
|
||||
: redis-smembers ( key -- response ) smembers flush read-response ;
|
||||
|
||||
#! Multiple db
|
||||
: redis-select ( integer -- response ) select flush read-response ;
|
||||
: redis-move ( integer key -- response ) move flush read-response ;
|
||||
: redis-flushdb ( -- response ) flushdb flush read-response ;
|
||||
: redis-flushall ( -- response ) flushall flush read-response ;
|
||||
|
||||
#! Sorting
|
||||
! sort
|
||||
|
||||
#! Persistence control
|
||||
: redis-save ( -- response ) save flush read-response ;
|
||||
: redis-bgsave ( -- response ) bgsave flush read-response ;
|
||||
: redis-lastsave ( -- response ) lastsave flush read-response ;
|
||||
: redis-shutdown ( -- response ) shutdown flush read-response ;
|
||||
|
||||
#! Remote server control
|
||||
: redis-info ( -- response ) info flush read-response ;
|
||||
: redis-monitor ( -- response ) monitor flush read-response ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Bruno Deferrari
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
! Copyright (C) 2009 Bruno Deferrari
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test redis.response-parser io.streams.string ;
|
||||
IN: redis.response-parser.tests
|
||||
|
||||
[ 1 ] [ ":1\r\n" [ read-response ] with-string-reader ] unit-test
|
||||
|
||||
[ "hello" ] [ "$5\r\nhello\r\n" [ read-response ] with-string-reader ] unit-test
|
||||
|
||||
[ f ] [ "$-1\r\n" [ read-response ] with-string-reader ] unit-test
|
||||
|
||||
[ { "hello" "world!" } ] [
|
||||
"*2\r\n$5\r\nhello\r\n$6\r\nworld!\r\n" [ read-response ] with-string-reader
|
||||
] unit-test
|
||||
|
||||
[ { "hello" f "world!" } ] [
|
||||
"*3\r\n$5\r\nhello\r\n$-1\r\n$6\r\nworld!\r\n" [
|
||||
read-response
|
||||
] with-string-reader
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
! Copyright (C) 2009 Bruno Deferrari
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators io kernel math math.parser sequences ;
|
||||
IN: redis.response-parser
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: read-bulk ( n -- bytes ) dup 0 < [ drop f ] [ read 2 read drop ] if ;
|
||||
: (read-multi-bulk) ( -- bytes ) readln rest string>number read-bulk ;
|
||||
: read-multi-bulk ( n -- seq/f )
|
||||
dup 0 < [ drop f ] [
|
||||
iota [ drop (read-multi-bulk) ] map
|
||||
] if ;
|
||||
|
||||
: handle-response ( string -- string ) ; ! TODO
|
||||
: handle-error ( string -- string ) ; ! TODO
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: read-response ( -- response )
|
||||
readln unclip {
|
||||
{ CHAR: : [ string>number ] }
|
||||
{ CHAR: + [ handle-response ] }
|
||||
{ CHAR: $ [ string>number read-bulk ] }
|
||||
{ CHAR: * [ string>number read-multi-bulk ] }
|
||||
{ CHAR: - [ handle-error ] }
|
||||
} case ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Parser for responses sent by the Redis server
|
||||
|
|
@ -0,0 +1 @@
|
|||
Words for communicating with the Redis key-value database
|
||||
Loading…
Reference in New Issue