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

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