syntax_tree_types.h 12.6 KB
Newer Older
clean's avatar
clean committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
/*
	Version 1.2 17 dec1996
*/

#define BASIC_TYPE_IDS_STRING "ibcrfswpvr" /* indexed by SymbKind */

#define Type_Variable_Mark	(1 << Nr_Of_Basic_Types)

typedef enum
{	NoUniAttr, NotUniqueAttr, UniqueAttr, ExistsAttr, UniqueVariable, FirstUniVarNumber
} UniquenessAttributeKind;
	
typedef unsigned AttributeKind;

typedef struct poly_list
{	void *				pl_elem;
	struct poly_list *	pl_next;
} * PolyList;

typedef struct export_list
{
	union
	{	IdentStringP 		exp_u_ident_string;
		struct symbol_def *	exp_u_class;
	} exp_union;

	unsigned	long		exp_type_vector;
	unsigned				exp_line;
	struct export_list *	exp_next;
} *ExportList;

#define exp_class	exp_union.exp_u_class
#define exp_ident	exp_union.exp_u_ident_string

typedef struct type_arg * TypeArgs, TypeArg;
typedef struct type_node *	TypeNode;
typedef struct type_alt *	TypeAlts;

typedef struct
{	BITVECT	tac_uniprop;
	BITVECT	tac_possign;
	BITVECT	tac_negsign;		
} TypeArgClass;

#define type_uniprop  type_argclass.tac_uniprop
#define type_possign  type_argclass.tac_possign
#define type_negsign  type_argclass.tac_negsign

typedef struct type_var *TypeVar;

typedef struct type_var_list
{
	TypeVar					tvl_elem;
	struct type_var_list *	tvl_next;
	AttributeKind			tvl_attribute;
	Bool					tvl_exist_quant:1;
	Bool					tvl_cons_variable:1;

} * TypeVarList;

typedef struct flat_type 
{
	Symbol					ft_symbol;
	TypeVarList				ft_arguments;
	TypeVarList				ft_exist_quant_arguments;

	struct cons_var_list *	ft_cons_vars;
	struct uni_var_admin *	ft_attr_vars;
	
	AttributeKind			ft_attribute;
	int						ft_arity;
	int						ft_exist_arity;

} * FlatType;

typedef enum {	SLK_Symbol, SLK_TreeOfLists, SLK_ListNumber } SymbolListKind;

STRUCT (symbol_list, SymbolList)
{
	union
	{	struct symbol_def *		sl_u_symbol;
		IdentStringP			sl_u_ident_string;
		struct symbol_list *	sl_u_next_tree;
		int						sl_u_class_number;
	} sl_union;
	
	struct symbol_list *		sl_next;

	SymbolListKind				sl_kind;
	
};

#define sl_symbol		sl_union.sl_u_symbol
#define sl_ident_string sl_union.sl_u_ident_string
#define sl_next_tree	sl_union.sl_u_next_tree
#define sl_class_number	sl_union.sl_u_class_number

STRUCT (type_context, TypeContext)
{
	SymbolList				tyco_symbols;

#ifdef SHORT_CLASS_NAMES
	int						tyco_number;
#endif	
	TypeVar					tyco_variable;
	
/*	
	AttributeKind			tyco_attribute;
*/
	unsigned long			tyco_basic_instances;
	struct type_context	*	tyco_next;

};

typedef	struct _instance
{
	Symbol				ins_overloaded_symbol;
	Symbol				ins_symbol;

	TypeNode			ins_type;
	TypeContext			ins_type_context;

	struct type_alt *	ins_type_alt;
	struct type_cell *	ins_over_vars;

	union /* struct */
	{	struct type_cell * 	u1_ins_type_cell;
		struct _instance *	u1_ins_next;
	} ins_union1;
	
	union
	{	ImpRules 	u2_ins_imprule;
		RuleTypes	u2_ins_defrule;
	} ins_union2;
	
	int					ins_context_arity;
	unsigned			ins_line;
	Bool				ins_exported:1;
	Bool				ins_unq_attributed:1;
	Bool				ins_is_default:1;
	unsigned			ins_kind:5;

} * Instance;

#define ins_type_cell	ins_union1.u1_ins_type_cell
#define ins_next		ins_union1.u1_ins_next
#define ins_imprule		ins_union2.u2_ins_imprule
#define ins_defrule		ins_union2.u2_ins_defrule

