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

Fix duplex-stream set-timeout

db4
Slava Pestov 2008-02-10 01:39:21 -06:00
parent f052852a27
commit b120abcee2
1 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
extra/io/timeouts/timeouts.factor
View File

@ -8,15 +8,14 @@ TUPLE: lapse entry timeout cutoff ;
: <lapse> f 0 0 \ lapse construct-boa ; : <lapse> f 0 0 \ lapse construct-boa ;
! Won't need this with new slot accessors
GENERIC: get-lapse ( obj -- lapse ) GENERIC: get-lapse ( obj -- lapse )
GENERIC: set-timeout ( ms obj -- ) GENERIC: set-timeout ( ms obj -- )
M: object set-timeout get-lapse set-lapse-timeout ; M: object set-timeout get-lapse set-timeout ;
M: duplex-stream set-timeout M: lapse set-timeout set-lapse-timeout ;
2dup
duplex-stream-in set-timeout
duplex-stream-out set-timeout ;
: timeout ( obj -- ms ) get-lapse lapse-timeout ; : timeout ( obj -- ms ) get-lapse lapse-timeout ;
: entry ( obj -- dlist-node ) get-lapse lapse-entry ; : entry ( obj -- dlist-node ) get-lapse lapse-entry ;
@ -24,6 +23,16 @@ M: duplex-stream set-timeout
: cutoff ( obj -- ms ) get-lapse lapse-cutoff ; : cutoff ( obj -- ms ) get-lapse lapse-cutoff ;
: set-cutoff ( ms obj -- ) get-lapse set-lapse-cutoff ; : set-cutoff ( ms obj -- ) get-lapse set-lapse-cutoff ;
! Won't need this with inheritance
TUPLE: duplex-stream-lapse stream ;
M: duplex-stream-lapse set-timeout
duplex-stream-lapse-stream 2dup
duplex-stream-in set-timeout
duplex-stream-out set-timeout ;
M: duplex-stream get-lapse duplex-stream-lapse construct-boa ;
SYMBOL: timeout-queue SYMBOL: timeout-queue
: timeout? ( lapse -- ? ) : timeout? ( lapse -- ? )