Annotation of /sml/branches/SMLNJ/src/cm/bootstrap/btcompile.sml

Parent Directory | Revision Log

---

Revision 410 - (view) (download)

1 :	blume	327	(*
2 :			* The bootstrap compiler.
3 :			* (Formerly known as "batch" compiler.)
4 :			*
5 :			* (C) 1999 Lucent Technologies, Bell Laboratories
6 :			*
7 :			* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
8 :			*)
9 :			functor BootstrapCompileFn (structure MachDepVC: MACHDEP_VC) = struct
10 :
11 :			structure EM = GenericVC.ErrorMsg
12 :			structure E = GenericVC.Environment
13 :			structure SE = GenericVC.CMStaticEnv
14 :			structure BE = GenericVC.BareEnvironment
15 :			structure PS = GenericVC.PersStamps
16 :			structure CoerceEnv = GenericVC.CoerceEnv
17 :
18 :			(* Since the bootstrap compiler never executes any of the code
19 :			* it produces, we don't need any dynamic values. Therefore,
20 :			* we create RecompPersstate (but not FullPersstate!) and
21 :			* instantiate Recomp as well as RecompTraversal.
22 :			* Since RecompPersstate is not part of any surrounding FullPersstate,
23 :			* function "discard_value" simply does nothing. *)
24 :			structure RecompPersstate =
25 :			RecompPersstateFn (structure MachDepVC = MachDepVC
26 :			val discard_code = true
27 :			fun discard_value (i: SmlInfo.info) = ())
28 :			structure Recomp = RecompFn (structure PS = RecompPersstate)
29 :			structure RT = CompileGenericFn (structure CT = Recomp)
30 :
31 :			fun recomp gp g = isSome (RT.group gp g)
32 :
33 :			(* instantiate Stabilize... *)
34 :			structure Stabilize = StabilizeFn (fun bn2statenv gp i =
35 :			#1 (#stat (valOf (RT.bnode gp i)))
36 :			val recomp = recomp)
37 :			(* ... and Parse *)
38 :			structure Parse = ParseFn (structure Stabilize = Stabilize)
39 :
40 :			fun compile (keep_going, fnpolicy, pcmode, initgspec, maingspec, sflag) = let
41 :
42 :			val emptydyn = E.dynamicPart E.emptyEnv
43 :
44 :			(* first, build an initial GeneralParam.info, so we can
45 :			* deal with the pervasive env and friends... *)
46 :			local
47 :			(* We could actually go and calculate the actual pid of primEnv.
48 :			* But in reality it's pretty pointless to do so... *)
49 :			val bogusPid = PS.fromBytes (Byte.stringToBytes "0123456789abcdef")
50 :			val pspec = { name = "primitive",
51 :			env = E.mkenv { static = E.primEnv,
52 :			symbolic = E.symbolicPart E.emptyEnv,
53 :			dynamic = emptydyn },
54 :			pidInfo = { statpid = bogusPid,
55 :			sympid = bogusPid,
56 :			ctxt = SE.empty } }
57 :			in
58 :			val primconf = Primitive.configuration [pspec]
59 :			end
60 :
61 :			val param = { primconf = primconf,
62 :			fnpolicy = fnpolicy,
63 :			pcmode = pcmode,
64 :			keep_going = keep_going,
65 :			pervasive = E.emptyEnv,
66 :			corenv = BE.staticPart BE.emptyEnv,
67 :			pervcorepids = PidSet.empty }
68 :
69 :			val groupreg = GroupReg.new ()
70 :			val errcons = EM.defaultConsumer ()
71 :			val ginfo = { param = param, groupreg = groupreg, errcons = errcons }
72 :
73 :			fun main_compile arg = let
74 :			val { rts, core, pervasive, primitives, filepaths } = arg
75 :
76 :			(* here we build a new gp -- the one that uses the freshly
77 :			* brewed pervasive env, core env, and primitives *)
78 :			fun rt n = valOf (RT.snode ginfo n)
79 :			val rts = rt rts
80 :			val core = rt core
81 :			val pervasive = rt pervasive
82 :
83 :			fun sn2pspec (name, n) = let
84 :			val { stat = (s, sp), sym = (sy, syp), ctxt } = rt n
85 :			val env =
86 :			E.mkenv { static = s, symbolic = sy, dynamic = emptydyn }
87 :			val pidInfo = { statpid = sp, sympid = syp, ctxt = ctxt }
88 :			in
89 :			{ name = name, env = env, pidInfo = pidInfo }
90 :			end
91 :
92 :			val pspecs = map sn2pspec primitives
93 :
94 :			val param = { primconf = Primitive.configuration pspecs,
95 :			fnpolicy = fnpolicy,
96 :			pcmode = pcmode,
97 :			keep_going = keep_going,
98 :			pervasive = E.mkenv { static = #1 (#stat pervasive),
99 :			symbolic = #1 (#sym pervasive),
100 :			dynamic = emptydyn },
101 :			corenv = CoerceEnv.es2bs (#1 (#stat core)),
102 :			pervcorepids =
103 :			PidSet.addList (PidSet.empty,
104 :			[#2 (#stat pervasive),
105 :			#2 (#sym pervasive),
106 :			#2 (#stat core)]) }
107 :			in
108 :			case Parse.parse param sflag maingspec of
109 :			NONE => false
110 :			| SOME (g, gp) => recomp gp g
111 :			end handle Option => false (* to catch valOf failures in "rt" *)
112 :			in
113 :			case BuildInitDG.build ginfo initgspec of
114 :			SOME x => main_compile x
115 :			| NONE => false
116 :			end
117 :			end

---

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