Commit fa149451 authored by Camil Staps's avatar Camil Staps 🐧

WIP: clipped arrays (for INT32 and REAL32)

parent e4ab7387
......@@ -284,26 +284,27 @@ BEFunType:==16;
BEArrayType:==17;
BEStrictArrayType:==18;
BEUnboxedArrayType:==19;
BEListType:==20;
BETupleType:==21;
BEEmptyType:==22;
BEDynamicType:==23;
BENrOfPredefTypes:==24;
BETupleSymb:==25;
BEConsSymb:==26;
BENilSymb:==27;
BEApplySymb:==28;
BEIfSymb:==29;
BEFailSymb:==30;
BEAllSymb:==31;
BESelectSymb:==32;
BENrOfPredefFunsOrConses:==33;
BEDefinition:==34;
BENewSymbol:==35;
BEInstanceSymb:==36;
BEEmptySymbol:==37;
BEFieldSymbolList:==38;
BEErroneousSymb:==39;
BEClippedArrayType:==20;
BEListType:==21;
BETupleType:==22;
BEEmptyType:==23;
BEDynamicType:==24;
BENrOfPredefTypes:==25;
BETupleSymb:==26;
BEConsSymb:==27;
BENilSymb:==28;
BEApplySymb:==29;
BEIfSymb:==30;
BEFailSymb:==31;
BEAllSymb:==32;
BESelectSymb:==33;
BENrOfPredefFunsOrConses:==34;
BEDefinition:==35;
BENewSymbol:==36;
BEInstanceSymb:==37;
BEEmptySymbol:==38;
BEFieldSymbolList:==39;
BEErroneousSymb:==40;
BECreateArrayFun:==0;
BEArraySelectFun:==1;
BEUnqArraySelectFun:==2;
......
......@@ -732,26 +732,27 @@ BEFunType:==16;
BEArrayType:==17;
BEStrictArrayType:==18;
BEUnboxedArrayType:==19;
BEListType:==20;
BETupleType:==21;
BEEmptyType:==22;
BEDynamicType:==23;
BENrOfPredefTypes:==24;
BETupleSymb:==25;
BEConsSymb:==26;
BENilSymb:==27;
BEApplySymb:==28;
BEIfSymb:==29;
BEFailSymb:==30;
BEAllSymb:==31;
BESelectSymb:==32;
BENrOfPredefFunsOrConses:==33;
BEDefinition:==34;
BENewSymbol:==35;
BEInstanceSymb:==36;
BEEmptySymbol:==37;
BEFieldSymbolList:==38;
BEErroneousSymb:==39;
BEClippedArrayType:==20;
BEListType:==21;
BETupleType:==22;
BEEmptyType:==23;
BEDynamicType:==24;
BENrOfPredefTypes:==25;
BETupleSymb:==26;
BEConsSymb:==27;
BENilSymb:==28;
BEApplySymb:==29;
BEIfSymb:==30;
BEFailSymb:==31;
BEAllSymb:==32;
BESelectSymb:==33;
BENrOfPredefFunsOrConses:==34;
BEDefinition:==35;
BENewSymbol:==36;
BEInstanceSymb:==37;
BEEmptySymbol:==38;
BEFieldSymbolList:==39;
BEErroneousSymb:==40;
BECreateArrayFun:==0;
BEArraySelectFun:==1;
BEUnqArraySelectFun:==2;
......
......@@ -1086,6 +1086,7 @@ predefineSymbols {dcl_common} predefs
(PD_LazyArrayType, 1, BEArrayType)
, (PD_StrictArrayType, 1, BEStrictArrayType)
, (PD_UnboxedArrayType, 1, BEUnboxedArrayType)
, (PD_ClippedArrayType, 1, BEClippedArrayType)
: [(index, index-PD_Arity2TupleType+2, BETupleType) \\ index <- [PD_Arity2TupleType..PD_Arity32TupleType]]
]
......
......@@ -195,6 +195,7 @@ InitPredefinedSymbols (void)
gBasicSymbols [array_type] = PredefinedSymbol (array_type, 1);
gBasicSymbols [strict_array_type] = PredefinedSymbol (strict_array_type, 1);
gBasicSymbols [unboxed_array_type] = PredefinedSymbol (unboxed_array_type, 1);
gBasicSymbols [clipped_array_type] = PredefinedSymbol (clipped_array_type, 1);
gBasicSymbols [fun_type] = PredefinedSymbol (fun_type, 2);
......@@ -592,6 +593,7 @@ BESpecialArrayFunctionSymbol (BEArrayFunKind arrayFunKind, int functionIndex, in
{
case strict_array_type:
case unboxed_array_type:
case clipped_array_type:
elementType->type_node_annotation = StrictAnnot;
break;
case array_type:
......@@ -3163,6 +3165,7 @@ CheckBEEnumTypes (void)
Assert (array_type == BEArrayType);
Assert (strict_array_type == BEStrictArrayType);
Assert (unboxed_array_type == BEUnboxedArrayType);
Assert (clipped_array_type == BEClippedArrayType);
Assert (list_type == BEListType);
Assert (tuple_type == BETupleType);
Assert (empty_type == BEEmptyType);
......
......@@ -114,7 +114,8 @@ enum {
BEIntDenot, BEBoolDenot, BECharDenot, BERealDenot, BEIntegerDenot,
BEStringDenot,
BEFunType, BEArrayType, BEStrictArrayType, BEUnboxedArrayType, BEListType, BETupleType, BEEmptyType,
BEFunType, BEArrayType, BEStrictArrayType, BEUnboxedArrayType, BEClippedArrayType,
BEListType, BETupleType, BEEmptyType,
BEDynamicType,
BENrOfPredefTypes,
......
......@@ -21,6 +21,7 @@ char *ConvertSymbolKindToString (SymbKind skind)
case array_type: return "{ }";
case strict_array_type: return "{ ! }";
case unboxed_array_type:return "{ # }";
case clipped_array_type:return "{ #32 }";
case world_type: return "World";
case procid_type: return "ProcId";
case redid_type: return "RedId";
......
......@@ -296,7 +296,7 @@ void ConvertTypeToState (TypeNode type,StateS *state_p,StateKind kind)
} else
state_p->state_tuple_arguments[i] = arg_type_node->type_node_annotation==NoAnnot ? LazyState : StrictState;
}
} else if (obj_kind==UnboxedArrayObj || obj_kind==StrictArrayObj || obj_kind==ArrayObj){
} else if (obj_kind==UnboxedArrayObj || obj_kind==StrictArrayObj || obj_kind==ArrayObj || obj_kind==ClippedArrayObj){
TypeNode element_node;
element_node=type->type_node_arguments->type_arg_node;
......@@ -320,6 +320,9 @@ void ConvertTypeToState (TypeNode type,StateS *state_p,StateKind kind)
ConvertTypeToState (element_node,&state_p->state_array_arguments [0],StrictOnA);
state_p->state_mark |= STATE_UNBOXED_ARRAY_MASK;
break;
case ClippedArrayObj:
fprintf (stderr,"ConvertTypeToState: ClippedArrayObj\n");
exit (-1);
}
}
}
......@@ -4249,7 +4252,8 @@ static void AnnotateStrictNodeIds (Node node,StrictNodeIdP strict_node_ids,NodeD
if (!type_arg->type_arg_node->type_node_is_var &&
(type_arg->type_arg_node->type_node_symbol->symb_kind==strict_array_type ||
type_arg->type_arg_node->type_node_symbol->symb_kind==unboxed_array_type)
type_arg->type_arg_node->type_node_symbol->symb_kind==unboxed_array_type ||
type_arg->type_arg_node->type_node_symbol->symb_kind==clipped_array_type)
){
node_id->nid_node->node_annotation=StrictAnnot;
} else {
......@@ -4573,6 +4577,7 @@ void InitStatesGen (void)
SetUnaryState (& BasicSymbolStates[array_type], StrictOnA, ArrayObj);
SetUnaryState (& BasicSymbolStates[strict_array_type], StrictOnA, StrictArrayObj);
SetUnaryState (& BasicSymbolStates[unboxed_array_type], StrictOnA, UnboxedArrayObj);
SetUnaryState (& BasicSymbolStates[clipped_array_type], StrictOnA, ClippedArrayObj);
SetUnaryState (& BasicSymbolStates[fun_type], StrictOnA, UnknownObj);
SetUnaryState (& BasicSymbolStates[list_type], StrictOnA, ListObj);
SetUnaryState (& BasicSymbolStates[tuple_type], StrictOnA, TupleObj);
......
......@@ -27,7 +27,7 @@ typedef enum {
#endif
IntObj, BoolObj, CharObj, RealObj, FileObj, unusedObjectKind0/*StringObj*/,
TupleObj, ListObj, RecordObj, ArrayObj, StrictArrayObj, UnboxedArrayObj,
WorldObj, ProcIdObj, RedIdObj
ClippedArrayObj, WorldObj, ProcIdObj, RedIdObj
#ifdef CLEAN2
,DynamicObj
#endif
......@@ -52,7 +52,7 @@ typedef enum {
int_denot, bool_denot, char_denot, real_denot,
/* Nr_Of_Basic_Denots, */ integer_denot,
string_denot,
fun_type, array_type, strict_array_type, unboxed_array_type, list_type, tuple_type, empty_type,
fun_type, array_type, strict_array_type, unboxed_array_type, clipped_array_type, list_type, tuple_type, empty_type,
#ifdef CLEAN2
dynamic_type,
#endif
......
......@@ -848,6 +848,7 @@ checkExpression free_vars (PE_TypeSignature array_kind expr) e_input e_state e_i
predef_array_index = case array_kind of
UnboxedArray -> PD_UnboxedArrayType
StrictArray -> PD_StrictArrayType
ClippedArray -> PD_ClippedArrayType
({pds_module,pds_def},cs) = cs!cs_predef_symbols.[predef_array_index]
#! strict_array_ident = predefined_idents.[predef_array_index]
# type_prop = { tsp_sign = BottomSignClass, tsp_propagation = NoPropClass, tsp_coercible = True }
......
......@@ -592,6 +592,8 @@ where
-> type_code_constructor_expression PD_TC__StrictArray ci
PD_UnboxedArrayType
-> type_code_constructor_expression PD_TC__UnboxedArray ci
PD_ClippedArrayType
-> type_code_constructor_expression PD_TC__ClippedArray ci
PD_UnitType
-> type_code_constructor_expression PD_TC__Unit ci
typeConstructor (GTT_Constructor fun_ident _) ci
......
......@@ -507,6 +507,9 @@ check_unboxed_array_or_list_type ri_main_dcl_module_n glob_module ins_class_inde
| is_predefined_global_symbol ins_class_index PD_ArrayClass rs_predef_symbols && is_unboxed_array tc_types rs_predef_symbols
= check_unboxed_array_type ri_main_dcl_module_n glob_module ins_class_index ins_members tc_types class_members ri_defs class_instances
rs_special_instances (rs_predef_symbols, rs_type_heaps) rs_error
| is_predefined_global_symbol ins_class_index PD_ArrayClass rs_predef_symbols && is_clipped_array tc_types rs_predef_symbols
= check_clipped_array_type ri_main_dcl_module_n ins_class_index ins_members tc_types
rs_special_instances (rs_predef_symbols, rs_type_heaps) rs_error
| is_predefined_global_symbol ins_class_index PD_UListClass rs_predef_symbols
= check_unboxed_list_type ri_main_dcl_module_n glob_module ins_class_index ins_members tc_types class_members ri_defs class_instances
rs_special_instances (rs_predef_symbols, rs_type_heaps) rs_error
......@@ -560,6 +563,29 @@ where
-> (inst.ai_members, { special_instances & si_next_array_member_index = si_next_array_member_index + size members,
si_array_instances = [ inst : si_array_instances ] })
is_clipped_array:: [Type] PredefinedSymbols -> Bool
is_clipped_array [TA {type_index={glob_module,glob_object},type_arity} _ : _] predef_symbols
= is_predefined_symbol glob_module glob_object PD_ClippedArrayType predef_symbols
is_clipped_array _ predef_symbols
= False
check_clipped_array_type :: Int GlobalIndex {#ClassInstanceMember} ![Type]
*SpecialInstances (*PredefinedSymbols,*TypeHeaps) *ErrorAdmin
-> (ReducedContext,*SpecialInstances,(*PredefinedSymbols,*TypeHeaps),*ErrorAdmin)
check_clipped_array_type main_dcl_module_n ins_class_index ins_members types=:[_,elem_type:_]
special_instances predef_symbols_type_heaps error
# error = if (elem_type=:(TB BT_Int) || elem_type=:(TB BT_Real))
error
(clipError error)
= ({rc_class_index = ins_class_index, rc_inst_module = main_dcl_module_n, rc_inst_members = ins_members, rc_red_contexts = [], rc_types = types},
special_instances, predef_symbols_type_heaps, error)
where
clipError error
# error = errorHeading "Overloading error of Array class" error
format = { form_properties = cNoProperties, form_attr_position = No }
error & ea_file = error.ea_file <<< ' ' <:: (format, elem_type, Yes initialTypeVarBeautifulizer) <<< " cannot be clipped\n"
= error
check_unboxed_list_type :: Int Int GlobalIndex {#ClassInstanceMember} ![Type] {#DefinedSymbol} {#CommonDefs} InstanceTree
*SpecialInstances *(*PredefinedSymbols,*TypeHeaps) *ErrorAdmin
-> (ReducedContext,*SpecialInstances,(*PredefinedSymbols,*TypeHeaps), *ErrorAdmin)
......
......@@ -109,6 +109,10 @@ makeUnboxedArraySymbol arity
#! unboxed_array_ident = predefined_idents.[PD_UnboxedArrayType]
= MakeNewTypeSymbIdent unboxed_array_ident arity
makeClippedArraySymbol arity
#! clipped_array_ident = predefined_idents.[PD_ClippedArrayType]
= MakeNewTypeSymbIdent clipped_array_ident arity
makeTupleTypeSymbol form_arity act_arity
#! tuple_ident = predefined_idents.[GetTupleTypeIndex form_arity]
= MakeNewTypeSymbIdent tuple_ident act_arity
......@@ -3176,7 +3180,17 @@ trySimpleTypeT CurlyOpenToken attr pState
| token == CurlyCloseToken
# array_symbol = makeUnboxedArraySymbol 0
= (ParseOk, {at_attribute = attr, at_type = TA array_symbol []}, pState)
// otherwise // token <> CurlyCloseToken
| token == IntToken "32"
# (token, pState) = nextToken TypeContext pState
| token == CurlyCloseToken
# array_symbol = makeClippedArraySymbol 0
= (ParseOk, {at_attribute = attr, at_type = TA array_symbol []}, pState)
// otherwise // token <> CurlyCloseToken
# (atype, pState) = wantAType_strictness_ignored (tokenBack pState)
pState = wantToken TypeContext "clipped array type" CurlyCloseToken pState
array_symbol = makeClippedArraySymbol 1
= (ParseOk, {at_attribute = attr, at_type = TA array_symbol [atype]}, pState)
// otherwise // token <> CurlyCloseToken and token <> IntToken "32"
# (atype, pState) = wantAType_strictness_ignored (tokenBack pState)
pState = wantToken TypeContext "unboxed array type" CurlyCloseToken pState
array_symbol = makeUnboxedArraySymbol 1
......@@ -4496,7 +4510,10 @@ wantRecordOrArrayExp is_pattern pState
ExclamationToken
-> want_array_elems StrictArray pState
SeqLetToken False
-> want_array_elems UnboxedArray pState
# (token, pState) = nextToken FunctionContext pState
| token == IntToken "32"
-> want_array_elems ClippedArray pState
-> want_array_elems UnboxedArray (tokenBack pState)
CurlyCloseToken
-> (PE_ArrayDenot OverloadedArray [], pState)
_
......
This diff is collapsed.
......@@ -47,6 +47,7 @@ predefined_idents
[PD_LazyArrayType] = i "_Array",
[PD_StrictArrayType] = i "_!Array",
[PD_UnboxedArrayType] = i PD_UnboxedArray_String,
[PD_ClippedArrayType] = i "_#32Array",
[PD_UnitType] = i "_Unit",
[PD_TypeCodeMember] = i "_type_code",
[PD_DummyForStrictAliasFun] = i "_dummyForStrictAlias"
......@@ -169,6 +170,7 @@ predefined_idents
[PD_TC__LazyArray] = i "TC__LazyArray",
[PD_TC__StrictArray] = i "TC__StrictArray",
[PD_TC__UnboxedArray] = i "TC__UnboxedArray",
[PD_TC__ClippedArray] = i "TC__ClippedArray",
[PD_TC__Unit] = i "TC__Unit",
......@@ -308,6 +310,7 @@ where
<<= (local_predefined_idents, PD_LazyArrayType)
<<= (local_predefined_idents, PD_StrictArrayType)
<<= (local_predefined_idents, PD_UnboxedArrayType)
<<= (local_predefined_idents, PD_ClippedArrayType)
<<= (local_predefined_idents, PD_UnitType) <<= (local_predefined_idents, PD_UnitConsSymbol)
<<= (local_predefined_idents, PD_TypeCodeMember)
<<= (local_predefined_idents, PD_DummyForStrictAliasFun) // MW++
......@@ -458,10 +461,11 @@ buildPredefinedModule support_dynamics pre_def_symbols
(array_def, pre_def_symbols) = make_type_def PD_LazyArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
(strict_def, pre_def_symbols) = make_type_def PD_StrictArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
(unboxed_def, pre_def_symbols) = make_type_def PD_UnboxedArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
(clipped_def, pre_def_symbols) = make_type_def PD_ClippedArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
(unit_type_def,unit_cons_def,pre_def_symbols) = make_unit_definition pre_mod_ident pre_def_symbols
array_and_unit_type_defs = [array_def,strict_def,unboxed_def,unit_type_def]
array_and_unit_type_defs = [array_def,strict_def,unboxed_def,clipped_def,unit_type_def]
(type_defs, cons_defs, pre_def_symbols) = add_tuple_defs pre_mod_ident MaxTupleArity array_and_unit_type_defs [unit_cons_def] pre_def_symbols
alias_dummy_type = make_identity_fun_type alias_dummy_ident type_var
......
......@@ -1279,7 +1279,7 @@ instance toString KindInfo
:: ModuleIdent:==Ident
:: ArrayKind = OverloadedArray | StrictArray | UnboxedArray;
:: ArrayKind = OverloadedArray | StrictArray | UnboxedArray | ClippedArray;
:: GeneratorKind = IsListGenerator | IsOverloadedListGenerator | IsArrayGenerator
......
......@@ -1449,6 +1449,8 @@ writeTypeTA file opt_beautifulizer form {type_ident,type_index,type_arity} types
= writeWithinBrackets "{!" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_UnboxedArrayType
= writeWithinBrackets "{#" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index==PD_ClippedArrayType
= writeWithinBrackets "{#32" "}" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| predef_index>=PD_Arity2TupleType && predef_index<=PD_Arity32TupleType
= writeWithinBrackets "(" ")" file opt_beautifulizer (setProperty form cCommaSeparator, types)
| checkProperty form cBrackets
......
Markdown is supported
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