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/semant/members.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/semant/members.sml

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

revision 299, Thu May 27 13:53:27 1999 UTC revision 632, Sat Apr 29 15:50:42 2000 UTC
# Line 20  Line 20 
20    
21      val empty : collection      val empty : collection
22    
23      val expandOne : GeneralParams.info * (AbsPath.t -> GroupGraph.group)      val implicit : GroupGraph.group -> collection
24          -> { sourcepath: AbsPath.t, group: AbsPath.t * region,  
25               class: string option }      val expandOne :
26            { gp: GeneralParams.info,
27              rparse: SrcPath.t * Version.t option -> GroupGraph.group,
28              load_plugin: SrcPath.context -> string -> bool }
29            -> { name: string,
30                 mkpath: string -> SrcPath.t,
31                 group: SrcPath.t * region,
32                 class: string option,
33                 tooloptions: PrivateTools.toolopts option,
34                 context: SrcPath.context }
35          -> collection          -> collection
36      val sequential : collection * collection * (string -> unit) -> collection      val sequential : collection * collection * (string -> unit) -> collection
37    
38      val build :      val build :
39          collection * SymbolSet.set option * (string -> unit) *          collection * SymbolSet.set option * GeneralParams.info *
40          GeneralParams.info          DependencyGraph.farsbnode       (* pervasive env *)
41          -> impexp SymbolMap.map          -> impexp SymbolMap.map * GroupGraph.privileges
42    
43      val subgroups : collection -> GroupGraph.group list      val subgroups : collection -> (SrcPath.t * GroupGraph.group) list
44    
45      val num_look : collection -> string -> int      val num_look : GeneralParams.info -> collection -> string -> int
46        val cm_look : GeneralParams.info -> collection -> string -> bool
47      val ml_look : collection -> symbol -> bool      val ml_look : collection -> symbol -> bool
     val cm_look : collection -> string -> bool  
