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/trunk/src/cm/bootstrap/build-initdg.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/bootstrap/build-initdg.sml

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

revision 326, Thu Jun 10 06:08:29 1999 UTC revision 327, Thu Jun 10 09:14:48 1999 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    
15  signature BUILDINITDG = sig  signature BUILD_INIT_DG = sig
16      val build : GeneralParams.info -> AbsPath.t ->      val build : GeneralParams.info -> AbsPath.t ->
17          { rts: DependencyGraph.snode,          { rts: DependencyGraph.snode,
18            core: DependencyGraph.snode,            core: DependencyGraph.snode,
19            pervasive: DependencyGraph.snode,            pervasive: DependencyGraph.snode,
20            primitives: DependencyGraph.snode list }            primitives: (string * DependencyGraph.snode) list,
21              filepaths: AbsPath.t list } option
22  end  end
23    
24  structure BuildInitDG = struct  structure BuildInitDG :> BUILD_INIT_DG = struct
25    
26      structure S = GenericVC.Source      structure S = GenericVC.Source
27      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
# Line 53  Line 56 
56              else SOME (String.tokens sep line, newpos)              else SOME (String.tokens sep line, newpos)
57          end          end
58    
59          fun loop (split, m, fl, pos) =          fun loop (split, m, pl, pos) =
60              case lineIn pos of              case lineIn pos of
61                  NONE => (error (pos, pos) "unexpected end of file"; NONE)                  NONE => (error (pos, pos) "unexpected end of file"; NONE)
62                | SOME (line, newpos) => let                | SOME (line, newpos) => let
63                      val error = error (pos, newpos)                      val error = error (pos, newpos)
64                      fun sml (spec, split) = let                      fun sml (spec, split) = let
65                          val sourcepath = AbsPath.standard pcmode                          val p = AbsPath.standard pcmode
66                              { context = context, spec = spec }                              { context = context, spec = spec }
67                      in                      in
68                          SmlInfo.info gp { sourcepath = sourcepath,                          (p,
69                             SmlInfo.info gp { sourcepath = p,
70                                            group = (specgroup, (pos, newpos)),                                            group = (specgroup, (pos, newpos)),
71                                            share = NONE,                                            share = NONE,
72                                            split = split }                                             split = split })
73                      end                      end
74                      fun bogus n =                      fun bogus n =
75                          DG.SNODE { smlinfo = sml (n, false),                          DG.SNODE { smlinfo = #2 (sml (n, false)),
76                                     localimports = [], globalimports = [] }                                     localimports = [], globalimports = [] }
77                      fun look n =                      fun look n =
78                          case StringMap.find (m, n) of                          case StringMap.find (m, n) of
# Line 84  Line 88 
88                              DG.SB_SNODE n => n                              DG.SB_SNODE n => n
89                            | _ => (error ("illegal: " ^ n); bogus n)                            | _ => (error ("illegal: " ^ n); bogus n)
90    
91                      fun node (name, file, split, args) = let                      fun node (name, file, args) = let
92                          fun one (arg, (li, gi)) =                          fun one (arg, (li, gi)) =
93                              case look arg of                              case look arg of
94                                  DG.SB_SNODE n => (n :: li, gi)                                  DG.SB_SNODE n => (n :: li, gi)
95                                | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)                                | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
96                          val (li, gi) = foldr one ([], []) args                          val (li, gi) = foldr one ([], []) args
97                          val n = DG.SNODE { smlinfo = sml (file, split),                          val (p, i) = sml (file, split)
98                            val n = DG.SNODE { smlinfo = i,
99                                             localimports = li,                                             localimports = li,
100                                             globalimports = gi }                                             globalimports = gi }
101                      in                      in
102                          StringMap.insert (m, name, DG.SB_SNODE n)                          loop (split,
103                                  StringMap.insert (m, name, DG.SB_SNODE n),
104                                  p :: pl, newpos)
105                      end                      end
106                  in                  in
107                      case line of                      case line of
108                          [] => loop (split, m, fl, newpos)                          [] => loop (split, m, pl, newpos)
109                        | ["split"] => loop (true, m, fl, newpos)                        | ["split"] => loop (true, m, pl, newpos)
110                        | ["nosplit"] => loop (false, m, fl, newpos)                        | ["nosplit"] => loop (false, m, pl, newpos)
111                        | ("let" :: name :: file :: args)  =>                        | ("let" :: name :: file :: args)  =>
112                              loop (split, node (name, file, split, args),                              node (name, file, args)
113                                    file :: fl, newpos)                        | ("return" :: rts :: core :: pervasive :: prims) =>
                       | ("return" :: rts :: core :: pervasive :: primitives) =>  
114                              SOME { rts = look_snode rts,                              SOME { rts = look_snode rts,
115                                     core = look_snode core,                                     core = look_snode core,
116                                     pervasive = look_snode pervasive,                                     pervasive = look_snode pervasive,
117                                     primitives = map look_snode primitives }                                     primitives =
118                                            map (fn n => (n, look_snode n)) prims,
119                                       filepaths = rev pl }
120                        | _ => (error "malformed line"; NONE)                        | _ => (error "malformed line"; NONE)
121                  end                  end
122      in      in

Legend:
Removed from v.326  
changed lines
  Added in v.327

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