/*

typedef struct type_list
{
	TypeNode			tl_type;
	TypeContext			tl_type_context;
	Bool				tl_is_default;
	struct type_list *	tl_next;
} *TypeList;

typedef struct dcl_instance
{
	IdentStringP			di_symbol;
	TypeList				di_types;
	unsigned				di_line;
	struct dcl_instance *	di_next;

} * DclInstance;

typedef struct icl_instance
{
	IdentStringP			ii_symbol;
	TypeNode				ii_type;
	TypeContext				ii_type_context;
	PolyList				ii_instances;
	unsigned				ii_line;
	Bool					ii_is_default;
	struct icl_instance *	ii_next;

} * IclInstance;

*/

typedef struct overloaded
{
	Symbol					ol_symbol;
	TypeVar					ol_type_var;
	TypeAlts				ol_type;

/*
	Instance				ol_instances;
	Instance				ol_generic_instance;
*/	
	unsigned long			ol_basic_instances;
	struct overloaded *		ol_next;
	struct class_def *		ol_class;

	AttributeKind			ol_attribute;
	AttributeKind			ol_next_attribute;

	unsigned				ol_line;
	unsigned				ol_number;
	Bool					ol_has_default_instance;

} * Overloaded;

typedef struct field_list
{
	Symbol				fl_symbol;
	TypeNode			fl_type;
	StateS				fl_state;
	struct field_list *	fl_next;
} * FieldList;

typedef struct member_list
{
	Symbol				ml_symbol;
	Overloaded			ml_rule;
	struct member_list *ml_next;
} * MemberList;

typedef struct constructor_list
{
	TypeNode					cl_constructor;
	FieldList					cl_fields;
	StateP						cl_state_p; /* for constructors, union met cl_fields ? */
	TypeVarList					cl_exist_quant_typevars;
	struct constructor_list *	cl_next;

} * ConstructorList;

typedef struct type
{
	FlatType			type_lhs;
	ConstructorList		type_constructors;
	struct type *		type_next;
	unsigned			type_line;
	int					type_nr_of_constructors;	/* 0 for records */
	int					type_number;
	TypeArgClass		type_argclass;

	BITVECT				type_exivars;
	BITVECT				type_univars;
	BITVECT				type_consvars;

} * Types;

#define type_fields 	type_constructors -> cl_fields
#define type_symbol		type_lhs -> ft_symbol

typedef struct class_instance
{
	union
	{	IdentStringP ci_u1_ident_string;
		Symbol		 ci_u1_class_symbol;
	} ci_union1;
	
	Symbol						ci_instance_symbol;
	TypeNode					ci_type;
	TypeContext					ci_type_context;
	struct uni_var_admin *		ci_attr_vars;

	union
	{	struct class_instance *	ci_u3_link;
		struct type_cell *		ci_u3_type_cell;
	} ci_union3;

	struct type_cell **			ci_over_vars;
	
	union
	{	Instance	ci_u2_member_instance_list;
		Instance *	ci_u2_member_instances;
	} ci_union2;
	
	int							ci_context_arity;
	
	struct class_instance *	ci_next;

	unsigned					ci_line;
	Bool						ci_is_default:1;
	Bool						ci_is_imported:1;
	Bool						ci_is_member_instance_list:1;
	unsigned					ci_kind:5;

} * ClassInstance;

#define ci_class_symbol 		ci_union1.ci_u1_class_symbol
#define ci_ident_string			ci_union1.ci_u1_ident_string
#define ci_member_instance_list ci_union2.ci_u2_member_instance_list
#define ci_member_instances		ci_union2.ci_u2_member_instances
#define ci_link					ci_union3.ci_u3_link
#define ci_type_cell			ci_union3.ci_u3_type_cell

typedef struct class_def
{
	Symbol					cd_symbol;
	TypeVar					cd_variable;

	AttributeKind			cd_attribute;

	TypeContext				cd_context;
		
	union
	{	MemberList		cd_u_all_members;
		Overloaded	*	cd_u_members;
	} cd_union;

	MemberList				cd_derived_members;

	SymbolList				cd_context_classes;

	ClassInstance			cd_instances;
	ClassInstance			cd_generic_instance;
	
	unsigned long			cd_imported_basic_instances;
	unsigned long			cd_defined_basic_instances;
	
	struct class_def *		cd_next;
	unsigned				cd_line;
	unsigned				cd_nr_of_members;

	Bool					cd_has_default_instance:1;
	Bool					cd_internal:1;
	Bool					cd_is_member_list:1;

} * ClassDefinition;

