new accessors

db4
Doug Coleman 2008-08-29 10:27:31 -05:00
parent eb5e72c7d3
commit b839f608d0
4 changed files with 23 additions and 13 deletions

View File

@ -35,8 +35,8 @@ HELP: buffer
$nl $nl
"Buffers have two internal pointers:" "Buffers have two internal pointers:"
{ $list { $list
{ { $link buffer-fill } " - the fill pointer, a write index where new data is added" } { { $snippet "fill" } " - the fill pointer, a write index where new data is added" }
{ { $link buffer-pos } " - the position, a read index where data is consumed" } { { $snippet "pos" } " - the position, a read index where data is consumed" }
} } ; } } ;
HELP: <buffer> HELP: <buffer>

View File

@ -53,7 +53,7 @@ SYMBOL: +realtime-priority+
dup handle>> swap status>> or ; dup handle>> swap status>> or ;
: process-running? ( process -- ? ) : process-running? ( process -- ? )
process-handle >boolean ; handle>> >boolean ;
! Non-blocking process exit notification facility ! Non-blocking process exit notification facility
SYMBOL: processes SYMBOL: processes
@ -80,7 +80,7 @@ SYMBOL: wait-flag
V{ } clone swap processes get set-at V{ } clone swap processes get set-at
wait-flag get-global raise-flag ; wait-flag get-global raise-flag ;
M: process hashcode* process-handle hashcode* ; M: process hashcode* handle>> hashcode* ;
: pass-environment? ( process -- ? ) : pass-environment? ( process -- ? )
dup environment>> assoc-empty? not dup environment>> assoc-empty? not
@ -99,9 +99,14 @@ M: process hashcode* process-handle hashcode* ;
GENERIC: >process ( obj -- process ) GENERIC: >process ( obj -- process )
ERROR: process-already-started ;
M: process-already-started summary
drop "Process has already been started once" ;
M: process >process M: process >process
dup process-started? [ dup process-started? [
"Process has already been started once" throw process-already-started
] when ] when
clone ; clone ;
@ -111,6 +116,8 @@ HOOK: current-process-handle io-backend ( -- handle )
HOOK: run-process* io-backend ( process -- handle ) HOOK: run-process* io-backend ( process -- handle )
ERROR: process-was-killed ;
: wait-for-process ( process -- status ) : wait-for-process ( process -- status )
[ [
dup handle>> dup handle>>
@ -119,7 +126,7 @@ HOOK: run-process* io-backend ( process -- handle )
"process" suspend drop "process" suspend drop
] when ] when
dup killed>> dup killed>>
[ "Process was killed" throw ] [ status>> ] if [ process-was-killed ] [ status>> ] if
] with-timeout ; ] with-timeout ;
: run-detached ( desc -- process ) : run-detached ( desc -- process )
@ -150,7 +157,7 @@ HOOK: kill-process* io-backend ( handle -- )
M: process timeout timeout>> ; M: process timeout timeout>> ;
M: process set-timeout set-process-timeout ; M: process set-timeout swap >>timeout drop ;
M: process cancel-operation kill-process ; M: process cancel-operation kill-process ;
@ -222,10 +229,12 @@ GENERIC: underlying-handle ( stream -- handle )
M: port underlying-handle handle>> ; M: port underlying-handle handle>> ;
ERROR: invalid-duplex-stream ;
M: duplex-stream underlying-handle M: duplex-stream underlying-handle
[ in>> underlying-handle ] [ in>> underlying-handle ]
[ out>> underlying-handle ] bi [ out>> underlying-handle ] bi
[ = [ "Invalid duplex stream" throw ] when ] keep ; [ = [ invalid-duplex-stream ] when ] keep ;
M: encoder underlying-handle M: encoder underlying-handle
stream>> underlying-handle ; stream>> underlying-handle ;

View File

@ -2,14 +2,14 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel sequences words effects USING: parser kernel sequences words effects
stack-checker.transforms combinators assocs definitions stack-checker.transforms combinators assocs definitions
quotations namespaces memoize ; quotations namespaces memoize accessors ;
IN: macros IN: macros
: real-macro-effect ( word -- effect' ) : real-macro-effect ( word -- effect' )
"declared-effect" word-prop effect-in 1 <effect> ; "declared-effect" word-prop in>> 1 <effect> ;
: define-macro ( word definition -- ) : define-macro ( word definition -- )
over "declared-effect" word-prop effect-in length >r over "declared-effect" word-prop in>> length >r
2dup "macro" set-word-prop 2dup "macro" set-word-prop
2dup over real-macro-effect memoize-quot [ call ] append define 2dup over real-macro-effect memoize-quot [ call ] append define
r> define-transform ; r> define-transform ;

View File

@ -2,7 +2,8 @@ USING: arrays definitions io.streams.string io.streams.duplex
kernel math namespaces parser prettyprint prettyprint.config kernel math namespaces parser prettyprint prettyprint.config
prettyprint.sections sequences tools.test vectors words prettyprint.sections sequences tools.test vectors words
effects splitting generic.standard prettyprint.private effects splitting generic.standard prettyprint.private
continuations generic compiler.units tools.walker eval ; continuations generic compiler.units tools.walker eval
accessors ;
IN: prettyprint.tests IN: prettyprint.tests
[ "4" ] [ 4 unparse ] unit-test [ "4" ] [ 4 unparse ] unit-test
@ -296,7 +297,7 @@ M: class-see-layout class-see-layout ;
[ \ class-see-layout see-methods ] with-string-writer "\n" split [ \ class-see-layout see-methods ] with-string-writer "\n" split
] unit-test ] unit-test
[ ] [ \ effect-in synopsis drop ] unit-test [ ] [ \ in>> synopsis drop ] unit-test
! Regression ! Regression
[ t ] [ [ t ] [