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/smlfile/skel-cvt.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/smlfile/skel-cvt.sml

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

revision 295, Wed May 26 09:20:25 1999 UTC revision 296, Thu May 27 05:31:04 1999 UTC
# Line 1  Line 1 
1  (*  (*
2   * Convert ASTs to CM's trimmed version thereof.   * Convert ASTs to CM's trimmed version thereof ("skeletons").
  *   Very heavily revised.  
3   *   *
4   *   Copyright (c) 1999 by Lucent Technologies, Bell Laboratories   *   Copyright (c) 1999 by Lucent Technologies, Bell Laboratories
5     *
6     *   The ideas here are based on those found in the original SC and
7     *   also in an older version of CM (before 1999).  However, nearly
8     *   all aspects have been changed radically, and the code has been
9     *   re-written from scratch.
10     *
11     *   The skeletons generated by this module are typically smaller
12     *   than the "decl"s in SC or old versions of CM.  This should
13     *   make dependency analysis somewhat faster (but is probably not
14     *   very noticeable).
15     *
16     * author: Matthias Blume (blume@cs.princeton.edu)
17     *
18     * The copyright notices of the earlier versions are:
19   *   Copyright (c) 1995 by AT&T Bell Laboratories   *   Copyright (c) 1995 by AT&T Bell Laboratories
20   *   Copyright (c) 1993 by Carnegie Mellon University,   *   Copyright (c) 1993 by Carnegie Mellon University,
21   *                         School of Computer Science   *                         School of Computer Science
22   *                         contact: Gene Rollins (rollins+@cs.cmu.edu)   *                         contact: Gene Rollins (rollins+@cs.cmu.edu)
  *  
  * contact: Matthias Blume (blume@cs.princeton.edu)  
23   *)   *)
24  signature SKELCVT = sig  signature SKELCVT = sig
25      val convert : { tree: GenericVC.Ast.dec,      val convert : { tree: GenericVC.Ast.dec,
# Line 29  Line 40 
40      type symbol = Symbol.symbol      type symbol = Symbol.symbol
41      type path = symbol list      type path = symbol list
42    
     (* function composition suitable for fold[lr]-arguments *)  
     infix o'  
     fun (f o' g) (x, y) = f (g x, y)  
   
     (* make a Seq node when necessary *)  
     fun seq [] = Ref SS.empty  
       | seq [only] = only  
       | seq l = Seq l  
   
     (* make a Par node when necessary and stick it in front of a given dl *)  
     fun par ([], d) = d  
       | par ([only], d) = only :: d  
       | par (l, d) = Par l :: d  
   
43      (* The main idea is to collect lists of decl ("dl"s).      (* The main idea is to collect lists of decl ("dl"s).
44       * Normally, a dl will eventually become an argument to seq or par.       * Normally, a dl will eventually become an argument to seq or par.
45       * As an important optimization, we always try to keep any "Ref s"       * As an important optimization, we always try to keep any "Ref s"
46       * at the front.  At the moment, however, we do not pay attention       * at the front (but we don't try too hard and only do it where
47       * to whether a "Ref" commutes with a "Bind" and such.  In other words       * it is reasonably convenient). *)
48       * we are far from doing all conceivable optimizations. *)  
49        (* function composition suitable for fold[lr]-arguments *)
50        infix o'
51        fun (f o' g) (x, y) = f (g x, y)
52    
53      (* add the head of a symbol path to a given set *)      (* add the head of a symbol path to a given set *)
54      fun s_addP ([], set) = set      fun s_addP ([], set) = set
# Line 83  Line 83 
83            | Ref s' :: dl' => Ref (SS.union (s, s')) :: dl'            | Ref s' :: dl' => Ref (SS.union (s, s')) :: dl'
84            | _ => Ref s :: dl            | _ => Ref s :: dl
85    
86        (* make a Seq node when necessary *)
87        fun seq [] = Ref SS.empty
88          | seq [only] = only
89          | seq l = Seq l
90    
91        (* make a Par node when necessary and stick it in front of a given dl *)
92        fun parcons ([], d) = d
93          | parcons ([only], d) = only :: d
94          | parcons (l, d) = Par l :: d
95    
96        (* Given a "bind list", stick a parallel Bind in front of a given dl.
97         * While doing so, if a Ref occured at the front of the dl, move it
98         * past the bind list (shrinking it appropriately). *)
99        fun parbindcons (bl, Ref s :: d) = let
100                val bs = SS.addList (SS.empty, map #1 bl)
101            in
102                dl_addS (SS.difference (s, bs), parcons (map Bind bl, d))
103            end
104          | parbindcons (bl, d) = parcons (map Bind bl, d)
105    
106      (* split initial ref set from a decl list *)      (* split initial ref set from a decl list *)
107      fun split_dl [] = (SS.empty, [])      fun split_dl [] = (SS.empty, [])
108        | split_dl (Ref s :: d) = (s, d)        | split_dl (Ref s :: d) = (s, d)
# Line 121  Line 141 
141      fun parbind f l d = let      fun parbind f l d = let
142          val (s, bl) = foldl f (SS.empty, []) l          val (s, bl) = foldl f (SS.empty, []) l
143      in      in
144          dl_addS (s, par (bl, d))          dl_addS (s, parbindcons (bl, d))
145      end      end
146    
147      (* get the ref set from a type *)      (* get the ref set from a type *)
# Line 218  Line 238 
238                  val s'' = SS.union (s, s')                  val s'' = SS.union (s, s')
239              in              in
240                  case c of                  case c of
241                      NONE => (s'', Bind (n, e) :: bl)                      NONE => (s'', (n, e) :: bl)
242                    | SOME p => (s'', Bind (n, Ign1 (Var (SP.SPATH p), e)) :: bl)                    | SOME p => (s'', (n, Ign1 (Var (SP.SPATH p), e)) :: bl)
243              end              end
244              val (s, bl) = foldr one (SS.empty, []) l              val (s, bl) = foldr one (SS.empty, []) l
245          in          in
246              dl_addS (s, par (bl, d))              dl_addS (s, parbindcons (bl, d))
247          end          end
248        | spec_dl (TycSpec (l, _), d) = let        | spec_dl (TycSpec (l, _), d) = let
249              fun one_s ((_, _, SOME t), s) = ty_s (t, s)              fun one_s ((_, _, SOME t), s) = ty_s (t, s)
# Line 235  Line 255 
255              fun one ((n, g), (s, bl)) = let              fun one ((n, g), (s, bl)) = let
256                  val (s', e) = fsigexp_p g                  val (s', e) = fsigexp_p g
257              in              in
258                  (SS.union (s, s'), Bind (n, e) :: bl)                  (SS.union (s, s'), (n, e) :: bl)
259              end              end
260              val (s, bl) = foldr one (SS.empty, []) l              val (s, bl) = foldr one (SS.empty, []) l
261          in          in
262              dl_addS (s, par (bl, d))              dl_addS (s, parbindcons (bl, d))
263          end          end
264        | spec_dl (ValSpec l, d) = dl_addS (foldl (ty_s o' #2) SS.empty l, d)        | spec_dl (ValSpec l, d) = dl_addS (foldl (ty_s o' #2) SS.empty l, d)
265        | spec_dl (DataSpec { datatycs, withtycs }, d) =        | spec_dl (DataSpec { datatycs, withtycs }, d) =
# Line 341  Line 361 
361                | one (Strb { name, def, constraint }, (s, bl)) = let                | one (Strb { name, def, constraint }, (s, bl)) = let
362                      val (s', e) = ign (strexp_p def, sigexpc_p constraint)                      val (s', e) = ign (strexp_p def, sigexpc_p constraint)
363                  in                  in
364                      (SS.union (s, s'), Bind (name, e) :: bl)                      (SS.union (s, s'), (name, e) :: bl)
365                  end                  end
366          in          in
367              parbind one l d              parbind one l d
# Line 351  Line 371 
371                | one (Fctb { name, def }, (s, bl)) = let                | one (Fctb { name, def }, (s, bl)) = let
372                      val (s', e) = fctexp_p def                      val (s', e) = fctexp_p def
373                  in                  in
374                      (SS.union (s, s'), Bind (name, e) :: bl)                      (SS.union (s, s'), (name, e) :: bl)
375                  end                  end
376          in          in
377              parbind one l d              parbind one l d
# Line 361  Line 381 
381                | one (Sigb { name, def }, (s, bl)) = let                | one (Sigb { name, def }, (s, bl)) = let
382                      val (s', e) = sigexp_p def                      val (s', e) = sigexp_p def
383                  in                  in
384                      (SS.union (s, s'), Bind (name, e) :: bl)                      (SS.union (s, s'), (name, e) :: bl)
385                  end                  end
386          in          in
387              parbind one l d              parbind one l d
# Line 371  Line 391 
391                | one (Fsigb { name, def }, (s, bl)) = let                | one (Fsigb { name, def }, (s, bl)) = let
392                      val (s', e) = fsigexp_p def                      val (s', e) = fsigexp_p def
393                  in                  in
394                      (SS.union (s, s'), Bind (name, e) :: bl)                      (SS.union (s, s'), (name, e) :: bl)
395                  end                  end
396          in          in
397              parbind one l d              parbind one l d
# Line 379  Line 399 
399        | dec_dl (LocalDec (bdg, body), d) =        | dec_dl (LocalDec (bdg, body), d) =
400          local_dl (dec_dl (bdg, []), dec_dl (body, []), d)          local_dl (dec_dl (bdg, []), dec_dl (body, []), d)
401        | dec_dl (SeqDec l, d) = foldr dec_dl d l        | dec_dl (SeqDec l, d) = foldr dec_dl d l
402        | dec_dl (OpenDec l, d) = par (map (Open o Var o SP.SPATH) l, d)        | dec_dl (OpenDec l, d) = parcons (map (Open o Var o SP.SPATH) l, d)
403        | dec_dl ((OvldDec _ | FixDec _), d) = d        | dec_dl ((OvldDec _ | FixDec _), d) = d
404        | dec_dl (MarkDec (arg, _), d) = dec_dl (arg, d)        | dec_dl (MarkDec (arg, _), d) = dec_dl (arg, d)
405    

Legend:
Removed from v.295  
changed lines
  Added in v.296

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