## callcc-wrapper.pkg
# Compiled by:
#
src/lib/compiler/execution/execute.sublib### "Knowledge must come through action;
### you can have no test which is not
### fanciful, save by trial."
###
### -- Sophocles
package callcc_wrapper: (weak)
api {
exception TOPLEVEL_CALLCC;
trap_callcc: (X -> Y) -> (X -> Y); # Wrap given function to catch toplevel call/cc
}
{
exception TOPLEVEL_CALLCC;
stipulate
fate_stack = REF (NIL: List( Ref( Void ) ));
herein
# * Just like f x, except that it catches top-level callcc's
fun trap_callcc f x
=
{ r = REF ();
fate_stack := r ! *fate_stack;
fun pop_stack ()
=
case *fate_stack
r' ! rest => { fate_stack := rest;
if (r!=r' ) raise exception TOPLEVEL_CALLCC; fi;
};
_ => raise exception TOPLEVEL_CALLCC; # Can this ever happen?
esac;
a = f x
except
e = { pop_stack();
raise exception e;
};
pop_stack ();
a;
};
end;
};
## (C) 2001, Lucent Technologies, Bell Labs
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.