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 273, Wed May 12 08:38:51 1999 UTC revision 274, Fri May 14 05:23:02 1999 UTC
# Line 1  Line 1 
1    (*
2     * Target expansion and CM tools.
3     *
4     *   (C) 1999 Lucent Technologies, Bell Laboratories
5     *
6     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7     *)
8  signature TOOLS = sig  signature TOOLS = sig
9    
10      type fname = string      type fname = string
# Line 48  Line 55 
55    
56      include TOOLS      include TOOLS
57    
     type primitive = Primitive.primitive  
   
58      type smlsource =      type smlsource =
59          { sourcepath: AbsPath.t, history: class list, share: bool option }          { sourcepath: AbsPath.t, history: class list, share: bool option }
60    
61      datatype expansion =      datatype expansion =
62          PRIMITIVE of primitive          SMLSOURCE of smlsource
       | SMLSOURCE of smlsource  
63        | GROUP of AbsPath.t        | GROUP of AbsPath.t
64    
65      datatype private_rule =      datatype private_rule =
66          ISPRIMITIVE          ISSML of bool option
       | ISSML of bool option  
67        | ISGROUP        | ISGROUP
68        | ISTOOL of class * rule        | ISTOOL of class * rule
69    
     val registerPrimitiveClass : class -> unit  
   
70      val expand : AbsPath.t * class option -> expansion list      val expand : AbsPath.t * class option -> expansion list
71  end  end
72    
# Line 83  Line 84 
84      type rulecontext = rulefn -> item list      type rulecontext = rulefn -> item list
85      type rule = fname * rulecontext -> item list      type rule = fname * rulecontext -> item list
86    
     type primitive = Primitive.primitive  
   
87      type smlsource =      type smlsource =
88          { sourcepath: AbsPath.t, history: class list, share: bool option }          { sourcepath: AbsPath.t, history: class list, share: bool option }
89    
90      datatype expansion =      datatype expansion =
91          PRIMITIVE of primitive          SMLSOURCE of smlsource
       | SMLSOURCE of smlsource  
92        | GROUP of AbsPath.t        | GROUP of AbsPath.t
93    
94      datatype private_rule =      datatype private_rule =
95          ISPRIMITIVE          ISSML of bool option
       | ISSML of bool option  
96        | ISGROUP        | ISGROUP
97        | ISTOOL of class * rule        | ISTOOL of class * rule
98    
# Line 110  Line 107 
107      fun registerGroupClass class =      fun registerGroupClass class =
108          classes := StringMap.insert (!classes, class, ISGROUP)          classes := StringMap.insert (!classes, class, ISGROUP)
109    
     fun registerPrimitiveClass class =  
         classes := StringMap.insert (!classes, class, ISPRIMITIVE)  
   
110      (* classifiers are used when the class is not given explicitly *)      (* classifiers are used when the class is not given explicitly *)
111      datatype classifier =      datatype classifier =
112          SFX_CLASSIFIER of string -> class option          SFX_CLASSIFIER of string -> class option
# Line 180  Line 174 
174      fun expand' context = let      fun expand' context = let
175          fun loop (acc, []) = rev acc          fun loop (acc, []) = rev acc
176            | loop (acc, ((p, c), history) :: t) = let            | loop (acc, ((p, c), history) :: t) = let
177                  fun step ISPRIMITIVE =                  fun step (ISSML share) =
178                      loop (PRIMITIVE (Primitive.fromString p) :: acc, t)                      let
                   | step (ISSML share) = let  
179                          val ap = AbsPath.native { context = context, spec = p }                          val ap = AbsPath.native { context = context, spec = p }
180                          val src = { sourcepath = ap,                          val src = { sourcepath = ap,
181                                      history = rev history,                                      history = rev history,
# Line 204  Line 197 
197              in              in
198                  case c of                  case c of
199                      SOME class => step (class2rule class)                      SOME class => step (class2rule class)
200                    | NONE => step (ISSML NONE)                    | NONE =>
201                            (case defaultClassOf p of
202                                 SOME class => step (class2rule class)
203                               | NONE => step (ISSML NONE))
204              end              end
205      in      in
206          fn l => loop ([], l)          fn l => loop ([], l)
# Line 212  Line 208 
208    
209      fun expand (ap, SOME class) =      fun expand (ap, SOME class) =
210          (case class2rule class of          (case class2rule class of
211               ISPRIMITIVE =>               ISSML share =>
                  [PRIMITIVE (Primitive.fromString (AbsPath.spec ap))]  
            | ISSML share =>  
212                   [SMLSOURCE { sourcepath = ap, history = [], share = share }]                   [SMLSOURCE { sourcepath = ap, history = [], share = share }]
213             | ISGROUP =>             | ISGROUP =>
214                   [GROUP ap]                   [GROUP ap]
# Line 227  Line 221 
221               end)               end)
222        | expand (ap, NONE) =        | expand (ap, NONE) =
223               expand' (AbsPath.context ap) [((AbsPath.spec ap, NONE), [])]               expand' (AbsPath.context ap) [((AbsPath.spec ap, NONE), [])]
224    
225        (* registering standard classes and classifiers *)
226        local
227            fun sfx (s, c) =
228                registerClassifier (stdSfxClassifier { sfx = s, class = c })
229        in
230            val _ = registerSmlClass ("sml", NONE)
231            val _ = registerSmlClass ("shared", SOME true)
232            val _ = registerSmlClass ("private", SOME false)
233            val _ = registerGroupClass "cm"
234    
235            val _ = sfx ("sml", "sml")
236            val _ = sfx ("sig", "sml")
237            val _ = sfx ("cm", "cm")
238        end
239  end  end
240    
241  structure Tools :> TOOLS = PrivateTools  structure Tools :> TOOLS = PrivateTools

Legend:
Removed from v.273  
changed lines
  Added in v.274

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