remove 1+ a couple places, working on compile errors
parent
b91e8cbdaf
commit
e9e4028999
|
@ -25,7 +25,7 @@ IN: advice.tests
|
||||||
foo
|
foo
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
: bar ( a -- b ) 1+ ;
|
: bar ( a -- b ) 1 + ;
|
||||||
\ bar make-advised
|
\ bar make-advised
|
||||||
|
|
||||||
{ 11 } [
|
{ 11 } [
|
||||||
|
@ -91,4 +91,4 @@ IN: advice.tests
|
||||||
! [ 3 5 quux ] with-string-writer"> eval
|
! [ 3 5 quux ] with-string-writer"> eval
|
||||||
! ] unit-test
|
! ] unit-test
|
||||||
|
|
||||||
] with-scope
|
] with-scope
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2008 James Cash
|
! Copyright (C) 2008 James Cash
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences fry words assocs linked-assocs tools.annotations
|
USING: kernel sequences fry words assocs linked-assocs tools.annotations
|
||||||
coroutines lexer parser quotations arrays namespaces continuations ;
|
coroutines lexer parser quotations arrays namespaces continuations
|
||||||
|
summary ;
|
||||||
IN: advice
|
IN: advice
|
||||||
|
|
||||||
SYMBOLS: before after around advised in-advice? ;
|
SYMBOLS: before after around advised in-advice? ;
|
||||||
|
@ -45,8 +46,13 @@ PRIVATE>
|
||||||
: remove-advice ( name word loc -- )
|
: remove-advice ( name word loc -- )
|
||||||
word-prop delete-at ;
|
word-prop delete-at ;
|
||||||
|
|
||||||
|
ERROR: ad-do-it-error ;
|
||||||
|
|
||||||
|
M: ad-do-it-error summary
|
||||||
|
drop "ad-do-it should only be called inside 'around' advice" ;
|
||||||
|
|
||||||
: ad-do-it ( input -- result )
|
: ad-do-it ( input -- result )
|
||||||
in-advice? get [ "ad-do-it should only be called inside 'around' advice" throw ] unless coyield ;
|
in-advice? get [ ad-do-it-error ] unless coyield ;
|
||||||
|
|
||||||
: make-advised ( word -- )
|
: make-advised ( word -- )
|
||||||
[ dup '[ [ _ ] dip over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]
|
[ dup '[ [ _ ] dip over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]
|
||||||
|
@ -60,4 +66,4 @@ SYNTAX: ADVISE: ! word adname location => word adname quot loc
|
||||||
scan-word scan scan-word parse-definition swap [ spin ] dip advise ;
|
scan-word scan scan-word parse-definition swap [ spin ] dip advise ;
|
||||||
|
|
||||||
SYNTAX: UNADVISE:
|
SYNTAX: UNADVISE:
|
||||||
scan-word parsed \ unadvise parsed ;
|
scan-word parsed \ unadvise parsed ;
|
||||||
|
|
|
@ -25,8 +25,8 @@ M: counter-app init-session* drop 0 count sset ;
|
||||||
|
|
||||||
: <counter-app> ( -- responder )
|
: <counter-app> ( -- responder )
|
||||||
counter-app new-dispatcher
|
counter-app new-dispatcher
|
||||||
[ 1+ ] <counter-action> "inc" add-responder
|
[ 1 + ] <counter-action> "inc" add-responder
|
||||||
[ 1- ] <counter-action> "dec" add-responder
|
[ 1 - ] <counter-action> "dec" add-responder
|
||||||
<display-action> "" add-responder ;
|
<display-action> "" add-responder ;
|
||||||
|
|
||||||
! Deployment example
|
! Deployment example
|
||||||
|
|
Loading…
Reference in New Issue