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 986 - (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 592 * pervasive env and the primitives which later get used by
5 :     * the rest of the system.
6 :     * - One important job is to set up a binding to "structure _Core".
7 : blume 326 *
8 :     * (C) 1999 Lucent Technologies, Bell Laboratories
9 :     *
10 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
11 :     *)
12 : blume 327 signature BUILD_INIT_DG = sig
13 : blume 666 val build : GeneralParams.info -> SrcPath.file ->
14 : blume 592 { pervasive: DependencyGraph.sbnode,
15 : blume 537 others: DependencyGraph.sbnode list,
16 : blume 879 src: Source.inputSource } option
17 : blume 326 end
18 :    
19 : blume 327 structure BuildInitDG :> BUILD_INIT_DG = struct
20 : blume 326
21 : blume 879 structure S = Source
22 :     structure EM = ErrorMsg
23 :     structure SM = SourceMap
24 : blume 326 structure DG = DependencyGraph
25 : blume 879 structure LSC = Control.LambdaSplitting
26 : blume 326
27 :     fun build (gp: GeneralParams.info) specgroup = let
28 : blume 666 val penv = #penv (#param gp)
29 : blume 326 val errcons = #errcons gp
30 :     val groupreg = #groupreg gp
31 :    
32 : blume 666 val context = SrcPath.dir specgroup
33 : blume 354 val _ = Say.vsay ["[reading init spec from ",
34 :     SrcPath.descr specgroup, "]\n"]
35 : blume 326
36 : blume 715 fun defined symbol = isSome (#get (#symval (#param gp) symbol) ())
37 :    
38 : blume 345 fun work stream = let
39 : blume 354 val source = S.newSource (SrcPath.osstring specgroup,
40 :     1, stream, false, errcons)
41 : blume 345 val sourceMap = #sourceMap source
42 : blume 326
43 : blume 345 val _ = GroupReg.register groupreg (specgroup, source)
44 : blume 326
45 : blume 345 fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody
46 : blume 326
47 : blume 345 fun lineIn pos = let
48 :     fun sep c = Char.isSpace c orelse Char.contains "(),=;" c
49 : blume 735 val sub = String.sub
50 :     val null = List.null
51 :     fun return (pos, line) = SOME (String.tokens sep line, pos)
52 :     fun loop (pos, "", []) = NONE
53 :     | loop (pos, "", lines) = return (pos, concat (rev lines))
54 :     | loop (pos, line, lines) = let
55 :     val len = size line
56 :     val newpos = pos + len
57 :     val iscont =
58 :     len >= 2 andalso
59 :     sub (line, len -1 ) = #"\n" andalso
60 :     sub (line, len - 2) = #"\\"
61 :     in
62 : blume 879 SourceMap.newline sourceMap newpos;
63 : blume 735 if iscont then
64 :     loop (newpos, TextIO.inputLine stream,
65 :     substring (line, 0, len - 2) :: lines)
66 :     else if null lines andalso sub (line, 0) = #"#" then
67 :     SOME ([], newpos)
68 :     else return (newpos, concat (rev (line :: lines)))
69 :     end
70 : blume 345 in
71 : blume 735 loop (pos, TextIO.inputLine stream, [])
72 : blume 345 end
73 : blume 326
74 : blume 537 fun loop (split, m, pos) =
75 : blume 345 case lineIn pos of
76 :     NONE => (error (pos, pos) "unexpected end of file"; NONE)
77 :     | SOME (line, newpos) => let
78 :     val error = error (pos, newpos)
79 : blume 592 fun sml (spec, s, xe, rts, ecs) = let
80 : blume 666 val p = SrcPath.file
81 :     (SrcPath.standard
82 :     { env = penv, err = error }
83 :     { context = context, spec = spec })
84 : blume 537 val attribs =
85 : blume 592 { split = s, is_rts = rts, extra_compenv = xe,
86 :     explicit_core_sym = ecs }
87 : blume 345 in
88 : blume 537 SmlInfo.info' attribs gp
89 :     { sourcepath = p,
90 :     group = (specgroup, (pos, newpos)),
91 : blume 677 sh_spec = Sharing.DONTCARE,
92 : blume 986 setup = (NONE, NONE),
93 :     locl = false }
94 : blume 345 end
95 :     fun bogus n =
96 : blume 818 DG.SNODE { smlinfo = sml (n, LSC.UseDefault, NONE,
97 : blume 592 false, NONE),
98 : blume 345 localimports = [], globalimports = [] }
99 :     fun look n =
100 :     case StringMap.find (m, n) of
101 :     SOME x => x
102 : blume 537 | NONE => (error ("undefined: " ^ n); bogus n)
103 : blume 592 fun node (name, file, args, is_rts, ecs) = let
104 : blume 537 fun one (arg, (li, needs_primenv)) =
105 :     if arg = "primitive" then (li, true)
106 :     else (look arg :: li, needs_primenv)
107 :     val (li, needs_primenv) =
108 :     foldr one ([], false) args
109 :     val xe =
110 : blume 905 if needs_primenv then SOME PrimEnv.primEnv
111 : blume 537 else NONE
112 : blume 592 val i = sml (file, split, xe, is_rts, ecs)
113 : blume 345 val n = DG.SNODE { smlinfo = i,
114 : blume 371 localimports = li,
115 : blume 537 globalimports = [] }
116 : blume 345 in
117 : blume 537 loop (split, StringMap.insert (m, name, n), newpos)
118 : blume 345 end
119 : blume 537 val looksb = DG.SB_SNODE o look
120 : blume 715
121 :     fun proc [] = loop (split, m, newpos)
122 : blume 818 | proc ["split"] = loop (LSC.UseDefault, m, newpos)
123 :     | proc ["nosplit"] =
124 :     loop (LSC.Suggest NONE, m, newpos)
125 : blume 715 | proc ("bind" :: name :: file :: args) =
126 :     node (name, file, args, false, NONE)
127 :     | proc ("rts-placeholder" :: name :: file :: args) =
128 :     node (name, file, args, true, NONE)
129 :     | proc ("bind-core" :: ecs :: name :: file :: args) =
130 :     node (name, file, args, false,
131 :     SOME (Symbol.strSymbol ecs))
132 :     | proc ("return" :: pervasive :: prims) =
133 :     SOME { pervasive = looksb pervasive,
134 :     others = map looksb prims,
135 :     src = source }
136 :     | proc ("ifdef" :: symbol :: line) =
137 :     proc (if defined symbol then line else [])
138 :     | proc ("ifndef" :: symbol :: line) =
139 :     proc (if defined symbol then [] else line)
140 :     | proc _ = (error "malformed line"; NONE)
141 : blume 326 in
142 : blume 715 proc line
143 : blume 326 end
144 : blume 345 in
145 : blume 818 loop (LSC.UseDefault, StringMap.empty, 1)
146 : blume 345 end
147 : blume 364 fun openIt () = TextIO.openIn (SrcPath.osstring specgroup)
148 : blume 326 in
149 : blume 364 SafeIO.perform { openIt = openIt,
150 : blume 345 closeIt = TextIO.closeIn,
151 :     work = work,
152 : blume 459 cleanup = fn _ => () }
153 : blume 326 end
154 :     end

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