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/trunk/src/compiler/TopLevel/environ/dynenv.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/TopLevel/environ/dynenv.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 224 - (view) (download)

1 : monnier 45 (* Copyright 1996 by AT&T Bell Laboratories. *)
2 :     (* dynenv.sml *)
3 : monnier 16
4 :     structure DynamicEnv : DYNENV =
5 :     struct
6 :    
7 :     type pid = PersStamps.persstamp
8 :    
9 :     structure Map = PersMap
10 :    
11 : monnier 45 type object = CompBasic.object
12 : monnier 16
13 :     datatype dynenv = NORM of object Map.map * dynenv
14 :     | SPECIAL of (pid -> object) * dynenv
15 :     | EMPTY
16 :     (* chain invariant: only one NORM in a row. *)
17 :    
18 :     exception Unbound = Map.MapF
19 :     exception SpecialEnv
20 :    
21 :     val empty = EMPTY
22 :    
23 :     fun special (f,next) = SPECIAL(f,next)
24 :    
25 :     fun look (NORM(map,next)) pid = ((Map.lookup map pid)
26 :     handle Unbound => look next pid)
27 :     | look (SPECIAL(f,next)) pid = ((f pid) handle Unbound => look next pid)
28 :     | look EMPTY pid = raise Unbound
29 :    
30 :     fun bind (pid,binding,NORM(map,next)) = NORM(Map.add(map,pid,binding),next)
31 :     | bind (pid,binding,x) = NORM(Map.add(Map.empty,pid,binding),x)
32 :    
33 :     fun atop(NORM(topmap,EMPTY),NORM(bottommap,next)) =
34 :     NORM(Map.overlay(topmap,bottommap),next)
35 :     | atop(NORM(topmap,EMPTY),bottom) = NORM(topmap,bottom)
36 :     | atop(NORM(topmap,nexttop),bottom) = NORM(topmap,atop(nexttop,bottom))
37 :     | atop(SPECIAL(f,nexttop),bottom) = SPECIAL(f,atop(nexttop,bottom))
38 :     | atop(EMPTY,bottom) = bottom
39 :    
40 :     fun remove(pids: pid list, NORM(map,next)) =
41 :     NORM(foldr Map.delete map pids, remove(pids,next))
42 :     | remove(pids,SPECIAL(f,next)) = raise SpecialEnv
43 :     | remove(pids,EMPTY) = EMPTY
44 :    
45 :     fun consolidate e = e
46 :    
47 :     fun singleton (p, v) = bind (p, v, empty)
48 :    
49 :     end (* structure DynamicEnv *)
50 :    
51 : monnier 93
52 :     (*
53 : monnier 223 * $Log: dynenv.sml,v $
54 :     * Revision 1.1.1.1 1998/04/08 18:39:15 george
55 :     * Version 110.5
56 :     *
57 : monnier 93 *)

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