Return to stampset.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / basics

Annotation of researchv10no/cmd/sml/src/basics/stampset.sml, revision 1.1.1.1

1.1       root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
                      2: (* stampset.sml *)
                      3: 
                      4: structure Stampset: STAMPSET =
                      5: struct
                      6: 
                      7:   type stamp = int
                      8:   type stampset = {base: int, limit : int ref}
                      9:      (* represents a set of stamps *)
                     10:   type stampsets = {strStamps: stampset, tycStamps: stampset}
                     11:   type 'a stampmap = 'a array * int
                     12:      (* represents a finite mapping over a stampset to type 'a *)
                     13: 
                     14:   val nextbase = ref  0
                     15: 
                     16:   fun newStampset() : stampset =
                     17:     (* generate a new stampset, guaranteed to be disjoint from any
                     18:        existing stampset (unless a stampset has more than 10000 members!) *)
                     19:       let val base = !nextbase
                     20:        in nextbase := !nextbase + 10000;
                     21:           {base = base, limit = ref(base)}
                     22:       end
                     23: 
                     24:   fun newStampsets() : stampsets =
                     25:       {strStamps = newStampset(), tycStamps = newStampset()}
                     26: 
                     27:   fun member(s: stamp, {base,limit as ref lim}: stampset) : bool =
                     28:       (* tests membership in a stampset *)
                     29:       base <= s andalso s < lim
                     30: 
                     31:   fun newStamp({limit,...}: stampset) : stamp =
                     32:       (* generate a new member of the given stampset *)
                     33:       !limit before inc limit
                     34:       
                     35:   fun newMap({base,limit}: stampset, default: '1a) : '1a stampmap =
                     36:       (* generate a new stampmap over a given stampset with given default value *)
                     37:       (array(!limit-base,default),base)
                     38: 
                     39:   fun updateMap((a,b): 'a stampmap) (s: stamp, x: 'a) : unit =
                     40:       (* add mapping to a stampmap *)
                     41:       update(a,s-b,x)
                     42: 
                     43:   fun applyMap((a,b): 'a stampmap, s: stamp) : 'a =
                     44:       (* apply stampmap to a stamp *)
                     45:       a sub (s-b)
                     46: 
                     47:   fun join({base,limit} : stampset, {base=base',limit=limit'}: stampset)
                     48:       : stamp -> stamp =
                     49:       (* join(A,B) produces a translation function for elements of B and
                     50:          adds translated version of B to A, side-effecting A *)
                     51:      let val limit0 = !limit
                     52:       in limit := limit0 + (!limit' - base');
                     53:         (fn s => (s - base') + limit0)
                     54:      end
                     55: 
                     56:   val fixedStrStamps : stampset = newStampset()
                     57:   val fixedTycStamps : stampset = newStampset()
                     58:   val globalStamps : stampsets =
                     59:        {strStamps = fixedStrStamps,
                     60:         tycStamps = fixedTycStamps}
                     61:   
                     62:   val sigStamps : stampset = newStampset()
                     63:  
                     64:   fun strFixed(s : stamp) : bool = member(s,fixedStrStamps)
                     65:   fun tycFixed(s : stamp) : bool = member(s,fixedTycStamps)
                     66: 
                     67: end (* STAMPSET *)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.