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/main/cm-boot.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/main/cm-boot.sml

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

revision 1925, Fri May 12 20:16:43 2006 UTC revision 1926, Mon May 15 20:15:32 2006 UTC
# Line 331  Line 331 
331                                      (GroupReg.new (), NONE, mkStdSrcPath s)))                                      (GroupReg.new (), NONE, mkStdSrcPath s)))
332            end            end
333    
334            fun sources archos group = let            fun sources archos group =
335                val policy =                let val policy =
336                    case archos of                    case archos of
337                        NONE => fnpolicy                        NONE => fnpolicy
338                      | SOME ao => FilenamePolicy.colocate_generic ao                      | SOME ao => FilenamePolicy.colocate_generic ao
339                fun sourcesOf ((p, gth, _), (v, a, r)) =                    fun snam (p, version) = FilenamePolicy.mkStableName
340                    let val v' = SrcPathSet.add (v, p)                                                policy (p, version)
341                    in case gth () of                    fun insert0 (a, f, x) = StringMap.insert (a, f, x)
342                           GG.ERRORGROUP => (v', a, r)                    fun insert (a, p, x) = insert0 (a, SrcPath.osstring p, x)
343                      fun add (s, p) = SrcPathSet.add (s, p)
344    
345                      fun addSources (subgroups, sources, a, v) =
346                          let fun findSG p =
347                                  List.find (fn (p', _, _) =>
348                                                SrcPath.compare (p, p') = EQUAL)
349                                            subgroups
350                              fun one (p, x as { class, derived }, (a, v)) =
351                                  if SrcPathSet.member (v, p) then (a, v)
352                                  else if class = "cm" then
353                                      case findSG p of
354                                          NONE => (a, v) (* unused group/library *)
355                                        | SOME (_, gth, _) =>
356                                            addGroup (p, x, gth, a, add (v, p))
357                                  else (insert (a, p, x), add (v, p))
358                          in SrcPathMap.foldli one (a, v) sources
359                          end
360    
361                      and addGroup (p, x, gth, a, v) =
362                          case gth () of
363                              GG.ERRORGROUP => (a, v)
364                         | GG.GROUP { kind, sources, ... } =>                         | GG.GROUP { kind, sources, ... } =>
365                           let fun add (p, x, a) =                              (case kind of
                                  StringMap.insert (a, SrcPath.osstring p, x)  
                              fun sg l =  
                                  if SrcPathSet.member (v, p) then (v, a, r)  
                                  else foldl sourcesOf  
                                             (v', SrcPathMap.foldli  
                                                      add a sources, r)  
                                             l  
                          in case kind of  
366                                  GG.LIB { kind, version } =>                                  GG.LIB { kind, version } =>
367                                  (case kind of                                  (case kind of
368                                       GG.STABLE _ =>                                       GG.STABLE _ =>
369                                       let val f = SrcPath.osstring p                                            (insert0 (a, snam (p, version), x), v)
370                                           val r' = StringSet.add (r, f)                                        | GG.DEVELOPED d =>
371                                           val x = valOf (StringMap.find (a, f))                                            addSources (#subgroups d, sources,
372                                           val sf = FilenamePolicy.mkStableName                                                        insert (a, p, x), v))
373                                                        policy (p, version)                                 | GG.NOLIB n =>
374                                       in (v', StringMap.insert (a, sf, x), r')                                     addSources (#subgroups n, sources,
375                                       end                                                 insert (a, p, x), v))
376                                     | GG.DEVELOPED d => sg (#subgroups d))  
                               | GG.NOLIB n => sg (#subgroups n)  
                          end  
                   end  
377                val p = mkStdSrcPath group                val p = mkStdSrcPath group
378                val gr = GroupReg.new ()                val gr = GroupReg.new ()
379            in                    val x0 = { class = "cm", derived = false }
380                (case Parse.parse (parse_arg (gr, NONE, p)) of                    fun doit () =
381                     SOME (g, _) => let                        case Parse.parse (parse_arg (gr, NONE, p)) of
382                         val (_, sm, removed) =                            SOME (g, _) =>
383                             sourcesOf ((p, fn () => g, []),                              let val (sm, _) =
384                                        (SrcPathSet.empty,                                      addGroup (p, x0, fn () => g,
385                                         StringMap.singleton                                                StringMap.empty,
386                                             (SrcPath.osstring p,                                                SrcPathSet.singleton p)
387                                              { class = "cm",                                  fun add (f, { class, derived }, l) =
388                                                derived = false }),                                      { file = f, class = class,
389                                         StringSet.empty))                                        derived = derived } :: l
                        fun trim (f, sm) = #1 (StringMap.remove (sm, f))  
                        val sm = StringSet.foldl trim sm removed  
                        fun add (s, { class, derived }, l) =  
                            { file = s, class = class, derived = derived } :: l  
390                     in SOME (StringMap.foldli add [] sm)                     in SOME (StringMap.foldli add [] sm)
391                     end                     end
392                   | _ => NONE)                          | NONE => NONE
393                before dropPickles ()                in doit () before dropPickles ()
394            end            end
395    
396            fun mk_standalone sflag { setup, project, wrapper, target } = let            fun mk_standalone sflag { setup, project, wrapper, target } = let

Legend:
Removed from v.1925  
changed lines
  Added in v.1926

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