![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to basics.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 basics.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / basics |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: (* basics.sml *)
3:
4: (* basic datatypes *)
5:
6: structure Basics : BASICS = struct
7:
8: structure Symbol = Symbol
9: structure Access = Access
10: structure IntStrMap = IntStrMap
11: structure Stampset = Stampset
12:
13: open Symbol Access PrintUtil
14:
15: type spath = symbol list
16: type label = symbol
17: type stamp = int
18: type polysign = {weakness: int, eq: bool} list
19: type sharespec = {s: (spath*spath) list,
20: t: (spath*spath) list}
21:
22: datatype bool3 = YES | NO | MAYBE
23:
24: (* fixity attributes *)
25:
26: datatype fixity = NONfix | INfix of (int*int)
27:
28: datatype conrep
29: = UNDECIDED
30: | TAGGED of int
31: | CONSTANT of int
32: | TRANSPARENT
33: | TRANSU
34: | TRANSB
35: | REF
36: | VARIABLE of access (* exception constructor *)
37:
38: val infinity = 10000000
39:
40: datatype tvkind
41: = IBOUND of int (* inferred bound type variables -- indexed *)
42: | META of (* metavariables -- depth = infinity for metaargs *)
43: {depth: int,
44: weakness: int,
45: eq: bool}
46: | INSTANTIATED of ty
47: | UBOUND of (* user bound type variables -- user name*)
48: {name: symbol,
49: weakness: int,
50: eq: bool}
51:
52: and datacon (* exceptions are a special case with rep=VARIABLE() *)
53: = DATACON of
54: {name : symbol,
55: const : bool,
56: typ : ty ref,
57: rep : conrep,
58: sign : conrep list}
59:
60: and tyckind
61: = ABStyc (* atomic and abstract types *)
62: | DEFtyc of tyfun
63: | DATAtyc of datacon list
64: | RECORDtyc of label list
65: | UNDEFtyc of symbol list option
66:
67: and tycon
68: = TYCON of
69: {stamp : stamp,
70: arity : int,
71: eq : bool3 ref,
72: path : symbol list,
73: kind : tyckind}
74: | INDtyc of int (* indirect tycon -- only in bindings (in sigs) *)
75: | SHRtyc of int list (* sharing indirection -- probably not used *)
76: | RELtyc of int list (* relative tycon -- only in type expressions *)
77: | NULLtyc
78:
79: and ty
80: = VARty of tyvar
81: | CONty of tycon ref * ty list
82: | FLEXRECORDty of rowty ref
83: | POLYty of {sign: {weakness:int, eq:bool} list, tyfun: tyfun}
84: | UNDEFty
85: | ERRORty
86:
87: and rowty
88: = OPEN of (label * ty) list
89: | CLOSED of ty
90:
91: and tyfun
92: = TYFUN of
93: {arity : int,
94: body : ty}
95:
96:
97: (* variables *)
98:
99: and var
100: = VALvar of (* ordinary variables *)
101: {access: access,
102: name : symbol list,
103: typ : ty ref}
104: | OVLDvar of (* overloaded identifier *)
105: {name : symbol,
106: options: {indicator: ty, variant: var} list ref,
107: scheme: tyfun}
108: | UNKNOWNvar of symbol (* place holder for backpatching *)
109:
110:
111: (* structures and signatures *)
112:
113: and strenv
114: = DIR
115: | REL of {s: Structure array, t: tycon array}
116:
117: and strkind
118: = STRkind of
119: {path : symbol list}
120: | SIGkind of
121: {share: sharespec,
122: bindings : binding list,
123: stamps : Stampset.stampsets}
124:
125: and Structure
126: = STRstr of
127: {stamp : stamp,
128: sign : stamp,
129: table : symtable,
130: env : strenv,
131: kind : strkind}
132: | INDstr of int (* indirect substructure binding *)
133: | SHRstr of int list (* sharing indirection *)
134: | NULLstr
135:
136: and Functor
137: = FUNCTOR of
138: {paramName: symbol,
139: param: Structure,
140: body: Structure,
141: paramVis: bool,
142: stamps: Stampset.stampsets}
143:
144: and signatureVar
145: = SIGvar of
146: {name: symbol,
147: binding: Structure}
148:
149: and structureVar
150: = STRvar of
151: {name: symbol list,
152: access: access,
153: binding: Structure}
154:
155: and functorVar
156: = FCTvar of
157: {name: symbol,
158: access: access,
159: binding: Functor}
160:
161: and fixityVar
162: = FIXvar of
163: {name: symbol,
164: binding: fixity}
165:
166: and binding
167: = VARbind of var
168: | CONbind of datacon
169: | TYCbind of tycon ref (* patchable *)
170: | TYVbind of tyvar
171: | SIGbind of signatureVar
172: | STRbind of structureVar
173: | FCTbind of functorVar
174: | FIXbind of fixityVar
175:
176: (* Note: exceptions are identified with data constructors; they
177: no longer have a separate name space, hence no EXNbind constructor.
178: On the other hand, structures and functors have separate name spaces,
179: which may not be correct. *)
180:
181: withtype tyvar = tvkind ref
182: and binder = int * string * binding
183: and symtable = binding IntStrMap.intstrmap
184:
185: datatype trans
186: = VALtrans of access (* old position, val, exn, or unthinned str *)
187: | THINtrans of access * lvar * trans list
188: (* old str position, substr thinning *)
189: | CONtrans of datacon (* constructor as value component *)
190:
191: type thinning = (lvar * trans list) option
192:
193:
194: (* building fixities *)
195:
196: fun infixleft n = INfix (n+n, n+n)
197: fun infixright n = INfix (n+n+1, n+n)
198:
199:
200: (* building variables *)
201:
202: fun mkVALvar(id: symbol, refty: ty ref) : var =
203: VALvar{access = LVAR(namedLvar(id)), name = [id], typ = refty}
204:
205:
206: (* building tycons, signatures, structures, and functors *)
207:
208: fun mkTyvar(kind: tvkind) : tyvar = ref kind
209:
210: fun mkABStyc(path: symbol list, arity: int, eq: bool3,
211: {tycStamps,...}: Stampset.stampsets)
212: : tycon =
213: TYCON{stamp = Stampset.newStamp(tycStamps), path = path, arity = arity,
214: eq = ref eq, kind = ABStyc}
215:
216: fun mkDEFtyc(path: symbol list, def as TYFUN{arity,...}: tyfun, eq: bool3,
217: {tycStamps,...}: Stampset.stampsets)
218: : tycon =
219: TYCON{stamp = Stampset.newStamp(tycStamps), path = path,
220: arity = arity, eq = ref eq, kind = DEFtyc def}
221:
222: fun mkDATAtyc(path: symbol list, arity: int, dcons: datacon list, eq: bool3,
223: {tycStamps,...}: Stampset.stampsets)
224: : tycon =
225: TYCON{stamp = Stampset.newStamp(tycStamps), path = path,
226: arity = arity, eq = ref eq, kind = DATAtyc dcons}
227:
228: fun mkUNDEFtyc(name: symbol, arity: int) : tycon =
229: TYCON{stamp = ~1, path = [name], arity = arity, eq = ref MAYBE,
230: kind = UNDEFtyc NONE}
231:
232: fun mkSTR(path, table, env, {strStamps,...}: Stampset.stampsets) =
233: STRstr{stamp = Stampset.newStamp(strStamps),
234: sign = 0, (* guaranteed not to agree with any valid sig stamp *)
235: table = table,
236: env = env,
237: kind = STRkind{path=path}}
238:
239: end (* structure Basics *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.