/* 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;