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

Annotation of /sml/trunk/src/cm/bootstrap/build-initdg.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 537 - (view) (download)

1 : blume 326 (*
2 :     * Build a simple dependency graph from a direct DAG description.
3 :     * - This is used in the bootstrap compiler to establish the
4 : blume 327 * pervasive env, the core env, and the primitives which later
5 :     * get used by the rest of the system.
6 :     * - The DAG does not contain any BNODEs and the only PNODEs will
7 :     * be those that correspond to primitives passed via "gp".
8 :     * In practice, the only PNODE will be the one for Env.primEnv.
9 : blume 326 *
10 :     * (C) 1999 Lucent Technologies, Bell Laboratories
11 :     *
12 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
13 :     *)
14 : blume 327 signature BUILD_INIT_DG = sig
15 : blume 354 val build : GeneralParams.info -> SrcPath.t ->
16 : blume 537 { core: DependencyGraph.sbnode,
17 : blume 358 pervasive: DependencyGraph.sbnode,
18 : blume 537 others: DependencyGraph.sbnode list,
19 :     src: GenericVC.Source.inputSource } option
20 : blume 326 end
21 :    
22 : blume 327 structure BuildInitDG :> BUILD_INIT_DG = struct
23 : blume 326
24 :     structure S = GenericVC.Source
25 :     structure EM = GenericVC.ErrorMsg
26 :     structure SM = GenericVC.SourceMap
27 :     structure DG = DependencyGraph
28 :    
29 :     fun build (gp: GeneralParams.info) specgroup = let
30 :     val pcmode = #pcmode (#param gp)
31 :     val errcons = #errcons gp
32 :     val groupreg = #groupreg gp
33 :    
34 : blume 354 val context = SrcPath.sameDirContext specgroup
35 :     val _ = Say.vsay ["[reading init spec from ",
36 :     SrcPath.descr specgroup, "]\n"]
37 : blume 326
38 : blume 345 fun work stream = let
39 : blume 354 val source = S.newSource (SrcPath.osstring specgroup,
40 :     1, stream, false, errcons)
41 : blume 345 val sourceMap = #sourceMap source
42 : blume 326
43 : blume 345 val _ = GroupReg.register groupreg (specgroup, source)
44 : blume 326
45 : blume 345 fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody
46 : blume 326
47 : blume 345 fun lineIn pos = let
48 :     val line = TextIO.inputLine stream
49 :     val len = size line
50 :     val newpos = pos + len
51 :     val _ = GenericVC.SourceMap.newline sourceMap newpos
52 :     fun sep c = Char.isSpace c orelse Char.contains "(),=;" c
53 :     in
54 :     if line = "" then NONE
55 :     else if String.sub (line, 0) = #"#" then SOME ([], newpos)
56 :     else SOME (String.tokens sep line, newpos)
57 :     end
58 : blume 326
59 : blume 537 fun loop (split, m, pos) =
60 : blume 345 case lineIn pos of
61 :     NONE => (error (pos, pos) "unexpected end of file"; NONE)
62 :     | SOME (line, newpos) => let
63 :     val error = error (pos, newpos)
64 : blume 537 fun sml (spec, s, xe, rts) = let
65 : blume 354 val p = SrcPath.standard pcmode
66 : blume 345 { context = context, spec = spec }
67 : blume 537 val attribs =
68 :     { split = s, is_rts = rts, extra_compenv = xe }
69 : blume 345 in
70 : blume 537 SmlInfo.info' attribs gp
71 :     { sourcepath = p,
72 :     group = (specgroup, (pos, newpos)),
73 :     sh_spec = Sharing.DONTCARE }
74 : blume 345 end
75 :     fun bogus n =
76 : blume 537 DG.SNODE { smlinfo = sml (n, false, NONE, false),
77 : blume 345 localimports = [], globalimports = [] }
78 :     fun look n =
79 :     case StringMap.find (m, n) of
80 :     SOME x => x
81 : blume 537 | NONE => (error ("undefined: " ^ n); bogus n)
82 :     fun node (name, file, args, is_rts) = let
83 :     fun one (arg, (li, needs_primenv)) =
84 :     if arg = "primitive" then (li, true)
85 :     else (look arg :: li, needs_primenv)
86 :     val (li, needs_primenv) =
87 :     foldr one ([], false) args
88 :     val xe =
89 :     if needs_primenv then
90 :     SOME (GenericVC.Environment.primEnv)
91 :     else NONE
92 :     val i = sml (file, split, xe, is_rts)
93 : blume 345 val n = DG.SNODE { smlinfo = i,
94 : blume 371 localimports = li,
95 : blume 537 globalimports = [] }
96 : blume 345 in
97 : blume 537 loop (split, StringMap.insert (m, name, n), newpos)
98 : blume 345 end
99 : blume 537 val looksb = DG.SB_SNODE o look
100 : blume 326 in
101 : blume 345 case line of
102 : blume 537 [] => loop (split, m, newpos)
103 :     | ["split"] => loop (true, m, newpos)
104 :     | ["nosplit"] => loop (false, m, newpos)
105 : blume 345 | ("bind" :: name :: file :: args) =>
106 : blume 537 node (name, file, args, false)
107 :     | ("rts-placeholder" :: name :: file :: args) =>
108 :     node (name, file, args, true)
109 :     | ("return" :: core :: pervasive :: prims) =>
110 :     SOME { core = looksb core,
111 :     pervasive = looksb pervasive,
112 :     others = map looksb prims,
113 :     src = source }
114 : blume 345 | _ => (error "malformed line"; NONE)
115 : blume 326 end
116 : blume 345 in
117 : blume 537 loop (false, StringMap.empty, 1)
118 : blume 345 end
119 : blume 364 fun openIt () = TextIO.openIn (SrcPath.osstring specgroup)
120 : blume 326 in
121 : blume 364 SafeIO.perform { openIt = openIt,
122 : blume 345 closeIt = TextIO.closeIn,
123 :     work = work,
124 : blume 459 cleanup = fn _ => () }
125 : blume 326 end
126 :     end

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