2005-02-22 23:07:47 -05:00
|
|
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
IN: inference
|
|
|
|
USING: errors interpreter kernel lists namespaces prettyprint
|
|
|
|
stdio ;
|
|
|
|
|
|
|
|
DEFER: recursive-state
|
|
|
|
|
|
|
|
: inference-condition ( msg symbol -- )
|
|
|
|
[
|
|
|
|
, , recursive-state get , meta-d get , meta-r get ,
|
|
|
|
] make-list ;
|
|
|
|
|
|
|
|
: inference-condition. ( cond msg -- )
|
2005-02-23 21:50:51 -05:00
|
|
|
"! " write write
|
2005-02-22 23:07:47 -05:00
|
|
|
cdr unswons error.
|
2005-02-23 21:50:51 -05:00
|
|
|
"! Recursive state:" print
|
|
|
|
car [ "! " write . ] each ;
|
|
|
|
|
|
|
|
: inference-error ( msg -- )
|
|
|
|
#! Signalled if your code is malformed in some
|
|
|
|
#! statically-provable way.
|
|
|
|
\ inference-error inference-condition throw ;
|
2005-02-22 23:07:47 -05:00
|
|
|
|
|
|
|
PREDICATE: cons inference-error car \ inference-error = ;
|
|
|
|
M: inference-error error. ( error -- )
|
|
|
|
"Inference error: " inference-condition. ;
|
|
|
|
|
2005-02-23 21:50:51 -05:00
|
|
|
: inference-warning ( msg -- )
|
2005-02-24 20:52:17 -05:00
|
|
|
"inference-warnings" get [
|
|
|
|
\ inference-warning inference-condition error.
|
|
|
|
] [
|
|
|
|
drop
|
|
|
|
] ifte ;
|
2005-02-23 21:50:51 -05:00
|
|
|
|
2005-02-22 23:07:47 -05:00
|
|
|
PREDICATE: cons inference-warning car \ inference-warning = ;
|
|
|
|
M: inference-warning error. ( error -- )
|
|
|
|
"Inference warning: " inference-condition. ;
|