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 326 - (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 :     * pervasive env that is used in the rest of the system.
5 :     * - The DAG does not contain any BNODEs and the only PNODE will
6 :     * be the one for Environment.primEnv.
7 :     *
8 :     * (C) 1999 Lucent Technologies, Bell Laboratories
9 :     *
10 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
11 :     *)
12 :    
13 :     signature BUILDINITDG = sig
14 :     val build : GeneralParams.info -> AbsPath.t ->
15 :     { rts: DependencyGraph.snode,
16 :     core: DependencyGraph.snode,
17 :     pervasive: DependencyGraph.snode,
18 :     primitives: DependencyGraph.snode list }
19 :     end
20 :    
21 :     structure BuildInitDG = struct
22 :    
23 :     structure S = GenericVC.Source
24 :     structure EM = GenericVC.ErrorMsg
25 :     structure SM = GenericVC.SourceMap
26 :     structure DG = DependencyGraph
27 :    
28 :     fun build (gp: GeneralParams.info) specgroup = let
29 :     val pcmode = #pcmode (#param gp)
30 :     val primconf = #primconf (#param gp)
31 :     val errcons = #errcons gp
32 :     val groupreg = #groupreg gp
33 :    
34 :     val context = AbsPath.relativeContext (AbsPath.dir specgroup)
35 :     val specname = AbsPath.name specgroup
36 :     val stream = TextIO.openIn specname
37 :     val source = S.newSource (specname, 1, stream, false, errcons)
38 :     val sourceMap = #sourceMap source
39 :    
40 :     val _ = GroupReg.register groupreg (specgroup, source)
41 :    
42 :     fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody
43 :    
44 :     fun lineIn pos = let
45 :     val line = TextIO.inputLine stream
46 :     val len = size line
47 :     val newpos = pos + len
48 :     val _ = GenericVC.SourceMap.newline sourceMap newpos
49 :     fun sep c = Char.isSpace c orelse Char.contains "(),=;" c
50 :     in
51 :     if line = "" then NONE
52 :     else if String.sub (line, 0) = #"#" then SOME ([], newpos)
53 :     else SOME (String.tokens sep line, newpos)
54 :     end
55 :    
56 :     fun loop (split, m, fl, pos) =
57 :     case lineIn pos of
58 :     NONE => (error (pos, pos) "unexpected end of file"; NONE)
59 :     | SOME (line, newpos) => let
60 :     val error = error (pos, newpos)
61 :     fun sml (spec, split) = let
62 :     val sourcepath = AbsPath.standard pcmode
63 :     { context = context, spec = spec }
64 :     in
65 :     SmlInfo.info gp { sourcepath = sourcepath,
66 :     group = (specgroup, (pos, newpos)),
67 :     share = NONE,
68 :     split = split }
69 :     end
70 :     fun bogus n =
71 :     DG.SNODE { smlinfo = sml (n, false),
72 :     localimports = [], globalimports = [] }
73 :     fun look n =
74 :     case StringMap.find (m, n) of
75 :     SOME x => x
76 :     | NONE =>
77 :     (case Primitive.fromString primconf n of
78 :     SOME p => DG.SB_BNODE (DG.PNODE p)
79 :     | NONE => (error ("undefined: " ^ n);
80 :     DG.SB_SNODE (bogus n)))
81 :    
82 :     fun look_snode n =
83 :     case look n of
84 :     DG.SB_SNODE n => n
85 :     | _ => (error ("illegal: " ^ n); bogus n)
86 :    
87 :     fun node (name, file, split, args) = let
88 :     fun one (arg, (li, gi)) =
89 :     case look arg of
90 :     DG.SB_SNODE n => (n :: li, gi)
91 :     | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
92 :     val (li, gi) = foldr one ([], []) args
93 :     val n = DG.SNODE { smlinfo = sml (file, split),
94 :     localimports = li,
95 :     globalimports = gi }
96 :     in
97 :     StringMap.insert (m, name, DG.SB_SNODE n)
98 :     end
99 :     in
100 :     case line of
101 :     [] => loop (split, m, fl, newpos)
102 :     | ["split"] => loop (true, m, fl, newpos)
103 :     | ["nosplit"] => loop (false, m, fl, newpos)
104 :     | ("let" :: name :: file :: args) =>
105 :     loop (split, node (name, file, split, args),
106 :     file :: fl, newpos)
107 :     | ("return" :: rts :: core :: pervasive :: primitives) =>
108 :     SOME { rts = look_snode rts,
109 :     core = look_snode core,
110 :     pervasive = look_snode pervasive,
111 :     primitives = map look_snode primitives }
112 :     | _ => (error "malformed line"; NONE)
113 :     end
114 :     in
115 :     loop (false, StringMap.empty, [], 2) (* consistent with ml-lex bug? *)
116 :     end
117 :     end

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