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 283, Wed May 19 08:20:58 1999 UTC revision 518, Wed Jan 12 06:26:25 2000 UTC
# Line 14  Line 14 
14      type symbol = Symbol.symbol      type symbol = Symbol.symbol
15      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
16      type impexp = DependencyGraph.impexp      type impexp = DependencyGraph.impexp
17        type region = GenericVC.SourceMap.region
18    
19      type collection      type collection
20    
     type farlooker = AbsPath.t ->  
         { imports: impexp SymbolMap.map, gimports: impexp SymbolMap.map }  
   
21      val empty : collection      val empty : collection
22    
23      val expandOne : farlooker      val expandOne :
24          -> { sourcepath: AbsPath.t, group: AbsPath.t, class: string option,          GeneralParams.info * (SrcPath.t -> GroupGraph.group) * (string -> bool)
25               error : string -> (PrettyPrint.ppstream -> unit) -> unit }          -> { name: string, mkpath: string -> SrcPath.t,
26                 group: SrcPath.t * region, class: string option,
27                 context: SrcPath.context }
28          -> collection          -> collection
29      val sequential : collection * collection * (string -> unit) -> collection      val sequential : collection * collection * (string -> unit) -> collection
30    
31      val build : collection * SymbolSet.set option * (string -> unit)      val build :
32          -> impexp SymbolMap.map          collection * SymbolSet.set option * GeneralParams.info
33            -> impexp SymbolMap.map * GroupGraph.privileges
34    
35        val subgroups : collection -> (SrcPath.t * GroupGraph.group) list
36    
37      val num_look : collection -> string -> int      val num_look : GeneralParams.info -> collection -> string -> int
38        val cm_look : GeneralParams.info -> collection -> string -> bool
39      val ml_look : collection -> symbol -> bool      val ml_look : collection -> symbol -> bool
     val cm_look : collection -> string -> bool  
40  end  end
41    
42  structure MemberCollection :> MEMBERCOLLECTION = struct  structure MemberCollection :> MEMBERCOLLECTION = struct
# Line 41  Line 44 
44      structure DG = DependencyGraph      structure DG = DependencyGraph
45      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
46      structure CBE = GenericVC.BareEnvironment      structure CBE = GenericVC.BareEnvironment
47        structure E = GenericVC.Environment
48        structure SS = SymbolSet
49        structure GG = GroupGraph
50    
51      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
52      type symbol = Symbol.symbol      type symbol = Symbol.symbol
53      type impexp = DG.impexp      type impexp = DG.impexp
54        type region = GenericVC.SourceMap.region
55    
56      datatype collection =      datatype collection =
57          COLLECTION of { imports: impexp SymbolMap.map,          COLLECTION of { imports: impexp SymbolMap.map,
58                          gimports: impexp SymbolMap.map,                          gimports: impexp SymbolMap.map,
59                          smlfiles: smlinfo list,                          smlfiles: smlinfo list,
60                          localdefs: smlinfo SymbolMap.map }                          localdefs: smlinfo SymbolMap.map,
61                            subgroups: (SrcPath.t * GG.group) list,
62      type farlooker = AbsPath.t ->                          reqpriv: GG.privileges }
         { imports: impexp SymbolMap.map, gimports: impexp SymbolMap.map }  
63    
64      val empty =      val empty =
65          COLLECTION { imports = SymbolMap.empty,          COLLECTION { imports = SymbolMap.empty,
66                       gimports = SymbolMap.empty,                       gimports = SymbolMap.empty,
67                       smlfiles = [],                       smlfiles = [],
68                       localdefs = SymbolMap.empty }                       localdefs = SymbolMap.empty,
69                         subgroups = [],
70      fun convertEnv cmenv = let                       reqpriv = StringSet.empty }
         fun modulesOnly sl = let  
             fun addModule (sy, set) =  
                 case Symbol.nameSpace sy of  
                     (Symbol.STRspace | Symbol.SIGspace |  
                      Symbol.FCTspace | Symbol.FSIGspace) =>  
                         SymbolSet.add (set, sy)  
                   | _ => set  
         in  
             foldl addModule SymbolSet.empty sl  
         end  
         fun cvt CBE.CM_NONE = NONE  
           | cvt (CBE.CM_ENV { look, symbols }) =  
             SOME (DG.FCTENV { looker = cvt o look,  
                               domain = modulesOnly o symbols })  
     in  
         valOf (cvt cmenv)  
     end  
