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

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

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

revision 652, Tue Jun 6 02:14:56 2000 UTC revision 666, Fri Jun 16 08:27:00 2000 UTC
# Line 7  Line 7 
7   *)   *)
8  signature CM_SEMANT = sig  signature CM_SEMANT = sig
9    
10      type context = SrcPath.context      type context = SrcPath.dir
     type pathname = SrcPath.t  
11      type region = GenericVC.SourceMap.region      type region = GenericVC.SourceMap.region
12      type ml_symbol      type ml_symbol
13      type cm_symbol      type cm_symbol
# Line 28  Line 27 
27      type complainer = string -> unit      type complainer = string -> unit
28    
29      (* getting elements of primitive types (pathnames and symbols) *)      (* getting elements of primitive types (pathnames and symbols) *)
30      val file_native : string * context -> pathname      val file_native : string * context * complainer -> SrcPath.prefile
31      val file_standard :      val file_standard :
32          GeneralParams.info -> string * context * complainer -> pathname          GeneralParams.info -> string * context * complainer -> SrcPath.prefile
33      val cm_symbol : string -> cm_symbol      val cm_symbol : string -> cm_symbol
34      val cm_version : string * complainer -> cm_version      val cm_version : string * complainer -> cm_version
35      val ml_structure : string -> ml_symbol      val ml_structure : string -> ml_symbol
# Line 40  Line 39 
39      val class : cm_symbol -> cm_class      val class : cm_symbol -> cm_class
40    
41      (* getting the full analysis for a group/library *)      (* getting the full analysis for a group/library *)
42      val group : { path: pathname,      val group : { path: SrcPath.file,
43                    privileges: privilegespec,                    privileges: privilegespec,
44                    exports: exports option,                    exports: exports option,
45                    members: members,                    members: members,
46                    gp: GeneralParams.info,                    gp: GeneralParams.info,
47                    curlib: pathname option,                    curlib: SrcPath.file option,
48                    owner: pathname option,                    owner: SrcPath.file option,
49                    error: complainer,                    error: complainer,
50                    initgroup: group } -> group                    initgroup: group } -> group
51      val library : { path: pathname,      val library : { path: SrcPath.file,
52                      privileges: privilegespec,                      privileges: privilegespec,
53                      exports: exports,                      exports: exports,
54                      version : cm_version option,                      version : cm_version option,
# Line 66  Line 65 
65      val emptyMembers : members      val emptyMembers : members
66      val member :      val member :
67          { gp: GeneralParams.info,          { gp: GeneralParams.info,
68            rparse: pathname option -> pathname * Version.t option -> group,            rparse: SrcPath.file option ->
69            load_plugin: SrcPath.context -> string -> bool }                    SrcPath.file * Version.t option * SrcPath.rebindings ->
70                      group,
71              load_plugin: SrcPath.dir -> string -> bool }
72          -> { name: string,          -> { name: string,
73               mkpath: string -> pathname,               mkpath: string -> SrcPath.prefile,
74               group: pathname * region,               group: SrcPath.file * region,
75               class: cm_class option,               class: cm_class option,
76               tooloptions: toolopt list option,               tooloptions: toolopt list option,
77               context: SrcPath.context }               context: SrcPath.dir }
78          -> members          -> members
79      val members : members * members -> members      val members : members * members -> members
80      val guarded_members :      val guarded_members :
# Line 127  Line 128 
128      val eq : aexp * eqsym * aexp -> exp      val eq : aexp * eqsym * aexp -> exp
129    
130      (* tool options *)      (* tool options *)
131      val string : { name: string, mkpath: string -> pathname } -> toolopt      val string : { name: string, mkpath: string -> SrcPath.prefile } -> toolopt
132      val subopts : { name: string, opts: toolopt list } -> toolopt      val subopts : { name: string, opts: toolopt list } -> toolopt
133  end  end
134    
# Line 137  Line 138 
138      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
139      structure GG = GroupGraph      structure GG = GroupGraph
140    
141      type pathname = SrcPath.t      type context = SrcPath.dir
     type context = SrcPath.context  
142      type region = GenericVC.SourceMap.region      type region = GenericVC.SourceMap.region
143      type ml_symbol = Symbol.symbol      type ml_symbol = Symbol.symbol
144      type cm_symbol = string      type cm_symbol = string
# Line 152  Line 152 
152    
153      type aexp = environment -> int      type aexp = environment -> int
154      type exp = environment -> bool      type exp = environment -> bool
155      type members = environment * pathname option -> MemberCollection.collection      type members =
156             environment * SrcPath.file option -> MemberCollection.collection
157      type exports = environment -> SymbolSet.set      type exports = environment -> SymbolSet.set
158    
159      type toolopt = PrivateTools.toolopt      type toolopt = PrivateTools.toolopt
# Line 165  Line 166 
166              (error ("expression raises exception: " ^ General.exnMessage exn);              (error ("expression raises exception: " ^ General.exnMessage exn);
167               false)               false)
168    
169      fun file_native (s, d) = SrcPath.native { context = d, spec = s }      fun file_native (s, d, err) =
170            SrcPath.native { err = err } { context = d, spec = s }
171      fun file_standard (gp: GeneralParams.info) (s, d, err) =      fun file_standard (gp: GeneralParams.info) (s, d, err) =
172          SrcPath.standard (#pcmode (#param gp))          SrcPath.standard { env = #penv (#param gp), err = err }
173                           { context = d, spec = s, err = err }                           { context = d, spec = s }
174      fun cm_symbol s = s      fun cm_symbol s = s
175      fun cm_version (s, error) =      fun cm_version (s, error) =
176          case Version.fromString s of          case Version.fromString s of
# Line 184  Line 186 
186      fun applyTo mc e = e mc      fun applyTo mc e = e mc
187    
188      fun sgl2sll subgroups = let      fun sgl2sll subgroups = let
189          fun sameSL (p, g) (p', g') = SrcPath.compare (p, p') = EQUAL          fun sameSL (p, _, _) (p', _, _) = SrcPath.compare (p, p') = EQUAL
190          fun add (x, l) =          fun add (x, l) =
191              if List.exists (sameSL x) l then l else x :: l              if List.exists (sameSL x) l then l else x :: l
192          fun oneSG (x as (_, gth), l) =          fun oneSG (x as (_, gth, _), l) =
193              case gth () of              case gth () of
194                  GG.GROUP { kind, sublibs, ... } =>                  GG.GROUP { kind, sublibs, ... } =>
195                  (case kind of                  (case kind of
# Line 213  Line 215 
215              #1 (valOf (SymbolMap.find (exports, PervAccess.pervStrSym)))              #1 (valOf (SymbolMap.find (exports, PervAccess.pervStrSym)))
216          end          end
217          val (exports, rp) = MemberCollection.build (mc, filter, gp, pfsbn ())          val (exports, rp) = MemberCollection.build (mc, filter, gp, pfsbn ())
218          fun thunkify (p, g) = (p, fn () => g)          fun thunkify (p, g, rb) = (p, fn () => g, rb)
219          val subgroups = map thunkify (MemberCollection.subgroups mc)          val subgroups = map thunkify (MemberCollection.subgroups mc)
220          val { required = rp', wrapped = wr } = p          val { required = rp', wrapped = wr } = p
221          val rp'' = StringSet.union (rp', StringSet.union (rp, wr))          val rp'' = StringSet.union (rp', StringSet.union (rp, wr))
# Line 243  Line 245 
245              #1 (valOf (SymbolMap.find (exports, PervAccess.pervStrSym)))              #1 (valOf (SymbolMap.find (exports, PervAccess.pervStrSym)))
246          end          end
247          val (exports, rp) = MemberCollection.build (mc, filter, gp, pfsbn ())          val (exports, rp) = MemberCollection.build (mc, filter, gp, pfsbn ())
248          fun thunkify (p, g) = (p, fn () => g)          fun thunkify (p, g, rb) = (p, fn () => g, rb)
249          val subgroups = map thunkify (MemberCollection.subgroups mc)          val subgroups = map thunkify (MemberCollection.subgroups mc)
250          val { required = rp', wrapped = wr } = p          val { required = rp', wrapped = wr } = p
251          val rp'' = StringSet.union (rp', StringSet.union (rp, wr))          val rp'' = StringSet.union (rp', StringSet.union (rp, wr))
# Line 284  Line 286 
286          val group = #group arg          val group = #group arg
287          val error = GroupReg.error (#groupreg gp) group          val error = GroupReg.error (#groupreg gp) group
288          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
289          fun checkowner (_, GG.GROUP { kind = GG.NOLIB { owner, ... }, ...}) =          fun checkowner (_, GG.GROUP { kind = GG.NOLIB { owner, ... }, ...},
290                            _) =
291              let fun libname NONE = "<toplevel>"              let fun libname NONE = "<toplevel>"
292                    | libname (SOME p) = SrcPath.descr p                    | libname (SOME p) = SrcPath.descr p
293                  fun eq (NONE, NONE) = true                  fun eq (NONE, NONE) = true

Legend:
Removed from v.652  
changed lines
  Added in v.666

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