version 1.1, 1998/04/29 17:09:46
|
version 1.2, 2004/11/28 20:20:37
|
Line 2
|
Line 2
|
|
|
\ This file is in the public domain. NO WARRANTY. |
\ This file is in the public domain. NO WARRANTY. |
|
|
: noop ; |
|
|
|
: perform ( ? addr -- ? ) |
: perform ( ? addr -- ? ) |
@ execute ; |
@ execute ; |
|
|
: defer ( "name" -- ) |
: defer ( "name" -- ) |
create ['] noop , \ you should not rely on initialization with noop |
create ['] abort , \ you should not rely on initialization with noop |
does> ( ? -- ? ) |
does> ( ? -- ? ) |
perform ; |
perform ; |
|
|
|
: defer@ ( xt1 -- xt2 ) |
|
>body @ ; |
|
|
|
: defer! ( xt2 xt1 -- ) |
|
>body ! ; |
|
|
: <is> ( xt "name" -- ) |
: <is> ( xt "name" -- ) |
' >body ! ; |
' defer! ; |
|
|
: [is] ( compilation: "name" -- ; run-time: xt -- ) |
: [is] ( compilation: "name" -- ; run-time: xt -- ) |
' >body postpone Literal postpone ! ; immediate |
postpone ['] postpone defer! ; immediate |
|
|
|
: is |
|
state @ if |
|
postpone [is] |
|
else |
|
<is> |
|
then ; immediate |
|
|
|
: action-of |
|
state @ if |
|
POSTPONE ['] POSTPONE defer@ |
|
else |
|
' defer@ |
|
then ; immediate |
|
|
|
|