48  end  end
49    
50  structure MemberCollection :> MEMBERCOLLECTION = struct  structure MemberCollection :> MEMBERCOLLECTION = struct
51    
52      structure DG = DependencyGraph      structure DG = DependencyGraph
53      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
54      structure CBE = GenericVC.BareEnvironment      structure E = GenericVC.Environment
55      structure SS = SymbolSet      structure SS = SymbolSet
56      structure GG = GroupGraph      structure GG = GroupGraph
57        structure V = Version
58    
59      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
60      type symbol = Symbol.symbol      type symbol = Symbol.symbol
# Line 56  Line 66 
66                          gimports: impexp SymbolMap.map,                          gimports: impexp SymbolMap.map,
67                          smlfiles: smlinfo list,                          smlfiles: smlinfo list,
68                          localdefs: smlinfo SymbolMap.map,                          localdefs: smlinfo SymbolMap.map,
69                          subgroups: GG.group list }                          subgroups: (SrcPath.t * GG.group) list,
70                            reqpriv: GG.privileges }
71          | ERRORCOLLECTION
72    
73      val empty =      val empty =
74          COLLECTION { imports = SymbolMap.empty,          COLLECTION { imports = SymbolMap.empty,
75                       gimports = SymbolMap.empty,                       gimports = SymbolMap.empty,
76                       smlfiles = [],                       smlfiles = [],
77                       localdefs = SymbolMap.empty,                       localdefs = SymbolMap.empty,
78                       subgroups = [] }                       subgroups = [],
79                         reqpriv = StringSet.empty }
80    
81        fun implicit init_group = let
82            val { grouppath, ... } =
83                case init_group of
84                    GG.GROUP x => x
85                  | GG.ERRORGROUP =>
86                    EM.impossible "members.sml: implicit: bad init group"
87        in
88            (* This is a collection that is an implicit member of every
89             * library -- the "init" group which exports the pervasive env. *)
90            COLLECTION { imports = SymbolMap.empty,
91                         gimports = SymbolMap.empty,
92                         smlfiles = [],
93                         localdefs = SymbolMap.empty,
94                         subgroups = [(grouppath, init_group)],
95                         reqpriv = StringSet.empty }
96        end
97    
98      fun sequential (COLLECTION c1, COLLECTION c2, error) = let      fun sequential (COLLECTION c1, COLLECTION c2, error) =
99          fun describeSymbol (s, r) = let          let fun describeSymbol (s, r) = let
100              val ns = Symbol.nameSpace s              val ns = Symbol.nameSpace s
101          in          in
102              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
103          end          end
104          fun i_error (s, x as (fn1, _), (fn2, _)) =              fun i_error (s, x as ((f, sbn), e), ((f', sbn'), e')) = let
105              (error (concat (describeSymbol                  fun complain () =
106                              (s, [" imported from ", DG.describeFarSBN fn1,                      error (concat (describeSymbol
107                                   " and also from ", DG.describeFarSBN fn2])));                                         (s, [" imported from ",
108               x)                                              DG.describeSBN sbn,
109                                                " and also from ",
110                                                DG.describeSBN sbn'])))
111                    fun union (NONE, _) = NONE
112                      | union (_, NONE) = NONE
113                      | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))
114                in
115                    if DG.sbeq (sbn, sbn') then
116                        ((union (f, f'), sbn), DAEnv.LAYER (e, e'))
117                    else (complain (); x)
118                end
119          val i_union = SymbolMap.unionWithi i_error          val i_union = SymbolMap.unionWithi i_error
120          val gi_union = SymbolMap.unionWith #1          val gi_union = SymbolMap.unionWith #1
121          fun ld_error (s, f1, f2) =          fun ld_error (s, f1, f2) =
# Line 89  Line 129 
129                       gimports = gi_union (#gimports c1, #gimports c2),                       gimports = gi_union (#gimports c1, #gimports c2),
130                       smlfiles = #smlfiles c1 @ #smlfiles c2,                       smlfiles = #smlfiles c1 @ #smlfiles c2,
131                       localdefs = ld_union (#localdefs c1, #localdefs c2),                       localdefs = ld_union (#localdefs c1, #localdefs c2),
132                       subgroups = #subgroups c1 @ #subgroups c2 }                           subgroups = #subgroups c1 @ #subgroups c2,
133                             reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }
134      end      end
135          | sequential _ = ERRORCOLLECTION
136    
137      fun expandOne (gp, rparse) arg = let      fun expandOne { gp, rparse, load_plugin } arg = let
138          val primconf = #primconf (#param gp)          val { name, mkpath, group, class, tooloptions, context } = arg
139          val { sourcepath, group, class } = arg          val class = Option.map (String.map Char.toLower) class
140          val error = GroupReg.error (#groupreg gp) group          val error = GroupReg.error (#groupreg gp) group
         fun noPrimitive () = let  
141              fun e0 s = error EM.COMPLAIN s EM.nullErrorBody              fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
142              fun w0 s = error EM.WARN s EM.nullErrorBody              fun w0 s = error EM.WARN s EM.nullErrorBody
143              val expansions = PrivateTools.expand e0 (sourcepath, class)          val { smlfiles, cmfiles } =
144              fun exp2coll (PrivateTools.GROUP p) = let              PrivateTools.expand { error = e0,
145                      val g as GG.GROUP { exports = i, islib, ... } = rparse p                                    spec = (name, mkpath, class, tooloptions),
146                      val gi = if islib then SymbolMap.empty else i                                    context = context,
147                  in                                    load_plugin = load_plugin }
148            fun g_coll (p, v) =
149                case rparse (p, v) of
150                    g as GG.GROUP { exports = i, kind, required,
151                                    grouppath, sublibs } => let
152                        val (gi, ver) =
153                            case kind of
154                                GG.NOLIB _ => (i, NONE)
155                              | GG.LIB l => (SymbolMap.empty, #version l)
156                    in
157                        case (v, ver) of
158                            (NONE, _) => ()
159                          | (SOME vrq, NONE) =>
160                            e0 "library does not carry a version stamp"
161                          | (SOME vrq, SOME ver) =>
162                            (case V.compare (vrq, ver) of
163                                 GREATER => e0 "library is older than expected"
164                               | EQUAL => ()
165                               | LESS =>
166                                 (case V.compare (V.nextMajor vrq, ver) of
167                                      GREATER =>
168                                       w0 "library is slightly newer than expected"
169                                    | _ => e0 "library is newer than expected"));
170                      COLLECTION { imports = i, gimports = gi, smlfiles = [],                      COLLECTION { imports = i, gimports = gi, smlfiles = [],
171                                   localdefs = SymbolMap.empty,                                   localdefs = SymbolMap.empty,
172                                   subgroups = [g] }                                   subgroups = [(p, g)],
173                                     reqpriv = required }
174                  end                  end
175                | exp2coll (PrivateTools.SMLSOURCE src) = let                | GG.ERRORGROUP => ERRORCOLLECTION
176                      val { sourcepath = p, history = h, share = s } = src          fun s_coll (p, s) = let
177                      val i =  SmlInfo.info gp              val i =
178                          { sourcepath = p,                  SmlInfo.info gp { sourcepath = p, group = group, sh_spec = s }
179                            group = group,              val exports =
180                            share = s }                  case SmlInfo.exports gp i of
181                      val exports = SmlInfo.exports gp i                      NONE => SS.empty
182                      val _ = if SS.isEmpty exports then w0 "no module exports"                    | SOME ex => (if SS.isEmpty ex then
183                              else ()                                      w0 ("no module exports from " ^
184                                            SrcPath.descr p)
185                                    else ();
186                                    ex)
187                      fun addLD (s, m) = SymbolMap.insert (m, s, i)                      fun addLD (s, m) = SymbolMap.insert (m, s, i)
188                      val ld = SS.foldl addLD SymbolMap.empty exports                      val ld = SS.foldl addLD SymbolMap.empty exports
189                  in                  in
# Line 124  Line 191 
191                                   gimports = SymbolMap.empty,                                   gimports = SymbolMap.empty,
192                                   smlfiles = [i],                                   smlfiles = [i],
193                                   localdefs = ld,                                   localdefs = ld,
194                                   subgroups = [] }                           subgroups = [],
195                             reqpriv = StringSet.empty }
196                  end                  end
197              val collections = map exp2coll expansions          val collections = map g_coll cmfiles @ map s_coll smlfiles
198              fun combine (c1, c2) = sequential (c2, c1, e0)              fun combine (c1, c2) = sequential (c2, c1, e0)
199          in          in
200              foldl combine empty collections              foldl combine empty collections
201          end          end
     in  
         if isSome class then noPrimitive ()  
         else case Primitive.fromString (AbsPath.spec sourcepath) of  
             SOME p => let  
                 val exports = Primitive.exports primconf p  
                 val plook = Primitive.lookup primconf p  
                 fun addFN (s, m) = let  
                     val env = plook s  
                     val fsbn = (NONE, DG.SB_BNODE (DG.PNODE p))  
                 in  
                     SymbolMap.insert (m, s, (fsbn, env))  
                 end  
                 val imp = SS.foldl addFN SymbolMap.empty exports  
             in  
                 COLLECTION { imports = imp,  
                              gimports = SymbolMap.empty,  
                              smlfiles = [],  
                              localdefs = SymbolMap.empty,  
                              subgroups = [] }  
             end  
           | NONE => noPrimitive ()  
     end  
202    
203      fun build (COLLECTION c, fopt, error, gp) =      fun build (COLLECTION c, fopt, gp, perv_fsbnode) =
204          BuildDepend.build (c, fopt, error, gp)          BuildDepend.build (c, fopt, gp, perv_fsbnode)
205          | build (ERRORCOLLECTION, _, _, _) =
206            (SymbolMap.empty, StringSet.empty)
207    
208      fun subgroups (COLLECTION { subgroups = sg, ... }) = sg      fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
209          | subgroups ERRORCOLLECTION = []
210    
211      fun num_look (c: collection) (s: string) = 0      local
212            fun symenv_look (gp: GeneralParams.info) (c: collection) s =
213      fun cm_look (c: collection) (s: string) = false              #get (#symval (#param gp) s) ()
214        in
215            fun num_look gp c s = getOpt (symenv_look gp c s, 0)
216            fun cm_look gp c s = isSome (symenv_look gp c s)
217        end
218    
219      fun ml_look (COLLECTION { imports, localdefs, ... }) s =      fun ml_look (COLLECTION { imports, localdefs, ... }) s =
220          isSome (SymbolMap.find (imports, s)) orelse          isSome (SymbolMap.find (imports, s)) orelse
221          isSome (SymbolMap.find (localdefs, s))          isSome (SymbolMap.find (localdefs, s))
222          | ml_look ERRORCOLLECTON _ = true
223  end  end

Legend:
Removed from v.299  
changed lines
  Added in v.632

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