2005-05-15 21:17:56 -04:00
|
|
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
|
IN: inference
|
2005-05-22 21:07:24 -04:00
|
|
|
USING: generic kernel lists namespaces sequences unparser words ;
|
2005-05-15 21:17:56 -04:00
|
|
|
|
|
|
|
|
GENERIC: value= ( literal value -- ? )
|
|
|
|
|
|
2005-07-27 01:46:06 -04:00
|
|
|
TUPLE: value recursion safe? ;
|
2005-05-15 21:17:56 -04:00
|
|
|
|
|
|
|
|
C: value ( recursion -- value )
|
2005-05-16 01:15:48 -04:00
|
|
|
[ t swap set-value-safe? ] keep
|
2005-05-15 21:17:56 -04:00
|
|
|
[ set-value-recursion ] keep ;
|
|
|
|
|
|
2005-07-28 15:17:31 -04:00
|
|
|
M: value = eq? ;
|
|
|
|
|
|
2005-05-15 21:17:56 -04:00
|
|
|
TUPLE: computed ;
|
|
|
|
|
|
2005-07-27 01:46:06 -04:00
|
|
|
C: computed ( -- value )
|
|
|
|
|
recursive-state get <value> over set-delegate ;
|
2005-05-15 21:17:56 -04:00
|
|
|
|
|
|
|
|
M: computed value= ( literal value -- ? )
|
|
|
|
|
2drop f ;
|
|
|
|
|
|
2005-05-16 01:15:48 -04:00
|
|
|
TUPLE: literal value ;
|
2005-05-15 21:17:56 -04:00
|
|
|
|
|
|
|
|
C: literal ( obj rstate -- value )
|
2005-07-27 01:46:06 -04:00
|
|
|
[ >r <value> r> set-delegate ] keep
|
2005-05-15 21:17:56 -04:00
|
|
|
[ set-literal-value ] keep ;
|
|
|
|
|
|
|
|
|
|
M: literal value= ( literal value -- ? )
|
|
|
|
|
literal-value = ;
|
|
|
|
|
|
2005-07-27 01:46:06 -04:00
|
|
|
: >literal< ( literal -- rstate obj )
|
|
|
|
|
dup value-recursion swap literal-value ;
|
2005-05-22 21:07:24 -04:00
|
|
|
|
2005-07-27 01:46:06 -04:00
|
|
|
M: value literal-value ( value -- )
|
|
|
|
|
"A literal value was expected where a computed value was found"
|
|
|
|
|
inference-error ;
|
2005-05-15 21:17:56 -04:00
|
|
|
|
2005-07-27 01:46:06 -04:00
|
|
|
TUPLE: meet values ;
|
2005-05-16 01:15:48 -04:00
|
|
|
|
2005-07-27 01:46:06 -04:00
|
|
|
C: meet ( values -- value )
|
|
|
|
|
[ set-meet-values ] keep f <value> over set-delegate ;
|
2005-06-09 19:49:31 -04:00
|
|
|
|
|
|
|
|
PREDICATE: tuple safe-literal ( obj -- ? )
|
|
|
|
|
dup literal? [ value-safe? ] [ drop f ] ifte ;
|