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 345 - (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 : blume 335 binpaths: 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 : blume 326
41 : blume 345 fun work stream = let
42 :     val source = S.newSource (specname, 1, stream, false, errcons)
43 :     val sourceMap = #sourceMap source
44 : blume 326
45 : blume 345 val _ = GroupReg.register groupreg (specgroup, source)
46 : blume 326
47 : blume 345 fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody
48 : blume 326
49 : blume 345 fun lineIn pos = let
50 :     val line = TextIO.inputLine stream
51 :     val len = size line
52 :     val newpos = pos + len
53 :     val _ = GenericVC.SourceMap.newline sourceMap newpos
54 :     fun sep c = Char.isSpace c orelse Char.contains "(),=;" c
55 :     in
56 :     if line = "" then NONE
57 :     else if String.sub (line, 0) = #"#" then SOME ([], newpos)
58 :     else SOME (String.tokens sep line, newpos)
59 :     end
60 : blume 326
61 : blume 345 fun loop (split, m, bpl, pos) =
62 :     case lineIn pos of
63 :     NONE => (error (pos, pos) "unexpected end of file"; NONE)
64 :     | SOME (line, newpos) => let
65 :     val error = error (pos, newpos)
66 :     fun sml (spec, split) = let
67 :     val p = AbsPath.standard pcmode
68 :     { context = context, spec = spec }
69 :     in
70 :     SmlInfo.info gp { sourcepath = p,
71 :     group = (specgroup,
72 :     (pos, newpos)),
73 :     share = NONE,
74 :     split = split }
75 :     end
76 :     fun bogus n =
77 :     DG.SNODE { smlinfo = sml (n, false),
78 :     localimports = [], globalimports = [] }
79 :     fun look n =
80 :     case StringMap.find (m, n) of
81 :     SOME x => x
82 :     | NONE =>
83 :     (case Primitive.fromString primconf n of
84 :     SOME p => DG.SB_BNODE (DG.PNODE p)
85 :     | NONE => (error ("undefined: " ^ n);
86 :     DG.SB_SNODE (bogus n)))
87 : blume 326
88 : blume 345 fun look_snode n =
89 :     case look n of
90 :     DG.SB_SNODE n => n
91 :     | _ => (error ("illegal: " ^ n); bogus n)
92 :    
93 :     fun node (name, file, args) = let
94 :     fun one (arg, (li, gi)) =
95 :     case look arg of
96 :     DG.SB_SNODE n => (n :: li, gi)
97 :     | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
98 :     val (li, gi) = foldr one ([], []) args
99 :     val i = sml (file, split)
100 :     val n = DG.SNODE { smlinfo = i,
101 :     localimports = li,
102 :     globalimports = gi }
103 :     val bpl' =
104 :     case bpl of
105 :     NONE => NONE
106 :     | SOME l => SOME (SmlInfo.binpath i :: l)
107 :     in
108 :     loop (split,
109 :     StringMap.insert (m, name, DG.SB_SNODE n),
110 :     bpl', newpos)
111 :     end
112 : blume 326 in
113 : blume 345 case line of
114 :     [] => loop (split, m, bpl, newpos)
115 :     | ["split"] => loop (true, m, bpl, newpos)
116 :     | ["nosplit"] => loop (false, m, bpl, newpos)
117 :     | ["start"] => loop (split, m, SOME [], newpos)
118 :     | ("bind" :: name :: file :: args) =>
119 :     node (name, file, args)
120 :     | ("return" :: core :: rts :: pervasive :: prims) =>
121 :     SOME { rts = look_snode rts,
122 :     core = look_snode core,
123 :     pervasive = look_snode pervasive,
124 :     primitives =
125 :     map (fn n => (n, look_snode n)) prims,
126 :     binpaths = rev (getOpt (bpl, [])) }
127 :     | _ => (error "malformed line"; NONE)
128 : blume 326 end
129 : blume 345 in
130 :     loop (false, StringMap.empty, NONE, 1)
131 :     end
132 : blume 326 in
133 : blume 345 SafeIO.perform { openIt = fn () => AbsPath.openTextIn specgroup,
134 :     closeIt = TextIO.closeIn,
135 :     work = work,
136 :     cleanup = fn () => () }
137 : blume 326 end
138 :     end

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