Commit aef2ea32 authored by John van Groningen's avatar John van Groningen
Browse files

rename extendable to extensible

parent 30f695d8
......@@ -852,7 +852,7 @@ defineType moduleIndex _ _ typeIndex {td_attribute, td_args, td_rhs=AbstractType
= beAbsType (convertTypeLhs moduleIndex typeIndex td_attribute td_args) be
defineType moduleIndex _ _ typeIndex {td_attribute, td_args, td_rhs=AbstractSynType _ _} be
= beAbsType (convertTypeLhs moduleIndex typeIndex td_attribute td_args) be
defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args, td_rhs=ExtendableAlgType constructorSymbols} be
defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args, td_rhs=ExtensibleAlgType constructorSymbols} be
# (flatType, be) = convertTypeLhs moduleIndex typeIndex td_attribute td_args be
# (constructors, be) = convertConstructors typeIndex td_ident.id_name moduleIndex constructors constructorSymbols be
= appBackEnd (BEExtendableAlgebraicType flatType constructors) be
......
......@@ -633,7 +633,7 @@ where
AbstractSynType properties _
# type_def_infos = init_abstract_type_def properties td_args gi_module gi_index type_def_infos
-> (True, type_def_infos, as_type_var_heap, kind_heap)
ExtendableAlgType _
ExtensibleAlgType _
# (tdi_kinds, (as_type_var_heap, kind_heap)) = newKindConstVariables td_args (as_type_var_heap, kind_heap)
-> (is_abstract_type, {type_def_infos & [gi_module].[gi_index].tdi_kinds = tdi_kinds}, as_type_var_heap, kind_heap)
AlgConses _ _
......@@ -683,7 +683,7 @@ where
= (cv_props, (conds, {as & as_kind_heap = uki_kind_heap, as_error = uki_error}))
anal_rhs_of_type_def modules com_cons_defs (NewType cons) conds_as
= analTypesOfConstructor modules com_cons_defs cons conds_as
anal_rhs_of_type_def modules com_cons_defs (ExtendableAlgType conses) conds_as
anal_rhs_of_type_def modules com_cons_defs (ExtensibleAlgType conses) conds_as
# (cons_properties, (conds,as)) = analTypesOfConstructors modules com_cons_defs conses conds_as
= ((cons_properties bitand (bitnot cIsHyperStrict)) /*bitor cIsNonCoercible*/, (conds,as))
anal_rhs_of_type_def modules com_cons_defs (AlgConses conses _) conds_as
......@@ -754,8 +754,8 @@ where
#! td_infos & [gi_module,gi_index] = td_info
| type_properties bitand cIsNonCoercible<>0
# type_def = modules.[gi_module].com_type_defs.[gi_index]
| not (isUniqueAttr type_def.td_attribute) && is_ExtendableAlgType_or_AlgConses type_def.td_rhs
# error = checkErrorWithPosition type_def.td_ident type_def.td_pos "a non unique extendable algebraic data type must be coercible" error
| not (isUniqueAttr type_def.td_attribute) && is_ExtensibleAlgType_or_AlgConses type_def.td_rhs
# error = checkErrorWithPosition type_def.td_ident type_def.td_pos "a non unique extensible algebraic data type must be coercible" error
= (kind_store, kind_heap, td_infos, error)
= (kind_store, kind_heap, td_infos, error)
= (kind_store, kind_heap, td_infos, error)
......@@ -779,9 +779,9 @@ where
is_a_top_var var_number []
= False
is_ExtendableAlgType_or_AlgConses (ExtendableAlgType _) = True
is_ExtendableAlgType_or_AlgConses (AlgConses _ _) = True
is_ExtendableAlgType_or_AlgConses _ = False
is_ExtensibleAlgType_or_AlgConses (ExtensibleAlgType _) = True
is_ExtensibleAlgType_or_AlgConses (AlgConses _ _) = True
is_ExtensibleAlgType_or_AlgConses _ = False
check_dcl_properties modules dcl_types dcl_mod_index properties {gi_module, gi_index} as
| gi_module == dcl_mod_index && gi_index < size dcl_types
......@@ -1197,7 +1197,7 @@ isUniqueTypeRhs common_defs mod_index (RecordType {rt_constructor={ds_index}}) s
= constructor_is_unique mod_index ds_index common_defs state
isUniqueTypeRhs common_defs mod_index (NewType {ds_index}) state
= constructor_is_unique mod_index ds_index common_defs state
isUniqueTypeRhs common_defs mod_index (ExtendableAlgType constructors) state
isUniqueTypeRhs common_defs mod_index (ExtensibleAlgType constructors) state
= has_unique_constructor constructors common_defs mod_index state
isUniqueTypeRhs common_defs mod_index (AlgConses constructors _) state
= has_unique_constructor constructors common_defs mod_index state
......
......@@ -196,7 +196,7 @@ where
| properties bitand cIsNonCoercible == 0
= (PostiveSignClass, scs)
= (TopSignClass, scs)
sign_class_of_type_def module_index (ExtendableAlgType conses) group_nr ci scs
sign_class_of_type_def module_index (ExtensibleAlgType conses) group_nr ci scs
= (TopSignClass, scs)
sign_class_of_type_def module_index (AlgConses conses _) group_nr ci scs
= (TopSignClass, scs)
......@@ -477,7 +477,7 @@ where
= (PropClass, pcs)
prop_class_of_type_def _ (AbstractSynType properties _) _ _ pcs
= (PropClass, pcs)
prop_class_of_type_def module_index (ExtendableAlgType conses) group_nr ci pcs
prop_class_of_type_def module_index (ExtensibleAlgType conses) group_nr ci pcs
= (PropClass, pcs)
prop_class_of_type_def module_index (AlgConses conses _) group_nr ci pcs
= (PropClass, pcs)
......
......@@ -434,7 +434,7 @@ where
check_rhs_of_TypeDef {td_rhs = AbstractSynType properties type} _ cti ts_ti_cs
# (type, type_attr, ts_ti_cs) = bindTypes cti type ts_ti_cs
= (AbstractSynType properties type, ts_ti_cs)
check_rhs_of_TypeDef {td_ident,td_arity,td_args,td_rhs = td_rhs=:ExtendableAlgType conses} attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} class_defs_ts_ti_cs
check_rhs_of_TypeDef {td_ident,td_arity,td_args,td_rhs = td_rhs=:ExtensibleAlgType conses} attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} class_defs_ts_ti_cs
# type_lhs = { at_attribute = cti_lhs_attribute,
at_type = TA (MakeTypeSymbIdent {glob_object = cti_type_index, glob_module = cti_module_index} td_ident td_arity)
[{at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]}
......@@ -447,7 +447,7 @@ where
cs & cs_symbol_table = cs_symbol_table
| type_index <> NotFound
# ts_ti_cs = (ts,ti,cs)
// to do check if ExtendableAlgType
// to do check if ExtensibleAlgType
# type_lhs = { at_attribute = cti_lhs_attribute,
at_type = TA (MakeTypeSymbIdent { glob_object = type_index, glob_module = type_module } td_ident td_arity)
[{at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]}
......
......@@ -690,7 +690,7 @@ instance consumerRequirements Case where
defined_symbols = case type_def.td_rhs of
AlgType defined_symbols -> defined_symbols
RecordType {rt_constructor} -> [rt_constructor]
ExtendableAlgType defined_symbols -> defined_symbols
ExtensibleAlgType defined_symbols -> defined_symbols
AlgConses defined_symbols _ -> defined_symbols
all_constructors = [ ds_index \\ {ds_index}<-defined_symbols ]
all_sorted_constructors = if (is_sorted all_constructors)
......@@ -710,7 +710,7 @@ instance consumerRequirements Case where
defined_symbols = case type_def.td_rhs of
AlgType defined_symbols -> defined_symbols
RecordType {rt_constructor} -> [rt_constructor]
ExtendableAlgType defined_symbols -> defined_symbols
ExtensibleAlgType defined_symbols -> defined_symbols
AlgConses defined_symbols _ -> defined_symbols
all_constructors = [ ds_index \\ {ds_index}<-defined_symbols ]
all_sorted_constructors = if (is_sorted all_constructors) all_constructors (sortBy (<) all_constructors)
......
......@@ -72,9 +72,9 @@ where
compare_rhs_of_types (AbstractSynType _ dclType) (SynType iclType) dcl_cons_defs icl_cons_defs comp_st
# (ok, comp_st) = compare dclType iclType comp_st
= (ok, icl_cons_defs, comp_st)
compare_rhs_of_types (ExtendableAlgType []) (ExtendableAlgType []) dcl_cons_defs icl_cons_defs comp_st
compare_rhs_of_types (ExtensibleAlgType []) (ExtensibleAlgType []) dcl_cons_defs icl_cons_defs comp_st
= (True, icl_cons_defs, comp_st)
compare_rhs_of_types (ExtendableAlgType dclConstructors) (ExtendableAlgType iclConstructors) dcl_cons_defs icl_cons_defs comp_st
compare_rhs_of_types (ExtensibleAlgType dclConstructors) (ExtensibleAlgType iclConstructors) dcl_cons_defs icl_cons_defs comp_st
= compare_constructor_lists dclConstructors iclConstructors dcl_cons_defs icl_cons_defs comp_st
compare_rhs_of_types (AlgConses dclConstructors dcl_type_index) (AlgConses iclConstructors icl_type_index) dcl_cons_defs icl_cons_defs comp_st
| dcl_type_index==icl_type_index
......@@ -970,7 +970,7 @@ instance t_corresponds TypeRhs where
= t_corresponds dclType iclType
t_corresponds (NewType dclConstructor) (NewType iclConstructor)
= t_corresponds dclConstructor iclConstructor
t_corresponds (ExtendableAlgType dclConstructors) (ExtendableAlgType iclConstructors)
t_corresponds (ExtensibleAlgType dclConstructors) (ExtensibleAlgType iclConstructors)
= t_corresponds dclConstructors iclConstructors
// sanity check ...
......
......@@ -1806,8 +1806,8 @@ where
-> want_record_type_rhs name True exi_vars pState
-> (PD_Type td, parseError "Record type" No ("after ! in definition of record type "+name+" { ") pState)
_
# (condefs, extendable_algebraic_type, pState) = want_constructor_list exi_vars token pState
# td & td_rhs = if extendable_algebraic_type (ExtendableConses condefs) (ConsList condefs)
# (condefs, extensible_algebraic_type, pState) = want_constructor_list exi_vars token pState
# td & td_rhs = if extensible_algebraic_type (ExtensibleConses condefs) (ConsList condefs)
| annot == AN_None
-> (PD_Type td, pState)
-> (PD_Type td, parseError "Algebraic type" No ("No lhs strictness annotation for the algebraic type "+name) pState)
......@@ -1902,8 +1902,8 @@ where
| token == BarToken
# (exi_vars, pState) = optionalExistentialQuantifiedVariables pState
(token, pState) = nextToken GeneralContext pState
(cons_list, extendable_algebraic_type, pState) = want_constructor_list exi_vars token pState
= ([cons : cons_list], extendable_algebraic_type, pState)
(cons_list, extensible_algebraic_type, pState) = want_constructor_list exi_vars token pState
= ([cons : cons_list], extensible_algebraic_type, pState)
= ([cons], False, tokenBack pState)
want_more_constructors :: ![ATypeVar] !Token !ParseState -> (![ParsedConstructor],!ParseState)
......
......@@ -1318,11 +1318,11 @@ reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = AbstractTypeSpec p
type_def = { type_def & td_rhs = AbstractSynType properties type }
c_defs = { c_defs & def_types = [type_def : c_defs.def_types] }
= (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca)
reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = ExtendableConses cons_defs} : defs] def_counts=:{cons_count,type_count} ca
reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = ExtensibleConses cons_defs} : defs] def_counts=:{cons_count,type_count} ca
# (cons_symbs, cons_count) = determine_symbols_of_conses cons_defs cons_count
def_counts & cons_count=cons_count, type_count=type_count+1
(fun_defs, c_defs, imports, imported_objects,foreign_exports, ca) = reorganiseDefinitions icl_module defs def_counts ca
type_def & td_rhs = ExtendableAlgType cons_symbs
type_def & td_rhs = ExtensibleAlgType cons_symbs
c_defs & def_types = [type_def : c_defs.def_types], def_constructors = mapAppend ParsedConstructorToConsDef cons_defs c_defs.def_constructors
= (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca)
reorganiseDefinitions icl_module [PD_Type type_def=:{td_rhs = MoreConses type_ext_ident cons_defs} : defs] def_counts=:{cons_count,type_count} ca
......
......@@ -186,7 +186,7 @@ instance == FunctionOrMacroIndex
| NewTypeCons !ParsedConstructor
| EmptyRhs !BITVECT
| AbstractTypeSpec !BITVECT !AType
| ExtendableConses ![ParsedConstructor]
| ExtensibleConses ![ParsedConstructor]
| MoreConses !Ident ![ParsedConstructor]
:: CollectedDefinitions instance_kind =
......@@ -526,7 +526,7 @@ cIsImportedObject :== False
| NewType !DefinedSymbol
| AbstractType !BITVECT
| AbstractSynType !BITVECT !AType
| ExtendableAlgType ![DefinedSymbol]
| ExtensibleAlgType ![DefinedSymbol]
| AlgConses ![DefinedSymbol] !GlobalIndex
| UncheckedAlgConses !Ident ![DefinedSymbol]
| UnknownType
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment