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

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

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

revision 386, Thu Jul 22 07:35:50 1999 UTC revision 387, Mon Jul 26 02:44:20 1999 UTC
# Line 30  Line 30 
30      val registerClass : class * rule -> unit      val registerClass : class * rule -> unit
31    
32      (* install "ML Source" class *)      (* install "ML Source" class *)
33      val registerSmlClass : class * bool option -> unit      val registerSmlClass : class * Sharing.request -> unit
34    
35      (* install "CM Group" class *)      (* install "CM Group" class *)
36      val registerGroupClass : class -> unit      val registerGroupClass : class -> unit
# Line 77  Line 77 
77      include TOOLS      include TOOLS
78    
79      type smlsource =      type smlsource =
80          { sourcepath: SrcPath.t, history: class list, share: bool option }          { sourcepath: SrcPath.t, history: class list,
81              sh_spec: Sharing.request }
82    
83      datatype expansion =      datatype expansion =
84          SMLSOURCE of smlsource          SMLSOURCE of smlsource
85        | GROUP of SrcPath.t        | GROUP of SrcPath.t
86    
87      datatype private_rule =      datatype private_rule =
88          ISSML of bool option          ISSML of Sharing.request
89        | ISGROUP        | ISGROUP
90        | ISTOOL of class * rule        | ISTOOL of class * rule
91    
# Line 105  Line 106 
106      type rule = fname * rulecontext -> item list      type rule = fname * rulecontext -> item list
107    
108      type smlsource =      type smlsource =
109          { sourcepath: SrcPath.t, history: class list, share: bool option }          { sourcepath: SrcPath.t, history: class list,
110              sh_spec: Sharing.request }
111    
112      datatype expansion =      datatype expansion =
113          SMLSOURCE of smlsource          SMLSOURCE of smlsource
114        | GROUP of SrcPath.t        | GROUP of SrcPath.t
115    
116      datatype private_rule =      datatype private_rule =
117          ISSML of bool option          ISSML of Sharing.request
118        | ISGROUP        | ISGROUP
119        | ISTOOL of class * rule        | ISTOOL of class * rule
120    
# Line 121  Line 123 
123      fun registerClass (class, rule) =      fun registerClass (class, rule) =
124          classes := StringMap.insert (!classes, class, ISTOOL (class, rule))          classes := StringMap.insert (!classes, class, ISTOOL (class, rule))
125    
126      fun registerSmlClass (class, share) =      fun registerSmlClass (class, shrq) =
127          classes := StringMap.insert (!classes, class, ISSML share)          classes := StringMap.insert (!classes, class, ISSML shrq)
128    
129      fun registerGroupClass class =      fun registerGroupClass class =
130          classes := StringMap.insert (!classes, class, ISGROUP)          classes := StringMap.insert (!classes, class, ISGROUP)
# Line 177  Line 179 
179              case StringMap.find (!classes, class) of              case StringMap.find (!classes, class) of
180                  SOME rule => rule                  SOME rule => rule
181                | NONE => (error (concat ["unknown class \"", class, "\""]);                | NONE => (error (concat ["unknown class \"", class, "\""]);
182                           ISSML NONE)                           ISSML Sharing.DONTCARE)
183    
184          (* apply a rule to a path within a given context *)          (* apply a rule to a path within a given context *)
185          fun apply (rule, p, c) = let          fun apply (rule, p, c) = let
# Line 199  Line 201 
201          fun expand' context = let          fun expand' context = let
202              fun loop (acc, []) = rev acc              fun loop (acc, []) = rev acc
203                | loop (acc, ((p, c), history) :: t) = let                | loop (acc, ((p, c), history) :: t) = let
204                      fun step (ISSML share) =                      fun step (ISSML shrq) =
205                          let                          let
206                              val ap = SrcPath.native { context = context,                              val ap = SrcPath.native { context = context,
207                                                        spec = p }                                                        spec = p }
208                              val src = { sourcepath = ap,                              val src = { sourcepath = ap,
209                                          history = rev history,                                          history = rev history,
210                                          share = share }                                          sh_spec = shrq }
211                          in                          in
212                              loop (SMLSOURCE src :: acc, t)                              loop (SMLSOURCE src :: acc, t)
213                          end                          end
# Line 227  Line 229 
229                        | NONE =>                        | NONE =>
230                              (case defaultClassOf p of                              (case defaultClassOf p of
231                                   SOME class => step (class2rule class)                                   SOME class => step (class2rule class)
232                                 | NONE => step (ISSML NONE))                                 | NONE => step (ISSML Sharing.DONTCARE))
233                  end                  end
234          in          in
235              fn l => loop ([], l)              fn l => loop ([], l)
# Line 240  Line 242 
242                  val class = String.map Char.toLower class0                  val class = String.map Char.toLower class0
243              in              in
244                  case class2rule class of                  case class2rule class of
245                      ISSML share =>                      ISSML shrq =>
246                          [SMLSOURCE { sourcepath = ap, history = [],                          [SMLSOURCE { sourcepath = ap, history = [],
247                                       share = share }]                                       sh_spec = shrq }]
248                    | ISGROUP =>                    | ISGROUP =>
249                          [GROUP ap]                          [GROUP ap]
250                    | ISTOOL (class, rule) => let                    | ISTOOL (class, rule) => let
# Line 325  Line 327 
327          fun sfx (s, c) =          fun sfx (s, c) =
328              registerClassifier (stdSfxClassifier { sfx = s, class = c })              registerClassifier (stdSfxClassifier { sfx = s, class = c })
329      in      in
330          val _ = registerSmlClass ("sml", NONE)          val _ = registerSmlClass ("sml", Sharing.DONTCARE)
331          val _ = registerSmlClass ("shared", SOME true)          val _ = registerSmlClass ("shared", Sharing.SHARED)
332          val _ = registerSmlClass ("private", SOME false)          val _ = registerSmlClass ("private", Sharing.PRIVATE)
333          val _ = registerGroupClass "cm"          val _ = registerGroupClass "cm"
334    
335          val _ = sfx ("sml", "sml")          val _ = sfx ("sml", "sml")

Legend:
Removed from v.386  
changed lines
  Added in v.387

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