Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/SMLNJ/src/cm/bootstrap/build-initdg.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/cm/bootstrap/build-initdg.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 629, Wed Apr 26 04:06:41 2000 UTC revision 630, Wed Apr 26 18:40:56 2000 UTC
# Line 1  Line 1 
1  (*  (*
2   * Build a simple dependency graph from a direct DAG description.   * Build a simple dependency graph from a direct DAG description.
3   *   - This is used in the bootstrap compiler to establish the   *   - This is used in the bootstrap compiler to establish the
4   *     pervasive env that is used in the rest of the system.   *     pervasive env, the core env, and the primitives which later
5   *   - The DAG does not contain any BNODEs and the only PNODE will   *     get used by the rest of the system.
6   *     be the one for Environment.primEnv.   *   - 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   *   *
10   * (C) 1999 Lucent Technologies, Bell Laboratories   * (C) 1999 Lucent Technologies, Bell Laboratories
11   *   *
12   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
13   *)   *)
14    signature BUILD_INIT_DG = sig
15  signature BUILDINITDG = sig      val build : GeneralParams.info -> SrcPath.t ->
16      val build : GeneralParams.info -> AbsPath.t ->          { rts: DependencyGraph.sbnode,
17          { rts: DependencyGraph.snode,            core: DependencyGraph.sbnode,
18            core: DependencyGraph.snode,            pervasive: DependencyGraph.sbnode,
19            pervasive: DependencyGraph.snode,            primitives: (string * DependencyGraph.sbnode) list,
20            primitives: DependencyGraph.snode list }            binpaths: (string * bool) list } option
21  end  end
22    
23  structure BuildInitDG = struct  structure BuildInitDG :> BUILD_INIT_DG = struct
24    
25      structure S = GenericVC.Source      structure S = GenericVC.Source
26      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
# Line 31  Line 33 
33          val errcons = #errcons gp          val errcons = #errcons gp
34          val groupreg = #groupreg gp          val groupreg = #groupreg gp
35    
36          val context = AbsPath.relativeContext (AbsPath.dir specgroup)          val context = SrcPath.sameDirContext specgroup
37          val specname = AbsPath.name specgroup          val _ = Say.vsay ["[reading init spec from ",
38          val stream = TextIO.openIn specname                            SrcPath.descr specgroup, "]\n"]
39          val source = S.newSource (specname, 1, stream, false, errcons)  
40            fun work stream = let
41                val source = S.newSource (SrcPath.osstring specgroup,
42                                          1, stream, false, errcons)
43          val sourceMap = #sourceMap source          val sourceMap = #sourceMap source
44    
45          val _ = GroupReg.register groupreg (specgroup, source)          val _ = GroupReg.register groupreg (specgroup, source)
# Line 53  Line 58 
58              else SOME (String.tokens sep line, newpos)              else SOME (String.tokens sep line, newpos)
59          end          end
60    
61          fun loop (split, m, fl, pos) =              fun loop (split, m, bnl, pos, lst) =
62              case lineIn pos of              case lineIn pos of
63                  NONE => (error (pos, pos) "unexpected end of file"; NONE)                  NONE => (error (pos, pos) "unexpected end of file"; NONE)
64                | SOME (line, newpos) => let                | SOME (line, newpos) => let
65                      val error = error (pos, newpos)                      val error = error (pos, newpos)
66                      fun sml (spec, split) = let                      fun sml (spec, split) = let
67                          val sourcepath = AbsPath.standard pcmode                              val p = SrcPath.standard pcmode
68                              { context = context, spec = spec }                              { context = context, spec = spec }
69                      in                      in
70                          SmlInfo.info gp { sourcepath = sourcepath,                              SmlInfo.info gp { sourcepath = p,
71                                            group = (specgroup, (pos, newpos)),                                                group = (specgroup,
72                                            share = NONE,                                                         (pos, newpos)),
73                                                  sh_spec = Sharing.DONTCARE,
74                                            split = split }                                            split = split }
75                      end                      end
76                      fun bogus n =                      fun bogus n =
# Line 75  Line 81 
81                              SOME x => x                              SOME x => x
82                            | NONE =>                            | NONE =>
83                                  (case Primitive.fromString primconf n of                                  (case Primitive.fromString primconf n of
84                                       SOME p => DG.SB_BNODE (DG.PNODE p)                                           SOME p =>  let
85                                                 val ii =
86                                                     Primitive.iinfo primconf p
87                                             in
88                                                 DG.SB_BNODE (DG.PNODE p, ii)
89                                             end
90                                     | NONE => (error ("undefined: " ^ n);                                     | NONE => (error ("undefined: " ^ n);
91                                                DG.SB_SNODE (bogus n)))                                                DG.SB_SNODE (bogus n)))
92    
93                      fun look_snode n =                          fun node (name, file, args) = let
                         case look n of  
                             DG.SB_SNODE n => n  
                           | _ => (error ("illegal: " ^ n); bogus n)  
   
                     fun node (name, file, split, args) = let  
