Diff of /sml/trunk/src/cm/link.sml

Parent Directory | Revision Log | Patch

	revision 316, Fri Jun 4 08:32:57 1999 UTC	revision 317, Fri Jun 4 09:00:10 1999 UTC
#	Line 15	Line 15
15	structure CMSE = GenericVC.CMStaticEnv	structure CMSE = GenericVC.CMStaticEnv
16	structure S = GenericVC.Symbol	structure S = GenericVC.Symbol
17
18		(* For testing purposes, I need to have access to the old basis
19		* library.  This is done via the "primitives" mechanism.  Eventually,
20		* the basis will be accessed as a genuine library. The "primitives"
21		* mechanism is really meant to serve a different purpose.
22		*
23		* We split the existing pervasive environment into two parts:
24		*  1. All ML module definitions -- this is the parts that will
25		*     become available via a primitive called "basis".
26		*  2. The remaining (non-modular) bindings.  Those will be
27		*     used as our "pervasive" environment.
28		*
29		* I didn't bother to split dynamic or symbolic environments.
30		* To function properly this is not necessary, and the whole thing
31		* will soon go away anyhow.
32		*)
33	fun split e = let	fun split e = let
34	val sym = E.symbolicPart e	val sym = E.symbolicPart e
35	val dyn = E.dynamicPart e	val dyn = E.dynamicPart e
#	Line 33	Line 48
48	{ mod = mk mods, nomod = mk nomods }	{ mod = mk mods, nomod = mk nomods }
49	end	end
50
51		(* Instantiate the persistent state functor; this includes
52		* the binfile cache and the dynamic value cache *)
53	structure FullPersstate =	structure FullPersstate =
54	FullPersstateFn (structure MachDepVC = HostMachDepVC)	FullPersstateFn (structure MachDepVC = HostMachDepVC)
55
56		(* Create two arguments appropriate for being passed to
57		* CompileGenericFn. One instantiation of that functor
58		* is responsible for "recompile" traversals, the other one
59		* does "link" traversals. Notice how the two share the same
60		* underlying state. *)
61	structure Recomp = RecompFn (structure PS = FullPersstate)	structure Recomp = RecompFn (structure PS = FullPersstate)
62	structure Exec = ExecFn (structure PS = FullPersstate)	structure Exec = ExecFn (structure PS = FullPersstate)
63
64		(* make the two traversals *)
65	structure RecompTraversal = CompileGenericFn (structure CT = Recomp)	structure RecompTraversal = CompileGenericFn (structure CT = Recomp)
66	structure ExecTraversal = CompileGenericFn (structure CT = Exec)	structure ExecTraversal = CompileGenericFn (structure CT = Exec)
67
68		(* The StabilizeFn functor needs a way of converting bnodes to
69		* dependency-analysis environments.  This can be achieved quite
70		* conveniently by a "recompile" traversal for bnodes. *)
71	fun bn2statenv gp i = #1 (#stat (valOf (RecompTraversal.bnode gp i)))	fun bn2statenv gp i = #1 (#stat (valOf (RecompTraversal.bnode gp i)))
72
73	val recomp_group = RecompTraversal.group	(* exec_group is basically the same as ExecTraversal.group with
74		* two additional actions to be taken:
75		*   1. Before executing the code, we announce the priviliges
76		*      that are being invoked.  (For the time being, we assume
77		*      that everybody has every conceivable privilege, but at the
78		*      very least we announce which ones are being made use of.)
79		*   2. After we are done we must make the values of "shared"
80		*      compilation units permanent. *)
81	fun exec_group gp (g as GroupGraph.GROUP { required = rq, ... }) =	fun exec_group gp (g as GroupGraph.GROUP { required = rq, ... }) =
82	(if StringSet.isEmpty rq then ()	(if StringSet.isEmpty rq then ()
83	else Say.say ("$Execute: required privileges are:\n" ::	else Say.say ("$Execute: required privileges are:\n" ::
#	Line 53	Line 85
85	ExecTraversal.group gp g	ExecTraversal.group gp g
86	before FullPersstate.rememberShared ())	before FullPersstate.rememberShared ())
87
88	fun recomp_runner gp g = isSome (recomp_group gp g)	fun recomp_runner gp g = isSome (RecompTraversal.group gp g)
89
90		(* This function combines the actions of "recompile" and "exec".
91		* When successful, it combines the results (thus forming a full
92		* environment) and adds it to the toplevel environment. *)
93	fun make_runner gp g =	fun make_runner gp g =
94	case recomp_group gp g of	case RecompTraversal.group gp g of
95	NONE => false	NONE => false
96	| SOME { stat, sym} =>	| SOME { stat, sym} =>
97	(case exec_group gp g of	(case exec_group gp g of
#	Line 72	Line 107
107	true	true
108	end)	end)
109
110		(* Instantiate the stabilization mechanism. *)
111	structure Stabilize =  StabilizeFn (val bn2statenv = bn2statenv	structure Stabilize =  StabilizeFn (val bn2statenv = bn2statenv
112	val recomp = recomp_runner)	val recomp = recomp_runner)
113
114		(* Access to the stabilization mechanism is integrated into the
115		* parser. I'm not sure if this is the cleanest way, but it works
116		* well enough. *)
117	structure Parse = ParseFn (structure Stabilize = Stabilize)	structure Parse = ParseFn (structure Stabilize = Stabilize)
118
119		(* this is just a dummy argument to "run" (see below). *)
120	fun stabilize_runner gp g = true	fun stabilize_runner gp g = true
121	in	in
122	structure CM = struct	structure CM = struct
#	Line 85	Line 125
125	val c = AbsPath.cwdContext ()	val c = AbsPath.cwdContext ()
126	val p = AbsPath.native { context = AbsPath.cwdContext (),	val p = AbsPath.native { context = AbsPath.cwdContext (),
127	spec = s }	spec = s }
128	val { mod = basis, nomod = perv } =	val { mod = basis, nomod = perv } = split (#get ER.pervasive ())
	split (#get ER.pervasive ())
129	val corenv = #get ER.core ()	val corenv = #get ER.core ()
130	val primconf = Primitive.configuration { basis = basis }	val primconf = Primitive.configuration { basis = basis }
131	val param = { primconf = primconf,	val param = { primconf = primconf,

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.316   changed lines   Added in v.317

---

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