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 449 - (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 358 { rts: DependencyGraph.sbnode,
17 :     core: DependencyGraph.sbnode,
18 :     pervasive: DependencyGraph.sbnode,
19 :     primitives: (string * DependencyGraph.sbnode) list,
20 : blume 364 binpaths: (string * bool) list } option
21 : blume 326 end
22 :    
23 : blume 327 structure BuildInitDG :> BUILD_INIT_DG = struct
24 : blume 326
25 :     structure S = GenericVC.Source
26 :     structure EM = GenericVC.ErrorMsg
27 :     structure SM = GenericVC.SourceMap
28 :     structure DG = DependencyGraph
29 :    
30 :     fun build (gp: GeneralParams.info) specgroup = let
31 :     val pcmode = #pcmode (#param gp)
32 :     val primconf = #primconf (#param gp)
33 :     val errcons = #errcons gp
34 :     val groupreg = #groupreg gp
35 :    
36 : blume 354 val context = SrcPath.sameDirContext specgroup
37 :     val _ = Say.vsay ["[reading init spec from ",
38 :     SrcPath.descr specgroup, "]\n"]
39 : blume 326
40 : blume 345 fun work stream = let
41 : blume 354 val source = S.newSource (SrcPath.osstring specgroup,
42 :     1, stream, false, errcons)
43 : blume 345 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 364 fun loop (split, m, bnl, pos, lst) =
62 : blume 345 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 : blume 354 val p = SrcPath.standard pcmode
68 : blume 345 { context = context, spec = spec }
69 :     in
70 :     SmlInfo.info gp { sourcepath = p,
71 :     group = (specgroup,
72 :     (pos, newpos)),
73 : blume 387 sh_spec = Sharing.DONTCARE,
74 : blume 345 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 : blume 398 SOME p => let
85 :     val ii =
86 :     Primitive.iinfo primconf p
87 :     in
88 :     DG.SB_BNODE (DG.PNODE p, ii)
89 :     end
90 : blume 345 | NONE => (error ("undefined: " ^ n);
91 :     DG.SB_SNODE (bogus n)))
92 : blume 326
93 : blume 345 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 : blume 371 localimports = li,
102 :     globalimports = gi }
103 : blume 345 in
104 :     loop (split,
105 :     StringMap.insert (m, name, DG.SB_SNODE n),
106 : blume 364 (SmlInfo.binname i, lst) :: bnl,
107 :     newpos,
108 :     lst)
109 : blume 345 end
110 : blume 326 in
111 : blume 345 case line of
112 : blume 364 [] => loop (split, m, bnl, newpos, lst)
113 :     | ["split"] => loop (true, m, bnl, newpos, lst)
114 :     | ["nosplit"] => loop (false, m, bnl, newpos, lst)
115 :     | ["start"] => loop (split, m, bnl, newpos, true)
116 : blume 345 | ("bind" :: name :: file :: args) =>
117 :     node (name, file, args)
118 :     | ("return" :: core :: rts :: pervasive :: prims) =>
119 : blume 358 SOME { rts = look rts,
120 :     core = look core,
121 :     pervasive = look pervasive,
122 : blume 345 primitives =
123 : blume 358 map (fn n => (n, look n)) prims,
124 : blume 364 binpaths = rev bnl }
125 : blume 345 | _ => (error "malformed line"; NONE)
126 : blume 326 end
127 : blume 345 in
128 : blume 364 loop (false, StringMap.empty, [], 1, false)
129 : blume 345 end
130 : blume 364 fun openIt () = TextIO.openIn (SrcPath.osstring specgroup)
131 : blume 326 in
132 : blume 364 SafeIO.perform { openIt = openIt,
133 : blume 345 closeIt = TextIO.closeIn,
134 :     work = work,
135 :     cleanup = fn () => () }
136 : blume 326 end
137 :     end

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