![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to access.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / basics|
Return to access.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / basics |
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.