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 1453 - (download) (annotate)
Mon Feb 9 20:33:28 2004 UTC (15 years, 7 months ago) by mblume
File size: 783 byte(s)
merged changes from main trunk into devel branch
(* isolate.sml
 *
 * (C) 2001, Lucent Technologies, Bell Labs
 *)
structure Isolate : sig
    exception TopLevelCallcc
    (* wrap given function to catch toplevel call/cc *)
    val isolate : ('a -> 'b) -> ('a -> 'b)
end = struct

    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 e)
	in
	    pop_stack (); a
	end
    end
end

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