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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/depend/build.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 278 - (view) (download)

1 : blume 277 structure BuildDepend = struct
2 :    
3 : blume 278 structure S = Symbol
4 : blume 277 structure SS = SymbolSet
5 : blume 278 structure SM = SymbolMap
6 : blume 277 structure SK = Skeleton
7 :     structure DG = DependencyGraph
8 :    
9 : blume 278 fun look otherwise DG.EMPTY s = otherwise s
10 :     | look otherwise (DG.BINDING (s', v)) s =
11 :     if S.eq (s, s') then v else otherwise s
12 :     | look otherwise (DG.LAYER (e, e')) s = look (look otherwise e') e s
13 :     | look otherwise (DG.FCTENV { looker, domain }) s =
14 :     (case looker s of NONE => otherwise s | SOME v => v)
15 :    
16 :     fun build { subexports, smlfiles, localdefs } = let
17 : blume 277
18 : blume 278 (* the "blackboard" where analysis results are announced *)
19 :     (* (also used for cycle detection) *)
20 :     val bb = ref AbsPathMap.empty
21 :     fun lock i = bb := AbsPathMap.insert (!bb, SmlInfo.sourcepath i, NONE)
22 : blume 277 fun release (i, r) =
23 : blume 278 (bb := AbsPathMap.insert (!bb, SmlInfo.sourcepath i, SOME r); r)
24 :     fun fetch i = AbsPathMap.find (!bb, SmlInfo.sourcepath i)
25 : blume 277
26 : blume 278 (* 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 : blume 277 fun getResult (i, history) =
38 :     case fetch i of
39 : blume 278 NONE => (lock i; addRoot i; release (i, analyze (i, history)))
40 :     | SOME (SOME r) => (delRoot i; r)
41 :     | SOME NONE => let (* cycle found --> error message *)
42 : blume 277 val f = SmlInfo.sourcepath i
43 :     fun symDesc (s, r) =
44 :     S.nameSpaceToString (S.nameSpace s) :: " " ::
45 :     S.name s :: r
46 :     fun pphist pps = let
47 :     fun recur [] = () (* shouldn't happen *)
48 :     | recur ((s, i') :: r) = let
49 :     val f' = SmlInfo.sourcepath i'
50 : blume 278 val _ =
51 : blume 277 if AbsPath.compare (f, f') = EQUAL then ()
52 :     else recur r
53 :     val n' = AbsPath.name f'
54 :     val l =
55 :     n' :: " refers to " ::
56 :     symDesc (s, [" defined in ..."])
57 :     in
58 :     app (PrettyPrint.add_string pps) l;
59 :     PrettyPrint.add_newline pps
60 :     end
61 :     in
62 :     recur history;
63 :     PrettyPrint.add_string pps (AbsPath.name f);
64 :     PrettyPrint.add_newline pps
65 :     end
66 :     in
67 :     SmlInfo.error i "cyclic ML dependencies" pphist
68 :     end
69 :    
70 : blume 278 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 : blume 277 in
89 :     Dummy.f ()
90 :     end
91 :     end

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