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/depend/build.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/depend/build.sml

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

revision 277, Mon May 17 09:13:26 1999 UTC revision 278, Mon May 17 14:53:49 1999 UTC
# Line 1  Line 1 
1  structure BuildDepend = struct  structure BuildDepend = struct
2    
3      structure S = GenericVC.Symbol      structure S = Symbol
4      structure SS = SymbolSet      structure SS = SymbolSet
5        structure SM = SymbolMap
6      structure SK = Skeleton      structure SK = Skeleton
7      structure DG = DependencyGraph      structure DG = DependencyGraph
8    
9      datatype env =      fun look otherwise DG.EMPTY s = otherwise s
10          IMPORTS        | look otherwise (DG.BINDING (s', v)) s =
11        | FCTENV of { looker: S.symbol -> value option,          if S.eq (s, s') then v else otherwise s
12                      domain: SS.set }        | look otherwise (DG.LAYER (e, e')) s = look (look otherwise e') e s
13        | BINDING of S.symbol * value        | look otherwise (DG.FCTENV { looker, domain }) s =
14        | LAYER of env * env          (case looker s of NONE => otherwise s | SOME v => v)
     withtype value = env  
15    
16      fun build { subexports, smlfiles, localdefs } = let      fun build { subexports, smlfiles, localdefs } = let
17          val results = ref AbsPathMap.empty  
18          fun lock i =          (* the "blackboard" where analysis results are announced *)
19              results :=          (* (also used for cycle detection) *)
20              AbsPathMap.insert (!results, SmlInfo.sourcepath i, NONE)          val bb = ref AbsPathMap.empty
21            fun lock i = bb := AbsPathMap.insert (!bb, SmlInfo.sourcepath i, NONE)
22          fun release (i, r) =          fun release (i, r) =
23              (results :=              (bb := AbsPathMap.insert (!bb, SmlInfo.sourcepath i, SOME r); r)
24                  AbsPathMap.insert (!results, SmlInfo.sourcepath i, SOME r);          fun fetch i = AbsPathMap.find (!bb, SmlInfo.sourcepath i)
25              r)  
26          fun fetch i = AbsPathMap.find (!results, SmlInfo.sourcepath i)          (* the "root set" *)
27            val rs = ref AbsPathSet.empty
28            fun addRoot i = rs := AbsPathSet.add (!rs, SmlInfo.sourcepath i)
29            fun delRoot i =
30                (rs := AbsPathSet.delete (!rs, SmlInfo.sourcepath i))
31                handle LibBase.NotFound => ()
32    
33            (* - get the result from the blackboard if it is there *)
34            (* - otherwise trigger analysis *)
35            (* - detect cycles using locking *)
36            (* - maintain root set *)
37          fun getResult (i, history) =          fun getResult (i, history) =
38              case fetch i of              case fetch i of
39                  NONE => (lock i; release (i, doSmlfile (i, history)))                  NONE => (lock i; addRoot i; release (i, analyze (i, history)))
40                | SOME NONE => let                | SOME (SOME r) => (delRoot i; r)
41                  | SOME NONE => let        (* cycle found --> error message *)
42                      val f = SmlInfo.sourcepath i                      val f = SmlInfo.sourcepath i
43                      fun symDesc (s, r) =                      fun symDesc (s, r) =
44                          S.nameSpaceToString (S.nameSpace s) :: " " ::                          S.nameSpaceToString (S.nameSpace s) :: " " ::
# Line 36  Line 47 
47                          fun recur [] = () (* shouldn't happen *)                          fun recur [] = () (* shouldn't happen *)
48                            | recur ((s, i') :: r) = let                            | recur ((s, i') :: r) = let
49                                  val f' = SmlInfo.sourcepath i'                                  val f' = SmlInfo.sourcepath i'
50                                  val () =                                  val _ =
51                                      if AbsPath.compare (f, f') = EQUAL then ()                                      if AbsPath.compare (f, f') = EQUAL then ()
52                                      else recur r                                      else recur r
53                                  val n' = AbsPath.name f'                                  val n' = AbsPath.name f'
# Line 55  Line 66 
66                  in                  in
67                      SmlInfo.error i "cyclic ML dependencies" pphist                      SmlInfo.error i "cyclic ML dependencies" pphist
68                  end                  end
               | SOME (SOME r) => r  
69    
70          and doSmlfile (i, history) = Dummy.f ()          and analyze (i, history) = let
71    (*          fun lookimport s =
72                    case SM.find (localdefs, s) of
73                        SOME i' => let
74                            val (_, e) = getResult (i', (s, i) :: history)
75                        in
76                            e
77                        end
78                      | NONE =>
79    
80                val lookup = look lookimport *)
81            in
82                Dummy.f ()
83            end
84    
85            (* run the analysis on one ML file -- causing the blackboard
86             * and the root set to be updated accordingly *)
87            fun doSmlFile i = ignore (getResult (i, []))
88      in      in
89          Dummy.f ()          Dummy.f ()
90      end      end

Legend:
Removed from v.277  
changed lines
  Added in v.278

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