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 327, Thu Jun 10 09:14:48 1999 UTC revision 371, Mon Jul 5 14:34:41 1999 UTC
# Line 13  Line 13 
13   *)   *)
14    
15  signature BUILD_INIT_DG = sig  signature BUILD_INIT_DG = sig
16      val build : GeneralParams.info -> AbsPath.t ->      val build : GeneralParams.info -> SrcPath.t ->
17          { rts: DependencyGraph.snode,          { rts: DependencyGraph.sbnode,
18            core: DependencyGraph.snode,            core: DependencyGraph.sbnode,
19            pervasive: DependencyGraph.snode,            pervasive: DependencyGraph.sbnode,
20            primitives: (string * DependencyGraph.snode) list,            primitives: (string * DependencyGraph.sbnode) list,
21            filepaths: AbsPath.t list } option            binpaths: (string * bool) list } option
22  end  end
23    
24  structure BuildInitDG :> BUILD_INIT_DG = struct  structure BuildInitDG :> BUILD_INIT_DG = struct
# Line 34  Line 34 
34          val errcons = #errcons gp          val errcons = #errcons gp
35          val groupreg = #groupreg gp          val groupreg = #groupreg gp
36    
37          val context = AbsPath.relativeContext (AbsPath.dir specgroup)          val context = SrcPath.sameDirContext specgroup
38          val specname = AbsPath.name specgroup          val _ = Say.vsay ["[reading init spec from ",
39          val stream = TextIO.openIn specname                            SrcPath.descr specgroup, "]\n"]
40          val source = S.newSource (specname, 1, stream, false, errcons)  
41            fun work stream = let
42                val source = S.newSource (SrcPath.osstring specgroup,
43                                          1, stream, false, errcons)
44          val sourceMap = #sourceMap source          val sourceMap = #sourceMap source
45    
46          val _ = GroupReg.register groupreg (specgroup, source)          val _ = GroupReg.register groupreg (specgroup, source)
# Line 56  Line 59 
59              else SOME (String.tokens sep line, newpos)              else SOME (String.tokens sep line, newpos)
60          end          end
61    
62          fun loop (split, m, pl, pos) =              fun loop (split, m, bnl, pos, lst) =
63              case lineIn pos of              case lineIn pos of
64                  NONE => (error (pos, pos) "unexpected end of file"; NONE)                  NONE => (error (pos, pos) "unexpected end of file"; NONE)
65                | SOME (line, newpos) => let                | SOME (line, newpos) => let
66                      val error = error (pos, newpos)                      val error = error (pos, newpos)
67                      fun sml (spec, split) = let                      fun sml (spec, split) = let
68                          val p = AbsPath.standard pcmode                              val p = SrcPath.standard pcmode
69                              { context = context, spec = spec }                              { context = context, spec = spec }
70                      in                      in
                         (p,  
71                           SmlInfo.info gp { sourcepath = p,                           SmlInfo.info gp { sourcepath = p,
72                                             group = (specgroup, (pos, newpos)),                                                group = (specgroup,
73                                                           (pos, newpos)),
74                                             share = NONE,                                             share = NONE,
75                                             split = split })                                                split = split }
76                      end                      end
77                      fun bogus n =                      fun bogus n =
78                          DG.SNODE { smlinfo = #2 (sml (n, false)),                              DG.SNODE { smlinfo = sml (n, false),
79                                     localimports = [], globalimports = [] }                                     localimports = [], globalimports = [] }
80                      fun look n =                      fun look n =
81                          case StringMap.find (m, n) of                          case StringMap.find (m, n) of
# Line 83  Line 86 
86                                     | NONE => (error ("undefined: " ^ n);                                     | NONE => (error ("undefined: " ^ n);
87                                                DG.SB_SNODE (bogus n)))                                                DG.SB_SNODE (bogus n)))
88    
                     fun look_snode n =  
                         case look n of  
                             DG.SB_SNODE n => n  
                           | _ => (error ("illegal: " ^ n); bogus n)  
   
89                      fun node (name, file, args) = let                      fun node (name, file, args) = let
90                          fun one (arg, (li, gi)) =                          fun one (arg, (li, gi)) =
91                              case look arg of                              case look arg of
92                                  DG.SB_SNODE n => (n :: li, gi)                                  DG.SB_SNODE n => (n :: li, gi)
93                                | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)                                | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
94                          val (li, gi) = foldr one ([], []) args                          val (li, gi) = foldr one ([], []) args
95                          val (p, i) = sml (file, split)                              val i = sml (file, split)
96                          val n = DG.SNODE { smlinfo = i,                          val n = DG.SNODE { smlinfo = i,
97                                             localimports = li,                                             localimports = li,
98                                             globalimports = gi }                                             globalimports = gi }
99                      in                      in
100                          loop (split,                          loop (split,
101                                StringMap.insert (m, name, DG.SB_SNODE n),                                StringMap.insert (m, name, DG.SB_SNODE n),
102                                p :: pl, newpos)                                    (SmlInfo.binname i, lst) :: bnl,
103                                      newpos,
104                                      lst)
105                      end                      end
106                  in                  in
107                      case line of                      case line of
108                          [] => loop (split, m, pl, newpos)                              [] => loop (split, m, bnl, newpos, lst)
109                        | ["split"] => loop (true, m, pl, newpos)                            | ["split"] => loop (true, m, bnl, newpos, lst)
110                        | ["nosplit"] => loop (false, m, pl, newpos)                            | ["nosplit"] => loop (false, m, bnl, newpos, lst)
111                        | ("let" :: name :: file :: args)  =>                            | ["start"] => loop (split, m, bnl, newpos, true)
112                              | ("bind" :: name :: file :: args)  =>
113                              node (name, file, args)                              node (name, file, args)
114                        | ("return" :: rts :: core :: pervasive :: prims) =>                            | ("return" :: core :: rts :: pervasive :: prims) =>
115                              SOME { rts = look_snode rts,                                  SOME { rts = look rts,
116                                     core = look_snode core,                                         core = look core,
117                                     pervasive = look_snode pervasive,                                         pervasive = look pervasive,
118                                     primitives =                                     primitives =
119                                          map (fn n => (n, look_snode n)) prims,                                                map (fn n => (n, look n)) prims,
120                                     filepaths = rev pl }                                         binpaths = rev bnl }
121                        | _ => (error "malformed line"; NONE)                        | _ => (error "malformed line"; NONE)
122                  end                  end
123      in      in
124          loop (false, StringMap.empty, [], 2) (* consistent with ml-lex bug? *)              loop (false, StringMap.empty, [], 1, false)
125            end
126            fun openIt () = TextIO.openIn (SrcPath.osstring specgroup)
127        in
128            SafeIO.perform { openIt = openIt,
129                             closeIt = TextIO.closeIn,
130                             work = work,
131                             cleanup = fn () => () }
132      end      end
133  end  end

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

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