factor/library/inference/stack.factor

40 lines
1.0 KiB
Factor
Raw Normal View History

! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
2004-11-26 22:23:57 -05:00
IN: inference
2005-07-31 23:38:33 -04:00
USING: interpreter kernel namespaces sequences words ;
2004-11-28 21:56:58 -05:00
\ >r [
2005-05-17 16:13:08 -04:00
\ >r #call
1 0 pick node-inputs
2004-11-28 21:56:58 -05:00
pop-d push-r
2005-05-17 16:13:08 -04:00
0 1 pick node-outputs
node,
] "infer" set-word-prop
2004-11-28 21:56:58 -05:00
\ r> [
2005-05-17 16:13:08 -04:00
\ r> #call
0 1 pick node-inputs
2004-11-28 21:56:58 -05:00
pop-r push-d
2005-05-17 16:13:08 -04:00
1 0 pick node-outputs
node,
] "infer" set-word-prop
2004-11-26 22:23:57 -05:00
2005-07-31 23:38:33 -04:00
: with-datastack ( stack word -- stack )
datastack >r >r set-datastack r> execute
datastack r> [ push ] keep set-datastack 2nip ;
: apply-datastack ( word -- )
meta-d [ swap with-datastack ] change ;
: infer-shuffle ( word -- )
2005-05-17 16:13:08 -04:00
dup #call [
2005-07-31 23:38:33 -04:00
over "infer-effect" word-prop
[ apply-datastack ] hairy-node
2005-05-17 16:13:08 -04:00
] keep node, ;
2004-11-26 22:23:57 -05:00
2005-05-17 16:13:08 -04:00
\ drop [ 1 #drop node, pop-d drop ] "infer" set-word-prop
\ dup [ \ dup infer-shuffle ] "infer" set-word-prop
\ swap [ \ swap infer-shuffle ] "infer" set-word-prop
\ over [ \ over infer-shuffle ] "infer" set-word-prop
\ pick [ \ pick infer-shuffle ] "infer" set-word-prop