1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
(* COPYRIGHT (c) 1996 Bell Laboratories.*)
(* envref.sml *)
signature ENVREF = sig
type environment = Environment.environment
type envref = {get: unit -> environment, set: environment -> unit}
type envstate = { loc: envref, base: envref, props: PropList.holder }
val state : unit -> envstate
val loc : unit -> envref (* interactive top level env *)
val base : unit -> envref
val props : unit -> PropList.holder
val pervasive : envref
val combined : unit -> environment
(* push a given envstate onto the stack, run the thunk, then pop the state *)
val locally : envstate * (unit -> 'a) -> 'a
val listBoundSymbols : unit -> Symbol.symbol list
end
structure EnvRef : ENVREF = struct
type environment = Environment.environment
type envref = {get: unit -> environment, set: environment -> unit}
type envstate = { loc: envref, base: envref, props: PropList.holder }
fun mkEnvRef a = let
val r = ref a
fun get () = !r
fun set x = r := x
in
{ get = get, set = set }
end
val pervasive = mkEnvRef Environment.emptyEnv
val stack : (envstate * envstate list) ref = let
val loc = mkEnvRef Environment.emptyEnv
val props = PropList.newHolder ()
in
ref ({ loc = loc, base = pervasive, props = props }, [])
end
fun state () = #1 (!stack)
val loc = #loc o state
val base = #base o state
val props = #props o state
fun combined () =
Environment.layerEnv (#get (loc ()) (),
#get (base ()) ())
fun locally (es, th) = let
val oldstack = !stack
in
stack := (es, op :: oldstack);
th ()
before stack := oldstack
end
fun listBoundSymbols () =
StaticEnv.symbols
(StaticEnv.atop (#static (#get (loc ()) ()),
#static (#get (base ()) ())))
end
|
