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 327 - (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 :     val stream = TextIO.openIn specname
40 :     val source = S.newSource (specname, 1, stream, false, errcons)
41 :     val sourceMap = #sourceMap source
42 :    
43 :     val _ = GroupReg.register groupreg (specgroup, source)
44 :    
45 :     fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody
46 :    
47 :     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 :    
59 : blume 327 fun loop (split, m, pl, pos) =
60 : blume 326 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 :     fun sml (spec, split) = let
65 : blume 327 val p = AbsPath.standard pcmode
66 : blume 326 { context = context, spec = spec }
67 :     in
68 : blume 327 (p,
69 :     SmlInfo.info gp { sourcepath = p,
70 :     group = (specgroup, (pos, newpos)),
71 :     share = NONE,
72 :     split = split })
73 : blume 326 end
74 :     fun bogus n =
75 : blume 327 DG.SNODE { smlinfo = #2 (sml (n, false)),
76 : blume 326 localimports = [], globalimports = [] }
77 :     fun look n =
78 :     case StringMap.find (m, n) of
79 :     SOME x => x
80 :     | NONE =>
81 :     (case Primitive.fromString primconf n of
82 :     SOME p => DG.SB_BNODE (DG.PNODE p)
83 :     | NONE => (error ("undefined: " ^ n);
84 :     DG.SB_SNODE (bogus n)))
85 :    
86 :     fun look_snode n =
87 :     case look n of
88 :     DG.SB_SNODE n => n
89 :     | _ => (error ("illegal: " ^ n); bogus n)
90 :    
91 : blume 327 fun node (name, file, args) = let
92 : blume 326 fun one (arg, (li, gi)) =
93 :     case look arg of
94 :     DG.SB_SNODE n => (n :: li, gi)
95 :     | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
96 :     val (li, gi) = foldr one ([], []) args
97 : blume 327 val (p, i) = sml (file, split)
98 :     val n = DG.SNODE { smlinfo = i,
99 : blume 326 localimports = li,
100 :     globalimports = gi }
101 :     in
102 : blume 327 loop (split,
103 :     StringMap.insert (m, name, DG.SB_SNODE n),
104 :     p :: pl, newpos)
105 : blume 326 end
106 :     in
107 :     case line of
108 : blume 327 [] => loop (split, m, pl, newpos)
109 :     | ["split"] => loop (true, m, pl, newpos)
110 :     | ["nosplit"] => loop (false, m, pl, newpos)
111 : blume 326 | ("let" :: name :: file :: args) =>
112 : blume 327 node (name, file, args)
113 :     | ("return" :: rts :: core :: pervasive :: prims) =>
114 : blume 326 SOME { rts = look_snode rts,
115 :     core = look_snode core,
116 :     pervasive = look_snode pervasive,
117 : blume 327 primitives =
118 :     map (fn n => (n, look_snode n)) prims,
119 :     filepaths = rev pl }
120 : blume 326 | _ => (error "malformed line"; NONE)
121 :     end
122 :     in
123 :     loop (false, StringMap.empty, [], 2) (* consistent with ml-lex bug? *)
124 :     end
125 :     end

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