94                          fun one (arg, (li, gi)) =                          fun one (arg, (li, gi)) =
95                              case look arg of                              case look arg of
96                                  DG.SB_SNODE n => (n :: li, gi)                                  DG.SB_SNODE n => (n :: li, gi)
97                                | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)                                | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
98                          val (li, gi) = foldr one ([], []) args                          val (li, gi) = foldr one ([], []) args
99                          val n = DG.SNODE { smlinfo = sml (file, split),                              val i = sml (file, split)
100                                val n = DG.SNODE { smlinfo = i,
101                                             localimports = li,                                             localimports = li,
102                                             globalimports = gi }                                             globalimports = gi }
103                      in                      in
104                          StringMap.insert (m, name, DG.SB_SNODE n)                              loop (split,
105                                      StringMap.insert (m, name, DG.SB_SNODE n),
106                                      (SmlInfo.binname i, lst) :: bnl,
107                                      newpos,
108                                      lst)
109                      end                      end
110                  in                  in
111                      case line of                      case line of
112                          [] => loop (split, m, fl, newpos)                              [] => loop (split, m, bnl, newpos, lst)
113                        | ["split"] => loop (true, m, fl, newpos)                            | ["split"] => loop (true, m, bnl, newpos, lst)
114                        | ["nosplit"] => loop (false, m, fl, newpos)                            | ["nosplit"] => loop (false, m, bnl, newpos, lst)
115                        | ("let" :: name :: file :: args)  =>                            | ["start"] => loop (split, m, bnl, newpos, true)
116                              loop (split, node (name, file, split, args),                            | ("bind" :: name :: file :: args)  =>
117                                    file :: fl, newpos)                                  node (name, file, args)
118                        | ("return" :: rts :: core :: pervasive :: primitives) =>                            | ("return" :: core :: rts :: pervasive :: prims) =>
119                              SOME { rts = look_snode rts,                                  SOME { rts = look rts,
120                                     core = look_snode core,                                         core = look core,
121                                     pervasive = look_snode pervasive,                                         pervasive = look pervasive,
122                                     primitives = map look_snode primitives }                                         primitives =
123                                                  map (fn n => (n, look n)) prims,
124                                           binpaths = rev bnl }
125                        | _ => (error "malformed line"; NONE)                        | _ => (error "malformed line"; NONE)
126                  end                  end
127      in      in
128          loop (false, StringMap.empty, [], 2) (* consistent with ml-lex bug? *)              loop (false, StringMap.empty, [], 1, false)
129            end
130            fun openIt () = TextIO.openIn (SrcPath.osstring specgroup)
131        in
132            SafeIO.perform { openIt = openIt,
133                             closeIt = TextIO.closeIn,
134                             work = work,
135                             cleanup = fn _ => () }
136      end      end
137  end  end

Legend:
Removed from v.629  
changed lines
  Added in v.630

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