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 277 - (view) (download)

1 : blume 277 structure BuildDepend = struct
2 :    
3 :     structure S = GenericVC.Symbol
4 :     structure SS = SymbolSet
5 :     structure SK = Skeleton
6 :     structure DG = DependencyGraph
7 :    
8 :     datatype env =
9 :     IMPORTS
10 :     | FCTENV of { looker: S.symbol -> value option,
11 :     domain: SS.set }
12 :     | BINDING of S.symbol * value
13 :     | LAYER of env * env
14 :     withtype value = env
15 :    
16 :     fun build { subexports, smlfiles, localdefs } = let
17 :     val results = ref AbsPathMap.empty
18 :     fun lock i =
19 :     results :=
20 :     AbsPathMap.insert (!results, SmlInfo.sourcepath i, NONE)
21 :     fun release (i, r) =
22 :     (results :=
23 :     AbsPathMap.insert (!results, SmlInfo.sourcepath i, SOME r);
24 :     r)
25 :     fun fetch i = AbsPathMap.find (!results, SmlInfo.sourcepath i)
26 :    
27 :     fun getResult (i, history) =
28 :     case fetch i of
29 :     NONE => (lock i; release (i, doSmlfile (i, history)))
30 :     | SOME NONE => let
31 :     val f = SmlInfo.sourcepath i
32 :     fun symDesc (s, r) =
33 :     S.nameSpaceToString (S.nameSpace s) :: " " ::
34 :     S.name s :: r
35 :     fun pphist pps = let
36 :     fun recur [] = () (* shouldn't happen *)
37 :     | recur ((s, i') :: r) = let
38 :     val f' = SmlInfo.sourcepath i'
39 :     val () =
40 :     if AbsPath.compare (f, f') = EQUAL then ()
41 :     else recur r
42 :     val n' = AbsPath.name f'
43 :     val l =
44 :     n' :: " refers to " ::
45 :     symDesc (s, [" defined in ..."])
46 :     in
47 :     app (PrettyPrint.add_string pps) l;
48 :     PrettyPrint.add_newline pps
49 :     end
50 :     in
51 :     recur history;
52 :     PrettyPrint.add_string pps (AbsPath.name f);
53 :     PrettyPrint.add_newline pps
54 :     end
55 :     in
56 :     SmlInfo.error i "cyclic ML dependencies" pphist
57 :     end
58 :     | SOME (SOME r) => r
59 :    
60 :     and doSmlfile (i, history) = Dummy.f ()
61 :     in
62 :     Dummy.f ()
63 :     end
64 :     end

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