[ [ name>> ] map ] dip
dup vocab-platforms-path set-vocab-file-contents ;
-: supported-platform? ( vocab -- ? )
- vocab-platforms [ t ] [ [ os swap class<= ] any? ] if-empty ;
+: supported-platform? ( platforms -- ? )
+ [ t ] [ [ os swap class<= ] any? ] if-empty ;
: unportable? ( vocab -- ? )
{
[ vocab-tags "untested" swap member? ]
- [ supported-platform? not ]
+ [ vocab-platforms supported-platform? not ]
} 1|| ;
-ERROR: unsupported-platform vocab ;
+TUPLE: unsupported-platform vocab requires ;
+
+: unsupported-platform ( vocab requires -- )
+ \ unsupported-platform boa throw-continue ;
M: unsupported-platform summary
drop "Current operating system not supported by this vocabulary" ;
-[ dup supported-platform? [ drop ] [ vocab-name unsupported-platform ] if ]
-check-vocab-hook set-global
+[
+ dup vocab-platforms dup supported-platform?
+ [ 2drop ] [ [ vocab-name ] dip unsupported-platform ] if
+] check-vocab-hook set-global
TUPLE: redefine-error def ;
: redefine-error ( definition -- )
- \ redefine-error boa
- { { "Continue" t } } throw-restarts drop ;
+ \ redefine-error boa throw-continue ;
<PRIVATE
throw-restarts
rethrow-restarts
}
+"A utility word using the above:"
+{ $subsections
+ throw-continue
+}
"The list of restarts from the most recently-thrown error is stored in a global variable:"
{ $subsections restarts }
-"To invoke restarts, see " { $link "debugger" } "." ;
+"To invoke restarts, use " { $link "debugger" } "." ;
ARTICLE: "errors-post-mortem" "Post-mortem error inspection"
"The most recently thrown error, together with the continuation at that point, are stored in a pair of global variables:"
{ $values { "error" object } { "restarts" "a sequence of " { $snippet "{ string object }" } " pairs" } { "restart" object } }
{ $description "Throws a restartable error using " { $link rethrow } ". Otherwise, this word is identical to " { $link throw-restarts } "." } ;
-{ throw rethrow throw-restarts rethrow-restarts } related-words
+{ throw rethrow throw-restarts rethrow-restarts throw-continue } related-words
+
+HELP: throw-continue
+{ $values { "error" object } }
+{ $description "Throws a resumable error. If the user elects to continue execution, this word returns normally." } ;
HELP: compute-restarts
{ $values { "error" object } { "seq" "a sequence" } }
: rethrow-restarts ( error restarts -- restart )
[ <condition> rethrow ] callcc1 2nip ;
+: throw-continue ( error -- )
+ { { "Continue" t } } throw-restarts drop ;
+
TUPLE: restart name obj continuation ;
C: <restart> restart