2005-05-14 21:15:50 -04:00
|
|
|
! 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-05-14 21:15:50 -04:00
|
|
|
USING: interpreter kernel namespaces 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,
|
2005-03-05 14:45:23 -05:00
|
|
|
] "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,
|
2005-03-05 14:45:23 -05:00
|
|
|
] "infer" set-word-prop
|
2004-11-26 22:23:57 -05:00
|
|
|
|
2005-05-14 21:15:50 -04:00
|
|
|
: infer-shuffle ( word -- )
|
2005-05-17 16:13:08 -04:00
|
|
|
dup #call [
|
|
|
|
over "infer-effect" word-prop [ host-word ] hairy-node
|
|
|
|
] 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
|
2005-05-14 21:15:50 -04:00
|
|
|
\ 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
|