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/cmenviron.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 224 - (view) (download)

1 : monnier 89 (* COPYRIGHT (c) 1996 Bell Laboratories. *)
2 :     (* cmenviron.sml *)
3 :    
4 :     structure CMEnv : CMENV =
5 :     struct
6 :     structure E = Environment
7 :    
8 :     structure CMS = CMStaticEnv
9 :    
10 :     fun CM { static, dynamic, symbolic } =
11 :     { static = CMS.CM static, dynamic = dynamic, symbolic = symbolic }
12 :     fun unCM { static, dynamic, symbolic } =
13 :     { static = CMS.unCM static, dynamic = dynamic, symbolic = symbolic }
14 :    
15 :     structure Env =
16 :     struct
17 :     type staticEnv = CMStaticEnv.staticEnv
18 :     type dynenv = E.dynenv
19 :     type symenv = E.symenv
20 :     type environment = {static: staticEnv, dynamic: dynenv, symbolic: symenv}
21 :     type symbol = E.symbol
22 :     val emptyEnv = CM E.emptyEnv
23 :     fun staticPart { static, dynamic, symbolic } = static
24 :     fun dynamicPart { static, dynamic, symbolic } = dynamic
25 :     fun symbolicPart { static, dynamic, symbolic } = symbolic
26 :     fun mkenv x = x
27 :     fun layerEnv({static=s1,dynamic=d1,symbolic=sy1},
28 :     {static=s2,dynamic=d2,symbolic=sy2}) =
29 :     {static=CMS.atop(s1,s2),
30 :     dynamic=DynamicEnv.atop(d1,d2),
31 :     symbolic=SymbolicEnv.atop(sy1,sy2)}
32 :     val layerStatic = CMS.atop
33 :     val layerSymbolic = SymbolicEnv.atop
34 :     fun filterEnv(e,l) = let
35 :     val { static, dynamic, symbolic } = E.filterEnv (unCM e, l)
36 :     in
37 :     { static = CMS.adjCM ([#static e], static),
38 :     dynamic = dynamic, symbolic = symbolic }
39 :     end
40 : monnier 113
41 :     val catalogEnv = E.catalogEnv o CMS.unCM
42 :    
43 :     fun trimEnv e = let
44 :     val { dynamic, symbolic, ... } = E.trimEnv (unCM e)
45 :     in
46 :     { static = #static e, dynamic = dynamic, symbolic = symbolic }
47 :     end
48 :    
49 : monnier 89 fun filterStaticEnv (s, l) =
50 :     CMS.adjCM ([s], E.filterStaticEnv (CMS.unCM s, l))
51 :    
52 :     (*
53 :     * The following definition is extremely heavy weight on
54 :     * a list of top-level "use"-based compilations. The baseEnv
55 :     * is being CM-ed again and again --- resulting quadratic
56 :     * behaviors. (ZHONG)
57 :     *
58 :     * fun concatEnv(a,b) = CM(E.concatEnv(unCM a, unCM b))
59 :     *
60 :     * So I reimplemented concatEnv as follows:
61 :     *)
62 :     fun concatEnv (a as {static=newstat, ...}, b as {static=oldstat, ...}) =
63 :     let val {static=rstat, dynamic=rdyn, symbolic=rsym}
64 :     = E.concatEnv(unCM a, unCM b)
65 :     val nrstat = CMS.adjCM ([newstat, oldstat], rstat)
66 :     in {static=nrstat, dynamic=rdyn, symbolic=rsym}
67 :     end
68 :    
69 :     val consolidateSymbolic = SymbolicEnv.consolidate
70 :     val consolidateStatic = CMS.consolidate
71 :     fun consolidateEnv ({ static, dynamic, symbolic }) =
72 :     {static = CMS.consolidate static,
73 :     dynamic = DynamicEnv.consolidate dynamic,
74 :     symbolic = SymbolicEnv.consolidate symbolic}
75 :    
76 :     datatype cmEnv
77 :     = CM_NONE
78 :     | CM_ENV of {look : Symbol.symbol -> cmEnv,
79 :     symbols : unit -> Symbol.symbol list}
80 :    
81 :     fun coerceCmEnv E.CM_NONE = CM_NONE
82 :     | coerceCmEnv (E.CM_ENV {look, symbols}) =
83 :     CM_ENV {look = coerceCmEnv o look, symbols = symbols}
84 :    
85 :     fun cmEnvOfModule e id = coerceCmEnv (E.cmEnvOfModule (CMS.unCM e) id)
86 :    
87 :     val describe = E.describe o CMS.unCM
88 :    
89 :     (* not used, not exported --
90 :     fun coerce (to,unto) {get,set} = {get=to o get,set = set o unto}
91 :     *)
92 :     val primEnv = CMS.CM E.primEnv
93 :     end
94 :    
95 :     end
96 :    
97 :     (*
98 : monnier 223 * $Log: cmenviron.sml,v $
99 :     * Revision 1.2 1998/06/02 17:39:26 george
100 :     * Changes to integrate CM functionality into the compiler --- blume
101 :     *
102 : monnier 89 *)

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