#define cd_all_members	cd_union.cd_u_all_members 
#define cd_members		cd_union.cd_u_members 

struct rule_type
{	TypeAlts			rule_type_rule;
	StateP              rule_type_state_p;
	TypeNode			rule_type_root;
	struct rule_type *	rule_type_next;
	unsigned			rule_type_line;
};

typedef struct syn_type SynType,*SynTypes;

struct syn_type
{	FlatType 			syn_lhs;
	TypeNode 			syn_rhs;
	TypeVarList			syn_exist_quant_typevars;
	struct syn_type *	syn_next;
	TypeArgClass 		syn_argclass;

	BITVECT				syn_univars;
	BITVECT				syn_consvars;

	unsigned			syn_line;
};

#define syntype_uniprop  syn_argclass.tac_uniprop
#define syntype_possign  syn_argclass.tac_possign
#define syntype_negsign  syn_argclass.tac_negsign

#define syntype_exivars  syn_exivars
#define syntype_univars  syn_univars

#define syntype_symbol	syn_lhs -> ft_symbol

typedef struct abs_type
{	FlatType			abs_graph;
	struct symbol_def *	abs_impl;
	struct abs_type *	abs_next;
	TypeArgClass		abs_argclass;
	BITVECT				abs_exivars;
	BITVECT				abs_univars;
	unsigned			abs_line;
	int					abs_number;
} *AbsTypes;

#define abstype_uniprop  abs_argclass.tac_uniprop
#define abstype_possign  abs_argclass.tac_possign
#define abstype_negsign  abs_argclass.tac_negsign

#define abstype_exivars  abs_exivars
#define abstype_univars  abs_univars

#define abstype_symbol	abs_graph -> ft_symbol

#ifdef THINK_C
#define DTypeNodeKind(v) \
	(v==VariableTypeNode?"VariableTypeNode": \
	 v==NormalTypeNode?"NormalTypeNode": \
	 v==SelectorTypeNode?"SelectorTypeNode":"")
#endif

struct type_node
{
	union
	{	TypeVar				contents_tv;
		Symbol				contents_symbol;
	} type_node_contents;

	struct type_arg *		type_node_arguments;
#if 0
	StateS					type_node_state;
#endif
	AttributeKind			type_node_attribute;
	short					type_node_arity;
	Annotation				type_node_annotation;
	unsigned char			type_node_is_var:1;
404
405
406
# ifdef CLEAN2
	TypeVarList				type_for_all_vars;
# endif
clean's avatar
clean committed
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
};

#define type_node_symbol type_node_contents.contents_symbol
#define type_node_tv type_node_contents.contents_tv

struct type_arg
{	TypeNode	type_arg_node;
	TypeArgs	type_arg_next;
};

typedef struct attr_kind_list
{	AttributeKind			akl_elem;
	struct uni_var *		akl_id;
	struct attr_kind_list *	akl_next;
} * AttributeKindList;
	
typedef struct uni_var_equats
{	AttributeKind			uve_demanded;
	struct uni_var *		uve_demanded_var;
	AttributeKindList		uve_offered;
	struct uni_var_equats *	uve_next;
} * UniVarEquations;

typedef struct type_alt
{
	TypeNode				type_alt_lhs;
	TypeNode				type_alt_rhs;
	UniVarEquations			type_alt_attr_equations;
	TypeContext				type_alt_type_context;
	
	struct uni_var_admin *	type_alt_attr_vars;

	unsigned				type_alt_line;
} TypeAlt;

typedef struct cons_var_list
{
	TypeVar					cvl_nodeid;
	TypeArgClass *			cvl_argclass;
	struct cons_var_list *	cvl_next;
	int						cvl_number;
	int						cvl_arity;
	
} * ConsVarList;