71    
72      fun sequential (COLLECTION c1, COLLECTION c2, error) = let      fun sequential (COLLECTION c1, COLLECTION c2, error) = let
73          fun describeSymbol (s, r) = let          fun describeSymbol (s, r) = let
# Line 86  Line 75 
75          in          in
76              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
77          end          end
78          fun i_error (s, x as (fn1, _), (fn2, _)) =          fun i_error (s, x as ((f, sbn), e), ((f', sbn'), e')) = let
79              (error (concat (describeSymbol              fun complain () =
80                              (s, [" imported from ", DG.describeFarSBN fn1,                  error (concat (describeSymbol
81                                   " and also from ", DG.describeFarSBN fn2])));                                 (s, [" imported from ", DG.describeSBN sbn,
82               x)                                      " and also from ", DG.describeSBN sbn'])))
83                fun union (NONE, _) = NONE
84                  | union (_, NONE) = NONE
85                  | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))
86            in
87                if DG.sbeq (sbn, sbn') then
88                    ((union (f, f'), sbn), DAEnv.LAYER (e, e'))
89                else (complain (); x)
90            end
91          val i_union = SymbolMap.unionWithi i_error          val i_union = SymbolMap.unionWithi i_error
92          val gi_union = SymbolMap.unionWith #1          val gi_union = SymbolMap.unionWith #1
93          fun ld_error (s, f1, f2) =          fun ld_error (s, f1, f2) =
# Line 103  Line 100 
100          COLLECTION { imports = i_union (#imports c1, #imports c2),          COLLECTION { imports = i_union (#imports c1, #imports c2),
101                       gimports = gi_union (#gimports c1, #gimports c2),                       gimports = gi_union (#gimports c1, #gimports c2),
102                       smlfiles = #smlfiles c1 @ #smlfiles c2,                       smlfiles = #smlfiles c1 @ #smlfiles c2,
103                       localdefs = ld_union (#localdefs c1, #localdefs c2) }                       localdefs = ld_union (#localdefs c1, #localdefs c2),
104                         subgroups = #subgroups c1 @ #subgroups c2,
105                         reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }
106      end      end
107    
108      fun expandOne gexports { sourcepath, group, class, error } = let      fun expandOne (gp, rparse, load_plugin) arg = let
109            val primconf = #primconf (#param gp)
110            val { name, mkpath, group, class, context } = arg
111            val class = Option.map (String.map Char.toLower) class
112            val error = GroupReg.error (#groupreg gp) group
113          fun noPrimitive () = let          fun noPrimitive () = let
114              fun e0 s = error s EM.nullErrorBody              fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
115              val expansions = PrivateTools.expand e0 (sourcepath, class)              fun w0 s = error EM.WARN s EM.nullErrorBody
116              fun exp2coll (PrivateTools.GROUP p) = let              val { smlfiles, cmfiles } =
117                      val { imports = i, gimports = gi } = gexports p                  PrivateTools.expand { error = e0,
118                                          spec = (name, mkpath, class),
119                                          context = context,
120                                          load_plugin = load_plugin }
121                fun g_coll p = let
122                    val g as GG.GROUP { exports = i, kind, required, ... } =
123                        rparse p
124                    val gi = case kind of GG.NOLIB => i | _ => SymbolMap.empty
125                  in                  in
126                      COLLECTION { imports = i, gimports = gi, smlfiles = [],                      COLLECTION { imports = i, gimports = gi, smlfiles = [],
127                                   localdefs = SymbolMap.empty }                               localdefs = SymbolMap.empty,
128                                 subgroups = [(p, g)],
129                                 reqpriv = required }
130                  end                  end
131                | exp2coll (PrivateTools.SMLSOURCE src) = let              fun s_coll (p, s) = let
132                      val { sourcepath = p, history = h, share = s } = src                  val i = SmlInfo.info gp
                     val i =  SmlInfo.info  
                         Policy.default  
133                          { sourcepath = p, group = group,                          { sourcepath = p, group = group,
134                            error = error, history = h,                        sh_spec = s, split = true }
135                            share = s }                  val exports =
136                      val exports = SmlInfo.exports i                      case SmlInfo.exports gp i of
137                            NONE => SS.empty
138                          | SOME ex => (if SS.isEmpty ex then
139                                            w0 ("no module exports from " ^
140                                                SrcPath.descr p)
141                                        else ();
142                                        ex)
143                      fun addLD (s, m) = SymbolMap.insert (m, s, i)                      fun addLD (s, m) = SymbolMap.insert (m, s, i)
144                      val ld = SymbolSet.foldl addLD SymbolMap.empty exports                  val ld = SS.foldl addLD SymbolMap.empty exports
145                  in                  in
146                      COLLECTION { imports = SymbolMap.empty,                      COLLECTION { imports = SymbolMap.empty,
147                                   gimports = SymbolMap.empty,                                   gimports = SymbolMap.empty,
148                                   smlfiles = [i],                                   smlfiles = [i],
149                                   localdefs = ld }                               localdefs = ld,
150                                 subgroups = [],
151                                 reqpriv = StringSet.empty }
152                  end                  end
153              val collections = map exp2coll expansions              val collections = map g_coll cmfiles @ map s_coll smlfiles
154              fun combine (c1, c2) = sequential (c2, c1, e0)              fun combine (c1, c2) = sequential (c2, c1, e0)
155          in          in
156              foldl combine empty collections              foldl combine empty collections
157          end          end
158      in      in
159          if isSome class then noPrimitive ()          if isSome class then noPrimitive ()
160          else case Primitive.fromString (AbsPath.spec sourcepath) of          else case Primitive.fromString primconf name of
161              SOME p => let              SOME p => let
162                  val exports = Primitive.exports p                  val exports = Primitive.exports primconf p
163                    val env = Primitive.da_env primconf p
164                  fun addFN (s, m) = let                  fun addFN (s, m) = let
165                      val cmenv = Primitive.lookup p s                      val ii = Primitive.iinfo primconf p
166                      val env = convertEnv cmenv                      val fsbn = (NONE, DG.SB_BNODE (DG.PNODE p, ii))
                     val fsbn = (NONE, DG.SB_BNODE (DG.PNODE p))  
167                  in                  in
168                      SymbolMap.insert (m, s, (fsbn, env))                      SymbolMap.insert (m, s, (fsbn, env))
169                  end                  end
170                  val imp = SymbolSet.foldl addFN SymbolMap.empty exports                  val imp = SS.foldl addFN SymbolMap.empty exports
171              in              in
172                  COLLECTION { imports = imp,                  COLLECTION { imports = imp,
173                               gimports = SymbolMap.empty,                               gimports = SymbolMap.empty,
174                               smlfiles = [],                               smlfiles = [],
175                               localdefs = SymbolMap.empty }                               localdefs = SymbolMap.empty,
176                                 subgroups = [],
177                                 reqpriv = Primitive.reqpriv p }
178              end              end
179            | NONE => noPrimitive ()            | NONE => noPrimitive ()
180      end      end
181    
182      fun build (COLLECTION c, fopt, error) = BuildDepend.build (c, fopt, error)      fun build (COLLECTION c, fopt, gp) =
183            BuildDepend.build (c, fopt, gp)
184    
185      fun num_look (c: collection) (s: string) = 0      fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
186    
187      fun cm_look (c: collection) (s: string) = false      local
188            fun symenv_look (gp: GeneralParams.info) (c: collection) s =
189                #get (#symval (#param gp) s) ()
190        in
191            fun num_look gp c s = getOpt (symenv_look gp c s, 0)
192            fun cm_look gp c s = isSome (symenv_look gp c s)
193        end
194    
195      fun ml_look (COLLECTION { imports, localdefs, ... }) s =      fun ml_look (COLLECTION { imports, localdefs, ... }) s =
196          isSome (SymbolMap.find (imports, s)) orelse          isSome (SymbolMap.find (imports, s)) orelse

Legend:
Removed from v.283  
changed lines
  Added in v.518

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