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     ! 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.