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
|
/*
Version 1.0 25/04/1994
Author: Sjaak Smetsers
*/
#undef _TYPESBUG_
/*
Type definitions
*/
typedef
enum
{ US_OK, US_OrdinaryFailure, US_SpecificationError, US_UniquenessError, US_UniquenessSpecificationError,
US_StrictnessError, US_LiftedTypeVarError, US_LiftedAttrVarError, US_OverloadingError,
US_ExistentialError, US_ConstructorVarError
} UnificationStatus;
/*
Global variables
*/
extern ImpRules *LastNewImpRule;
extern SymbDef *LastNewDependency;
extern Symbol *LastNewSymbol;
typedef struct overloaded_variable_list_elem
{
TypeCell ovle_temp_type;
TypeCell ovle_copy_type;
struct overloaded_variable_list_elem * ovle_next;
} *OverloadedVariableList;
extern OverloadedVariableList OverloadedTypeVars;
extern Bool DoDeriveUniAttributes;
extern int ErroneousArgumentNumber;
extern HeapDescr TCWorkSpace, TCTempSpace;
extern void *AllocInTCWorkSpace (SizeT size);
/*
Global functions
*/
#ifdef _MEMORY_CHECK_
#define SkipIndirections(type) \
if (MemoryCheck (type), (type) -> tc_kind == Indirection)\
(type) = (TypeCell) SkipIndirectionChain ((type) -> contents_indirect)
#else
#define SkipIndirections(type) \
if ((type) -> tc_kind == Indirection)\
(type) = (TypeCell) SkipIndirectionChain ((type) -> contents_indirect)
#endif
extern TypeCell SkipIndirectionChain (TypeCell type);
#define SkipSC_Indirections(type) \
if ((type) -> tc_strict == SC_Indirection)\
(type) = (TypeCell) Skip_SCI_Chain ((type) -> contents_si_indirect)
extern TypeCell Skip_SCI_Chain (TypeCell type);
#define SkipAttrVarIndirections(avar) \
if ((avar) -> tav_varkind == AC_Indirection)\
(avar) = SkipAttrVarIndirectionChain ((avar) -> tav_indirection)
extern TempAttrVar SkipAttrVarIndirectionChain (TempAttrVar avar);
#ifdef _MEMORY_CHECK_
extern void MemoryCheck (void * ptr);
#else
#define MemoryCheck(ptr)
#endif
extern PlainAttrVar NewPlainAttrVar (void);
extern TempAttrVar NewTempAttrVar (void);
extern AttrVarWithEquations NewAttrVarWithEquations (unsigned attrnr);
extern TypeCell NewTypeVariableCell (HeapDescr hd, AttributeCellKind attrkind);
extern TypeCell NewConstructorTypeCell (SymbDef type_cons, int act_arity, AttributeCellKind attrkind);
#define cAddExtraArgument True
#define cDontAddExtraArgument False
extern TypeCell NewTemporaryConstructorTypeCell (TypeConsRepr type_cons, int act_arity, AttributeCellKind attrkind, Bool extra_argument);
extern BITVECT DetermineUniPropOfTypeCell (SymbDef cons_def, TypeCell cons_cell);
extern BITVECT DetermineConsVarsOfTypeCons (SymbDef typecons, ConsVarList * cons_vars);
extern BITVECT DetermineUniPropOfTypeCons (SymbDef typecons);
extern BITVECT DetermineUniPropOfTypeConsVar (TypeArgClass arg_class [], int arity);
extern void CreateAttributeEquationsForConstructorVariables (SymbDef cons_def, TypeCell arg_cells []);
extern BITVECT DetermineUniVarsOfTypeCons (SymbDef typecons);
extern AttributeCellKind DetermineAttrkindOfTemporaryTypeCell (TypeCell type);
extern TypeCell NewAttributedTypeVariable (HeapDescr hd, AttrVarKind av_kind);
extern TypeCell BasicCells [], UniqueBasicCells [], StrictBasicCells [Nr_Of_Basic_Types];
extern TypeCell NewTypeCell (CellKind kind, HeapDescr hd);
extern TypeCell NewBasicTypeCell (Symbol symbol, HeapDescr hd);
extern TypeCell NewAttributedBasicTypeCell (Symbol symbol, HeapDescr hd, AttributeCellKind attrkind);
extern TypeCell NewFunctionTypeCell (HeapDescr hd, AttributeCellKind attrkind);
extern TypeCell NewVoidTypeCell (AttributeCellKind attrkind, HeapDescr hd);
extern TypeConsRepr NewTypeConstructorRepr (SymbDef symbol, int arity, HeapDescr hd);
extern TypeCell NewConstructorVariableCell (int arity, HeapDescr hd);
extern TypeCell NewEmptyTypeCell (Bool is_strict, HeapDescr hd);
extern SymbDef GetTupleDef (int arity);
extern SymbolType NewSymbolType (HeapDescr hd, int arity);
extern void DumpSymbolType (Symbol symbol, SymbolType stype, int arity);
typedef enum { LhsConstructor, RhsConstructor, AnySymbol } SymbolApplKind;
extern TypeCell CreateInstance (TypeCell type, Bool marking, SymbolApplKind symb_appl, int inst_depth, unsigned group_nr);
extern TypeCell CreateInstanceOfTypeCell (TypeCell elemtype);
extern SymbolType CreateInstanceOfSymbolType (SymbolType stype, int demarity, int offarity, SymbolApplKind symb_appl);
extern Bool ExpandSynonymTypesIfNecessary (TypeCell *t1, TypeCell *t2);
extern UnificationStatus CompareSymbolTypes (SymbolType orig_type, SymbolType temp_type);
extern UnificationStatus SubstituteVariable (TypeCell alpha, TypeCell beta);
extern Bool CopySymbolType (SymbDef fun_symb, SymbolType dst_type);
extern TypeCell RetrieveInstanceOfTypeVar (TypeCell type_var);
extern void AdjustOverloadedNode (Node old_node, Node new_node);
extern void AdjustRecursionNode (Node old_node, Node new_node);
extern void CheckMarkingsOfSymbolType (SymbolType stype);
extern AttrEquationList NewAttributeEquation (TempAttrVar demvar, TempAttrVar offvar,
AttrEquationList nextdem, AttrEquationList nextoff, Bool implicit);
#define cEquationIsImplicit True
#define cEquationIsNotImplicit False
extern void CreateAttributeEquation (TempAttrVar demvar, TempAttrVar offvar, Bool implicit);
extern Bool AdjustDemandedAttributeList (TempAttrVar demvar);
extern PolyList *CollectPropagatingTypeArgs (ConsVarList cons_var, TypeCell type_args [], int arity,
PolyList extra_args [], int nr_of_extra_args);
extern Bool HasObservingResultType (TypeCell type);
extern Bool AdjustAttributeOfTypeCell (TypeCell type, AttributeCellKind attr_kind);
extern Bool MakeAttributeNotUnique (TypeCell type);
extern SymbolType InstantiateRecordSelectorType (Symbol sel_symb, int sel_kind);
typedef enum
{ UEK_OK, UEK_MultiToUni, UEK_NonCoercible, UEK_UniqueRequired, UEK_EssentiallyUnique, UEK_ExistentionalAttr
} UniquenessErrorKind;
extern UniquenessErrorKind DetermineAttributeDependencies (TypeCell demtype, TypeCell offtype, Bool write_access, Bool non_coercible);
extern UniquenessErrorKind ExpandSubstitutedTypes (TypeCell type, TypeCell * result_cell_p);
extern UniquenessErrorKind EquateAttributesOfType (TypeCell type1, AttributeCellKind attr1, TypeCell type2, AttributeCellKind attr2);
extern TypeCell gErroneousTypeCell;
extern Bool gDemandedIsErroneous;
|
