2006-04-08 16:46:47 -04:00
|
|
|
! Copyright (C) 2005, 2006 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2005-09-04 19:24:24 -04:00
|
|
|
IN: inference
|
2006-09-15 21:02:48 -04:00
|
|
|
USING: hashtables kernel math namespaces sequences words ;
|
2005-09-04 19:24:24 -04:00
|
|
|
|
2006-04-08 16:46:47 -04:00
|
|
|
SYMBOL: recursive-state
|
|
|
|
|
|
|
|
: <computed> \ <computed> counter ;
|
|
|
|
|
|
|
|
TUPLE: value uid literal recursion ;
|
|
|
|
|
|
|
|
C: value ( obj -- value )
|
|
|
|
<computed> over set-value-uid
|
|
|
|
recursive-state get over set-value-recursion
|
|
|
|
[ set-value-literal ] keep ;
|
|
|
|
|
|
|
|
M: value hashcode value-uid ;
|
|
|
|
|
2006-08-07 15:41:31 -04:00
|
|
|
M: value equal? eq? ;
|
2006-04-08 16:46:47 -04:00
|
|
|
|
|
|
|
M: integer value-uid ;
|
|
|
|
|
|
|
|
M: integer value-recursion drop f ;
|
|
|
|
|
2006-09-15 20:52:13 -04:00
|
|
|
: split-shuffle ( stack shuffle -- stack1 stack2 )
|
2006-09-15 20:59:47 -04:00
|
|
|
effect-in length swap cut* ;
|
2005-09-04 19:24:24 -04:00
|
|
|
|
2006-09-15 20:52:13 -04:00
|
|
|
: load-shuffle ( stack shuffle -- )
|
2006-09-15 20:59:47 -04:00
|
|
|
effect-in [ set ] 2each ;
|
2005-09-07 22:50:08 -04:00
|
|
|
|
2006-09-15 20:52:13 -04:00
|
|
|
: shuffled-values ( shuffle -- values )
|
2006-09-15 20:59:47 -04:00
|
|
|
effect-out [ get ] map ;
|
2005-09-04 19:24:24 -04:00
|
|
|
|
2006-09-15 20:52:13 -04:00
|
|
|
: shuffle* ( stack shuffle -- stack )
|
|
|
|
[ [ load-shuffle ] keep shuffled-values ] with-scope ;
|
2005-09-04 19:24:24 -04:00
|
|
|
|
2006-09-15 20:52:13 -04:00
|
|
|
: shuffle ( stack shuffle -- stack )
|
|
|
|
[ split-shuffle ] keep shuffle* append ;
|