struct type_var
{
	Ident			tv_ident;
	unsigned short	tv_mark;
	int				tv_refcount;
	int				tv_number;
	int 			tv_argument_nr;
	int				tv_overvar_arity;
	union
	{	TypeVar						u1_imp_tv;
		TypeNode					u1_subst_type;
		struct cons_var_list *		u1_cons_var_info;
	} tv_u1;
	union
	{	TypeVar						u2_forward_tv;
		struct type_cell *			u2_type;
		TypeNode					u2_type_node;
		struct type_context *		u2_context;
		PolyList					u2_formal_type_vars;
	} tv_u2;
};

#define tv_type					tv_u2.u2_type			/* comparser,typechecker */
#define tv_type_node			tv_u2.u2_type_node		/* typeconv */
#define tv_forward_tv			tv_u2.u2_forward_tv		/* checker,transform */
#define tv_type_context			tv_u2.u2_context		/* checktypedefs */
#define tv_formal_type_vars		tv_u2.u2_formal_type_vars/* checktypedefs */

#define tv_imp_tv				tv_u1.u1_imp_tv
#define tv_subst_type			tv_u1.u1_subst_type			/* checktypedefs */
#define tv_cons_var_info		tv_u1.u1_cons_var_info		/* checktypedefs */
#define tv_imp_tv				tv_u1.u1_imp_tv				/* checktypedefs */

#define TestMark(n,f,mask) 	(((n)->f & (mask)) != 0)
#define SetMark(n,f,mask) 	((n)->f |= (mask))
#define ClearMark(n,f,mask) ((n)->f &= ~(mask))

#define TV_INSTANTIATION_MASK 						(1 << 0)	/* checktypedefs */
#define TV_VERIFY_MASK								(1 << 1)	/* checktypedefs */
#define TV_CONVERSION_MASK							(1 << 2)	/* typeconv */
#define TV_EXISTENTIAL_ATTRIBUTE_MASK				(1 << 3)	/* checktypedefs, typeconv */
#define TV_RHS_EXISTENTIAL_MASK						(1 << 4)	/* checktypedefs */
#define TV_CONSTRUCTOR_VARIABLE_MASK				(1 << 5)	/* checktypedefs */
#define TV_OVERLOADED_VARIABLE_MASK					(1 << 6)	/* comparser */
#define TV_INIT_MASK								(1 << 7)	/* checktypedefs */
#define TV_DUPLICATED								(1 << 8)	/* checktypedefs */
#define TV_UNIQUE_MASK								(1 << 9)	/* checktypedefs */
#define TV_CLASS_VARIABLE_MASK						(1 << 10)	/* checktypedefs */
#define TV_CONS_VAR_WITH_ARGS						(1 << 11)	/* checktypedefs */
#define TV_UNIQUE_VARIABLE_PRINT_MASK				(1 << 12)	/* typeconv */
#define TV_NO_CONTEXT_VARIABLE_MASK					(1 << 13)	/* checktypedefs */
#define TV_WITH_INST_RESTR							(1 << 14)	/* checktypedefs */
#define TV_HAS_INST_MASK							(1 << 15)	/* checktypedefs */

typedef struct uni_var
{
	Ident				uv_ident;
	unsigned short		uv_mark;
	int					uv_number;
	struct uni_var *	uv_next_uni_var;
	UniVarEquations		uv_equations;

} * UniVar;

#define UV_INSTANTIATION_MASK 						(1 << 0)	/* checktypedefs */
#define UV_CYCLE_MASK 								(1 << 1)	/* checktypedefs */
#define UV_CHECKED_MASK 							(1 << 2)	/* checktypedefs */

typedef struct uni_var_admin
{	unsigned	uva_next_number;
	UniVar 		uva_list;

} * UniVarAdministration;

#ifdef SHORT_CLASS_NAMES
STRUCT (module_info, ModuleInfo)
{
	Symbol							mi_module_symbol;
	struct class_conversion_table *	mi_class_table;
	int								mi_next_class_number;
	struct type_conversion_table *	mi_type_table;
	int								mi_next_type_number;
};

STRUCT (class_conversion_table, ClassConversionTable) 
{	int								cct_number;
	SymbolList						cct_symbols;
	struct class_conversion_table *	cct_next;
};

STRUCT (type_conversion_table, TypeConversionTable) 
{	int								tct_number;
	struct symbol_def *				tct_type_symbol;
	struct type_conversion_table *	tct_next;
};

#endif