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/cm/bootstrap/btcompile.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/bootstrap/btcompile.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 327 - (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