Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/branches/blume-private-devel/src/compiler/Execution/main/isolate.sml
ViewVC logotype

View of /sml/branches/blume-private-devel/src/compiler/Execution/main/isolate.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1401 - (download) (annotate)
Thu Oct 2 16:09:02 2003 UTC (16 years ago)
File size: 920 byte(s)
This commit was manufactured by cvs2svn to create branch
'blume-private-devel'.
(* isolate.sml
 *
 * (C) 2001, Lucent Technologies, Bell Labs
 *)
structure Isolate : sig
    exception TopLevelException of exn
    exception TopLevelCallcc
    (* wrap given function to catch toplevel call/cc *)
    val isolate : ('a -> 'b) -> ('a -> 'b)
end = struct

    exception TopLevelException of exn
    exception TopLevelCallcc

    local 
	val cont_stack = ref (nil : unit ref list)
    in 
    (** just like f x, except that it catches top-level callcc's *)
        fun isolate f x = let
	    val r = ref()
	    val _ = cont_stack := r :: !cont_stack
	    fun pop_stack() =
		case !cont_stack of
		    r' :: rest =>
		    (cont_stack := rest;
		     if r<>r' then raise TopLevelCallcc else ())
		  | _ => raise TopLevelCallcc (* can this ever happen? *)
	    val a = f x
		handle e =>
		       (pop_stack(); 
			raise (case e of TopLevelException x => x | e => e))
	in
	    pop_stack (); a
	end
    end
end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0