factor/library/errors.factor

! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: kernel DEFER: callcc1
IN: streams DEFER: line-number
IN: parser DEFER: file
IN: errors USING: kernel-internals lists namespaces streams ;

TUPLE: undefined-method object generic ;

: undefined-method ( object generic -- )
    #! We 2dup here to leave both values on the stack, for
    #! post-mortem inspection.
    2dup <undefined-method> throw ;

! This is a very lightweight exception handling system.

: catchstack ( -- cs ) 6 getenv ;
: set-catchstack ( cs -- ) 6 setenv ;

: >c ( catch -- ) catchstack cons set-catchstack ;
: c> ( catch -- ) catchstack uncons set-catchstack ;

: save-error ( error -- )
    #! Save the stacks and parser state for post-mortem
    #! inspection after an error.
    namespace [
        "col" get
        "line" get
        line-number get
        file get
        global [
            "error-file" set
            "error-line-number" set
            "error-line" set
            "error-col" set
            "error" set
            datastack "error-datastack" set
            callstack "error-callstack" set
            namestack "error-namestack" set
            catchstack "error-catchstack" set
        ] bind
    ] when ;

: catch ( try catch -- )
    #! Call the try quotation. If an error occurs restore the
    #! datastack, push the error, and call the catch block.
    #! If no error occurs, push f and call the catch block.
    [ >c >r call c> drop f r> f ] callcc1 rot drop swap call ;

: rethrow ( error -- )
    #! Use rethrow when passing an error on from a catch block.
    #! For convinience, this word is a no-op if error is f.
    [ c> call ] when* ;