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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1453 - (view) (download)

1 : blume 902 (* isolate.sml
2 :     *
3 :     * (C) 2001, Lucent Technologies, Bell Labs
4 :     *)
5 :     structure Isolate : sig
6 :     exception TopLevelCallcc
7 :     (* wrap given function to catch toplevel call/cc *)
8 :     val isolate : ('a -> 'b) -> ('a -> 'b)
9 :     end = struct
10 :    
11 :     exception TopLevelCallcc
12 :    
13 :     local
14 :     val cont_stack = ref (nil : unit ref list)
15 :     in
16 :     (** just like f x, except that it catches top-level callcc's *)
17 :     fun isolate f x = let
18 :     val r = ref()
19 :     val _ = cont_stack := r :: !cont_stack
20 :     fun pop_stack() =
21 :     case !cont_stack of
22 :     r' :: rest =>
23 :     (cont_stack := rest;
24 :     if r<>r' then raise TopLevelCallcc else ())
25 :     | _ => raise TopLevelCallcc (* can this ever happen? *)
26 : mblume 1453 val a = f x handle e => (pop_stack(); raise e)
27 : blume 902 in
28 :     pop_stack (); a
29 :     end
30 :     end
31 :     end

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