Return to access.sml CVS log

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

Annotation of researchv10no/cmd/sml/src/basics/access.sml, revision 1.1

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: (* access.sml *)
        !             3: 
        !             4: (* use "symbol.sig"; use "access.sig"; use "intmap.sig";
        !             5: 
        !             6: functor AccessF(structure Intmap: INTMAP
        !             7:                       structure Symbol: SYMBOL) : ACCESS =
        !             8: *)
        !             9: structure Access : ACCESS =
        !            10: struct
        !            11: 
        !            12:   structure Symbol = Symbol
        !            13:   structure P = 
        !            14:     struct 
        !            15:       datatype primop = 
        !            16:        ! | * | + | - | := | < | <= | > | >= | alength | boxed | div | cast |
        !            17:        eql | fadd |fdiv |feql |fge |fgt |fle |flt |fmul |fneg |fneq |fsub |
        !            18:        gethdlr | ieql | ineq | neq | makeref | ordof | profile |
        !            19:        sethdlr | slength | callcc | throw | delay | force |
        !            20:        store | subscript | unboxedassign | unboxedupdate | update | ~ |
        !            21:        rshift | lshift | orb | andb | xorb | notb
        !            22: 
        !            23:       fun pr_primop(!) = "!"
        !            24:       |   pr_primop(op *) = "*"
        !            25:       |   pr_primop(op +)  = "+"
        !            26:       |   pr_primop(op -) = "-"
        !            27:       |   pr_primop(op :=) = ":="
        !            28:       |   pr_primop(op <)  = "<"
        !            29:       |   pr_primop(op <=) = "<="
        !            30:       |   pr_primop(op >)  = ">"
        !            31:       |   pr_primop(op >=) = ">="
        !            32:       |   pr_primop (alength) = "alength"
        !            33:       |   pr_primop(boxed) = "boxed"
        !            34:       |   pr_primop (op div) = "div"
        !            35:       |   pr_primop cast = "cast"
        !            36:       |   pr_primop eql = "eql"
        !            37:       |   pr_primop fadd = "fadd"
        !            38:       |   pr_primop fdiv = "fdiv"
        !            39:       |   pr_primop feql = "feql"
        !            40:       |   pr_primop fge  = "fge"
        !            41:       |   pr_primop fgt  = "fgt"
        !            42:       |   pr_primop fle = "fle"
        !            43:       |   pr_primop flt = "flt"
        !            44:       |   pr_primop fmul = "fmul"
        !            45:       |   pr_primop fneg = "fneg"
        !            46:       |   pr_primop fneq = "fneq"
        !            47:       |   pr_primop fsub = "fsub"
        !            48:       |   pr_primop gethdlr = "gethdlr"
        !            49:       |   pr_primop ieql = "ieql"
        !            50:       |   pr_primop ineq = "ineq"
        !            51:       |   pr_primop neq = "neq"
        !            52:       |   pr_primop makeref = "makeref"
        !            53:       |   pr_primop ordof = "ordof"
        !            54:       |   pr_primop profile = "profile"
        !            55:       |   pr_primop sethdlr = "sethdlr"
        !            56:       |   pr_primop slength = "slength"
        !            57:       |   pr_primop callcc = "callcc"
        !            58:       |   pr_primop throw = "throw"
        !            59:       |   pr_primop store = "store"
        !            60:       |   pr_primop subscript = "subscript"
        !            61:       |   pr_primop unboxedassign = "unboxedassign"
        !            62:       |   pr_primop unboxedupdate = "unboxedupdate"
        !            63:       |   pr_primop (op update) = "update"
        !            64:       |   pr_primop(~) = "~"
        !            65:       |   pr_primop(rshift) = "rshift"
        !            66:       |   pr_primop(lshift) = "lshift"
        !            67:       |   pr_primop(orb) = "orb"
        !            68:       |   pr_primop(andb) = "andb"
        !            69:       |   pr_primop(xorb) = "xorb"
        !            70:       |   pr_primop(notb) = "notb"
        !            71:     end
        !            72: 
        !            73:   type lvar = int      (* lambda variable id number *)
        !            74:   type slot = int      (* position in structure record *)
        !            75:   type path = int list (* slot chain terminated by lambda variable id number *)
        !            76:   type primop = P.primop
        !            77: 
        !            78:   datatype access 
        !            79:     = LVAR of lvar
        !            80:     | SLOT of slot
        !            81:     | PATH of path  
        !            82:     | INLINE of primop
        !            83: 
        !            84:   (* local *)
        !            85:     val varcount = ref 0
        !            86:     exception NoLvarName
        !            87:     val lvarNames : string Intmap.intmap = Intmap.new(32, NoLvarName)
        !            88:     val name = Intmap.map lvarNames
        !            89:     val giveLvarName = Intmap.add lvarNames
        !            90: 
        !            91:   val saveLvarNames = System.Control.saveLvarNames
        !            92:   fun mkLvar () : lvar = (inc varcount; !varcount)
        !            93:   fun sameName(v,w) =
        !            94:       if !saveLvarNames
        !            95:       then giveLvarName(v,name w)
        !            96:             handle NoLvarName => (giveLvarName(w, name v)
        !            97:                                      handle NoLvarName => ())
        !            98:       else ()
        !            99:   fun dupLvar v =
        !           100:       (inc varcount;
        !           101:        if !saveLvarNames
        !           102:        then giveLvarName(!varcount,name v) handle NoLvarName => ()
        !           103:        else ();
        !           104:        !varcount)
        !           105:   fun namedLvar(id: Symbol.symbol) =
        !           106:       (inc varcount;
        !           107:        if !saveLvarNames then giveLvarName(!varcount,Symbol.name id) else ();
        !           108:        !varcount)
        !           109:   fun lvarName(lv : lvar) : string =
        !           110:       (name lv ^ makestring lv) handle NoLvarName => makestring lv
        !           111: 
        !           112:   fun pr_lvar(lvar:lvar) = makestring(lvar)
        !           113:   fun pr_slot(slot:slot) = makestring(slot)
        !           114:   fun pr_path'[] = "]"
        !           115:   |   pr_path'[x:int] = makestring x ^ "]"
        !           116:   |   pr_path'((x:int)::rest)= makestring x ^ "," ^ pr_path' rest
        !           117:   fun pr_path path = "[" ^ pr_path' path
        !           118:   fun pr_access (LVAR lvar) = "LVAR(" ^ pr_lvar lvar ^ ")"
        !           119:   |   pr_access (SLOT slot) = "SLOT(" ^ pr_slot slot ^ ")"
        !           120:   |   pr_access (PATH path) = "PATH(" ^ pr_path path ^ ")"
        !           121:   |   pr_access (INLINE po) = "INLINE(" ^ P.pr_primop po ^ ")"
        !           122: 
        !           123: end  (* structure Access *)
        !           124: 
        !           125: (*
        !           126: structure Access= AccessF(structure Intmap= Intmap
        !           127:                                 structure Symbol= Symbol);
        !           128: 
        !           129: *)

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