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 331 - (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 :    
15 : blume 327 signature BUILD_INIT_DG = sig
16 : blume 326 val build : GeneralParams.info -> AbsPath.t ->
17 :     { rts: DependencyGraph.snode,
18 :     core: DependencyGraph.snode,
19 :     pervasive: DependencyGraph.snode,
20 : blume 327 primitives: (string * DependencyGraph.snode) list,
21 :     filepaths: AbsPath.t list } option
22 : blume 326 end
23 :    
24 : blume 327 structure BuildInitDG :> BUILD_INIT_DG = struct
25 : blume 326
26 :     structure S = GenericVC.Source
27 :     structure EM = GenericVC.ErrorMsg
28 :     structure SM = GenericVC.SourceMap
29 :     structure DG = DependencyGraph
30 :    
31 :     fun build (gp: GeneralParams.info) specgroup = let
32 :     val pcmode = #pcmode (#param gp)
33 :     val primconf = #primconf (#param gp)
34 :     val errcons = #errcons gp
35 :     val groupreg = #groupreg gp
36 :    
37 :     val context = AbsPath.relativeContext (AbsPath.dir specgroup)
38 :     val specname = AbsPath.name specgroup
39 : blume 329 val _ = Say.vsay ["[reading init spec from ", specname, "]\n"]
40 :     val stream = AbsPath.openTextIn specgroup
41 : blume 326 val source = S.newSource (specname, 1, stream, false, errcons)
42 :     val sourceMap = #sourceMap source
43 :    
44 :     val _ = GroupReg.register groupreg (specgroup, source)
45 :    
46 :     fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody
47 :    
48 :     fun lineIn pos = let
49 :     val line = TextIO.inputLine stream
50 :     val len = size line
51 :     val newpos = pos + len
52 :     val _ = GenericVC.SourceMap.newline sourceMap newpos
53 :     fun sep c = Char.isSpace c orelse Char.contains "(),=;" c
54 :     in
55 :     if line = "" then NONE
56 :     else if String.sub (line, 0) = #"#" then SOME ([], newpos)
57 :     else SOME (String.tokens sep line, newpos)
58 :     end
59 :    
60 : blume 327 fun loop (split, m, pl, pos) =
61 : blume 326 case lineIn pos of
62 :     NONE => (error (pos, pos) "unexpected end of file"; NONE)
63 :     | SOME (line, newpos) => let
64 :     val error = error (pos, newpos)
65 :     fun sml (spec, split) = let
66 : blume 327 val p = AbsPath.standard pcmode
67 : blume 326 { context = context, spec = spec }
68 :     in
69 : blume 327 (p,
70 :     SmlInfo.info gp { sourcepath = p,
71 :     group = (specgroup, (pos, newpos)),
72 :     share = NONE,
73 :     split = split })
74 : blume 326 end
75 :     fun bogus n =
76 : blume 327 DG.SNODE { smlinfo = #2 (sml (n, false)),
77 : blume 326 localimports = [], globalimports = [] }
78 :     fun look n =
79 :     case StringMap.find (m, n) of
80 :     SOME x => x
81 :     | NONE =>
82 :     (case Primitive.fromString primconf n of
83 :     SOME p => DG.SB_BNODE (DG.PNODE p)
84 :     | NONE => (error ("undefined: " ^ n);
85 :     DG.SB_SNODE (bogus n)))
86 :    
87 :     fun look_snode n =
88 :     case look n of
89 :     DG.SB_SNODE n => n
90 :     | _ => (error ("illegal: " ^ n); bogus n)
91 :    
92 : blume 327 fun node (name, file, args) = let
93 : blume 326 fun one (arg, (li, gi)) =
94 :     case look arg of
95 :     DG.SB_SNODE n => (n :: li, gi)
96 :     | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
97 :     val (li, gi) = foldr one ([], []) args
98 : blume 327 val (p, i) = sml (file, split)
99 :     val n = DG.SNODE { smlinfo = i,
100 : blume 326 localimports = li,
101 :     globalimports = gi }
102 : blume 329 val pl' =
103 :     case pl of
104 :     NONE => NONE
105 :     | SOME l => SOME (p :: l)
106 : blume 326 in
107 : blume 327 loop (split,
108 :     StringMap.insert (m, name, DG.SB_SNODE n),
109 : blume 329 pl', newpos)
110 : blume 326 end
111 :     in
112 :     case line of
113 : blume 327 [] => loop (split, m, pl, newpos)
114 :     | ["split"] => loop (true, m, pl, newpos)
115 :     | ["nosplit"] => loop (false, m, pl, newpos)
116 : blume 329 | ["start"] => loop (split, m, SOME [], newpos)
117 :     | ("bind" :: name :: file :: args) =>
118 : blume 327 node (name, file, args)
119 : blume 331 | ("return" :: core :: rts :: pervasive :: prims) =>
120 : blume 330 SOME { rts = look_snode rts,
121 :     core = look_snode core,
122 :     pervasive = look_snode pervasive,
123 :     primitives =
124 : blume 329 map (fn n => (n, look_snode n)) prims,
125 : blume 330 filepaths = rev (getOpt (pl, [])) }
126 : blume 326 | _ => (error "malformed line"; NONE)
127 :     end
128 :     in
129 : blume 330 loop (false, StringMap.empty, NONE, 1)
130 : blume 326 end
131 :     end

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