factor/library/errors.factor

37 lines
1.0 KiB
Factor
Raw Normal View History

! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
2005-03-21 14:39:46 -05:00
IN: kernel
2005-09-18 01:37:28 -04:00
DEFER: callcc1
2005-09-14 00:37:50 -04:00
DEFER: continue-with
2005-03-21 14:39:46 -05:00
IN: errors
2005-09-14 00:37:50 -04:00
USING: kernel-internals lists ;
2005-08-25 15:27:38 -04:00
! This is a very lightweight exception handling system.
2004-07-17 18:35:09 -04:00
2005-08-25 15:27:38 -04:00
TUPLE: no-method object generic ;
2005-09-17 22:25:18 -04:00
: no-method ( object generic -- ) <no-method> throw ;
2004-11-25 21:51:47 -05:00
2004-11-25 23:14:17 -05:00
: catchstack ( -- cs ) 6 getenv ;
: set-catchstack ( cs -- ) 6 setenv ;
2004-11-25 21:51:47 -05:00
2004-11-25 23:14:17 -05:00
: >c ( catch -- ) catchstack cons set-catchstack ;
: c> ( catch -- ) catchstack uncons set-catchstack ;
2004-07-17 18:35:09 -04:00
2005-09-14 00:37:50 -04:00
: (catch) ( try -- exception/f )
2005-09-18 01:37:28 -04:00
[ >c call f c> drop f ] callcc1 nip ;
2005-09-14 00:37:50 -04:00
2004-07-17 18:35:09 -04:00
: catch ( try catch -- )
2004-07-19 16:10:18 -04:00
#! 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.
2005-09-14 00:37:50 -04:00
>r (catch) r> call ;
2004-07-17 18:35:09 -04:00
: 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.
2005-09-18 01:37:28 -04:00
[ catchstack empty? [ die ] [ c> continue-with ] ifte ] when* ;
2005-03-25 21:43:06 -05:00
GENERIC: error. ( error -- )