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 277, Mon May 17 09:13:26 1999 UTC revision 278, Mon May 17 14:53:49 1999 UTC
# Line 11  Line 11 
11   *)   *)
12  signature MEMBERCOLLECTION = sig  signature MEMBERCOLLECTION = sig
13    
14      type symbol = GenericVC.Symbol.symbol      type symbol = Symbol.symbol
15      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
16    
17      type collection      type collection
18    
19        type farlooker =
20            AbsPath.t ->
21            (DependencyGraph.farnode * DependencyGraph.env) SymbolMap.map
22    
23      val empty : collection      val empty : collection
24    
25      val expandOne : (AbsPath.t -> DependencyGraph.farnode SymbolMap.map)      val expandOne : farlooker
26          -> { sourcepath: AbsPath.t, group: AbsPath.t, class: string option,          -> { sourcepath: AbsPath.t, group: AbsPath.t, class: string option,
27               error : string -> (PrettyPrint.ppstream -> unit) -> unit }               error : string -> (PrettyPrint.ppstream -> unit) -> unit }
28          -> collection          -> collection
29      val sequential : collection * collection * (string -> unit) -> collection      val sequential : collection * collection * (string -> unit) -> collection
30    
31      val num_look : collection -> string -> int      val num_look : collection -> string -> int
32      val ml_look : collection -> GenericVC.Symbol.symbol -> bool      val ml_look : collection -> symbol -> bool
33      val cm_look : collection -> string -> bool      val cm_look : collection -> string -> bool
34  end  end
35    
36  structure MemberCollection :> MEMBERCOLLECTION = struct  structure MemberCollection :> MEMBERCOLLECTION = struct
37    
38      structure DG = DependencyGraph      structure DG = DependencyGraph
     structure Symbol = GenericVC.Symbol  
39      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
40        structure CBE = GenericVC.BareEnvironment
41    
42      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
43      type symbol = Symbol.symbol      type symbol = Symbol.symbol
44    
45      datatype collection =      datatype collection =
46          COLLECTION of { subexports: DG.farnode SymbolMap.map,          COLLECTION of { subexports: (DG.farnode * DG.env) SymbolMap.map,
47                          smlfiles: smlinfo list,                          smlfiles: smlinfo list,
48                          localdefs: smlinfo SymbolMap.map }                          localdefs: smlinfo SymbolMap.map }
49    
50        type farlooker =
51            AbsPath.t ->
52            (DependencyGraph.farnode * DependencyGraph.env) SymbolMap.map
53    
54      val empty =      val empty =
55          COLLECTION { subexports = SymbolMap.empty,          COLLECTION { subexports = SymbolMap.empty,
56                       smlfiles = [],                       smlfiles = [],
57                       localdefs = SymbolMap.empty }                       localdefs = SymbolMap.empty }
58    
59        fun convertEnv cmenv = let
60            fun modulesOnly sl = let
61                fun addModule (sy, set) =
62                    case Symbol.nameSpace sy of
63                        (Symbol.STRspace | Symbol.SIGspace |
64                         Symbol.FCTspace | Symbol.FSIGspace) =>
65                            SymbolSet.add (set, sy)
66                      | _ => set
67            in
68                foldl addModule SymbolSet.empty sl
69            end
70            fun cvt CBE.CM_NONE = NONE
71              | cvt (CBE.CM_ENV { look, symbols }) =
72                SOME (DG.FCTENV { looker = cvt o look,
73                                  domain = modulesOnly o symbols })
74        in
75            valOf (cvt cmenv)
76        end
77    
78      fun sequential (COLLECTION c1, COLLECTION c2, error) = let      fun sequential (COLLECTION c1, COLLECTION c2, error) = let
79          fun describeSymbol (s, r) = let          fun describeSymbol (s, r) = let
80              val ns = Symbol.nameSpace s              val ns = Symbol.nameSpace s
81          in          in
82              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
83          end          end
84          fun se_error (s, x as (_, n1), (_, n2)) =          fun se_error (s, x as ((_, n1), _), ((_, n2), _)) =
85              (error (concat (describeSymbol              (error (concat (describeSymbol
86                              (s, [" imported from ", DG.describeNode n1,                              (s, [" imported from ", DG.describeNode n1,
87                                   " and also from ", DG.describeNode n2])));                                   " and also from ", DG.describeNode n2])));
# Line 105  Line 132 
132          else case Primitive.fromString (AbsPath.spec sourcepath) of          else case Primitive.fromString (AbsPath.spec sourcepath) of
133              SOME p => let              SOME p => let
134                  val exports = Primitive.exports p                  val exports = Primitive.exports p
135                  fun addFN (s, m) =                  fun addFN (s, m) = let
136                      SymbolMap.insert (m, s, (NONE, DG.PNODE p))                      val cmenv = Primitive.lookup p s
137                        val env = convertEnv cmenv
138                    in
139                        SymbolMap.insert (m, s, ((NONE, DG.PNODE p), env))
140                    end
141                  val se = SymbolSet.foldl addFN SymbolMap.empty exports                  val se = SymbolSet.foldl addFN SymbolMap.empty exports
142              in              in
143                  COLLECTION { subexports = se,                  COLLECTION { subexports = se,

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