Skip to content
GitLab
Commit 42a497e8 authored by Artem Alimarine's avatar Artem Alimarine
Browse files

added support for constructors (for toString like usage), 

fromString is not yet supported
some error handling improved
parial instances are temporary disabled
parent b6ff9814
Expand all Hide whitespace changes
Inline Side-by-side
frontend/check.icl
View file @ 42a497e8
......@@ -23,15 +23,21 @@ checkGenerics
| gen_index == size generic_defs
= (generic_defs, class_defs, type_defs, modules, type_heaps, cs)
// otherwise
# (gen_def=:{gen_name, gen_type, gen_pos}, generic_defs) = generic_defs![gen_index]
# (generic_def=:{gen_name, gen_type, gen_pos}, generic_defs) = generic_defs![gen_index]
# position = newPosition gen_name gen_pos
# cs_error = setErrorAdmin position cs_error
//---> ("checkGenerics generic type 1", gen_type.gt_type)
// add * for kind-star instances and *->* for arrays
# kinds =
[ KindConst
, KindArrow [KindConst, KindConst]
]
# (kinds_ptr, th_vars) = newPtr (TVI_Kinds kinds) th_vars
# cs = {cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }
# type_heaps = {type_heaps & th_vars = th_vars}
//# (gt_type, _, type_defs, class_defs, modules, type_heaps, cs) =
// checkSymbolType module_index gen_type.gt_type SP_None type_defs class_defs modules type_heaps cs
# (gt_type, type_defs, class_defs, modules, type_heaps, cs) =
checkMemberType module_index gen_type.gt_type type_defs class_defs modules type_heaps cs
......@@ -40,7 +46,13 @@ checkGenerics
#! cs = {cs & cs_error = cs_error}
#! gt_type = {gt_type & st_vars = st_vars}
# generic_defs = {generic_defs & [gen_index] . gen_type = { gen_type & gt_vars = gt_vars, gt_type = gt_type }}
# generic_def =
{ generic_def &
gen_type = { gen_type & gt_vars = gt_vars, gt_type = gt_type }
, gen_kinds_ptr = kinds_ptr
}
# generic_defs = {generic_defs & [gen_index] = generic_def}
//---> ("checkGenerics generic type 2", gt_type)
= checkGenerics (inc gen_index) module_index generic_defs class_defs type_defs modules type_heaps cs
where
......@@ -2537,6 +2549,7 @@ where
# (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_PredefinedModule]
| pre_mod.pds_def == mod_index
= (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols}
<=< adjust_predef_symbol PD_StringType mod_index STE_Type
<=< adjust_predef_symbols PD_ListType PD_UnboxedArrayType mod_index STE_Type
<=< adjust_predef_symbols PD_ConsSymbol PD_Arity32TupleSymbol mod_index STE_Constructor
<=< adjust_predef_symbol PD_TypeCodeClass mod_index STE_Class
......@@ -2581,7 +2594,12 @@ where
<=< adjust_predef_symbol PD_TypeARROW mod_index STE_Type
<=< adjust_predef_symbol PD_ConsARROW mod_index STE_Constructor
<=< adjust_predef_symbol PD_isomap_ARROW_ mod_index STE_DclFunction
<=< adjust_predef_symbol PD_isomap_ID mod_index STE_DclFunction)
<=< adjust_predef_symbol PD_isomap_ID mod_index STE_DclFunction
<=< adjust_predef_symbol PD_TypeCONSInfo mod_index STE_Type
<=< adjust_predef_symbol PD_ConsCONSInfo mod_index STE_Constructor
<=< adjust_predef_symbol PD_TypeCONS mod_index STE_Type
<=< adjust_predef_symbol PD_ConsCONS mod_index STE_Constructor
<=< adjust_predef_symbol PD_cons_info mod_index STE_DclFunction)
# (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdMisc]
| pre_mod.pds_def == mod_index
= (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols}
......
frontend/checkFunctionBodies.icl
View file @ 42a497e8
......@@ -871,22 +871,28 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
-> (!Expression, ![FreeVar], !*ExpressionState, !*ExpressionInfo, !*CheckState)
check_generic_expr
free_vars entry=:{ste_kind=STE_Generic,ste_index} id kind
e_input=:{ei_mod_index} e_state
e_input=:{ei_mod_index} e_state
e_info=:{ef_generic_defs} cs
//#! e_info = {e_info & ef_generic_defs = add_kind ef_generic_defs ste_index kind}
#! (ef_generic_defs, e_state) = add_kind ste_index kind ef_generic_defs e_state
#! e_info = { e_info & ef_generic_defs = ef_generic_defs }
= check_it free_vars ei_mod_index ste_index id kind e_input e_state e_info cs
check_generic_expr
free_vars entry=:{ste_kind=STE_Imported STE_Generic mod_index, ste_index} id kind
e_input e_state
e_info=:{ef_modules} cs
//#! (dcl_module, ef_modules) = ef_modules ! [mod_index]
//#! (dcl_common, dcl_module) = dcl_module ! dcl_common
//#! (com_generic_defs, dcl_common) = dcl_common ! com_generic_defs
//#! dcl_common = {dcl_common & com_generic_defs = add_kind com_generic_defs ste_index kind}
//#! dcl_module = {dcl_module & dcl_common = dcl_common}
//#! ef_modules = {ef_modules & [mod_index] = dcl_module}
//#! e_info = { e_info & ef_modules = ef_modules }
#! (dcl_module, ef_modules) = ef_modules ! [mod_index]
#! (dcl_common, dcl_module) = dcl_module ! dcl_common
#! (com_generic_defs, dcl_common) = dcl_common ! com_generic_defs
#! (com_generic_defs, e_state) = add_kind ste_index kind com_generic_defs e_state
#! dcl_common = {dcl_common & com_generic_defs = com_generic_defs}
#! dcl_module = {dcl_module & dcl_common = dcl_common}
#! ef_modules = {ef_modules & [mod_index] = dcl_module}
#! e_info = { e_info & ef_modules = ef_modules }
= check_it free_vars mod_index ste_index id kind e_input e_state e_info cs
check_generic_expr free_vars entry=:{ste_kind=STE_Empty} id kind e_input e_state e_info cs=:{cs_error}
......@@ -903,11 +909,15 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
#! cs = { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdGeneric }
= (App app, free_vars, e_state, e_info, cs)
add_kind :: !*{#GenericDef} !Index !TypeKind -> !*{#GenericDef}
add_kind generic_defs generic_index kind
# (generic_def, generic_defs) = generic_defs ! [generic_index]
= {generic_defs & [generic_index] = addGenericKind generic_def kind}
add_kind :: !Index !TypeKind !u:{#GenericDef} !*ExpressionState
-> (!u:{#GenericDef}, !*ExpressionState)
add_kind generic_index kind generic_defs e_state=:{es_type_heaps=es_type_heaps=:{th_vars}}
#! (generic_def=:{gen_kinds_ptr}, generic_defs) = generic_defs ! [generic_index]
#! (TVI_Kinds kinds, th_vars) = readPtr gen_kinds_ptr th_vars
#! kinds = eqMerge [kind] kinds
#! th_vars = writePtr gen_kinds_ptr (TVI_Kinds kinds) th_vars
#! e_state = { e_state & es_type_heaps = {es_type_heaps & th_vars = th_vars}}
= (generic_defs, e_state)
// ..AA
checkExpression free_vars expr e_input e_state e_info cs
= abort "checkExpression (checkFunctionBodies.icl, line 868)" // <<- expr
......@@ -947,6 +957,15 @@ where
#! (var_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
= (Var {var_name = id, var_info_ptr = info_ptr, var_expr_ptr = var_expr_ptr}, free_vars,
{e_state & es_expr_heap = es_expr_heap}, e_info, cs)
// AA..
check_id_expression {ste_kind = STE_Generic} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error}
= (EE, free_vars, e_state, e_info,
{ cs & cs_error = checkError id "generic: missing kind argument" cs_error})
check_id_expression {ste_kind = STE_Imported STE_Generic _} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error}
= (EE, free_vars, e_state, e_info,
{ cs & cs_error = checkError id "generic: missing kind argument" cs_error})
// ..AA
check_id_expression entry is_expr_list free_vars id=:{id_info} e_input e_state e_info cs
# (symb_kind, arity, priority, is_a_function, e_state, e_info, cs) = determine_info_of_symbol entry id_info e_input e_state e_info cs
symbol = { symb_name = id, symb_kind = symb_kind, symb_arity = 0 }
......
frontend/checktypes.icl
View file @ 42a497e8
......@@ -1247,7 +1247,7 @@ where
-> (!*{#ClassDef}, !w:{#DclModule}, !v:[SymbolPtr], !u:Indexes, !*TypeVarHeap, !*VarHeap, !*CheckState)
create_class_dictionary mod_index class_index class_defs =:{[class_index] = class_def } modules rev_dictionary_list
indexes type_var_heap var_heap cs=:{cs_symbol_table,cs_error}
# {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_info}}} = class_def
# {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_name,id_info}}} = class_def
| isNilPtr id_info
# (type_id_info, cs_symbol_table) = newPtr EmptySymbolTableEntry cs_symbol_table
nr_of_members = size class_members
......@@ -1315,7 +1315,7 @@ where
ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })
<:= (cons_id_info, { ste_kind = STE_DictCons cons_def, ste_index = index_cons,
ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })})
# ({ste_kind}, cs_symbol_table) = readPtr id_info cs_symbol_table
| ste_kind == STE_Empty
= (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap,
......
frontend/frontend.icl
View file @ 42a497e8
......@@ -130,14 +130,19 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
# heaps = { heaps & hp_type_heaps = type_heaps }
#! (components, ti_common_defs, fun_defs, generic_range, td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) =
case False of
case True of
True -> convertGenerics
components main_dcl_module_n ti_common_defs fun_defs td_infos
heaps hash_table predef_symbols dcl_mods error_admin
False -> (components, ti_common_defs, fun_defs, {ir_to=0,ir_from=0}, td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin)
# icl_common = ti_common_defs.[main_dcl_module_n]
# error = error_admin.ea_file
#! ok = error_admin.ea_ok
| not ok
= (No,{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
// ..AA
# (ok, fun_defs, array_instances, type_code_instances, common_defs, imported_funs, type_def_infos, heaps, predef_symbols, error,out)
......
frontend/generics.icl
View file @ 42a497e8
This diff is collapsed.
frontend/overloading.icl
View file @ 42a497e8
......@@ -695,10 +695,11 @@ where
heaps_and_ptrs)
adjust_member_application defs contexts {me_symb,me_offset,me_class={glob_module,glob_object}} symb_arity (CA_Context tc) class_exprs (heaps=:{hp_type_heaps}, ptrs)
# (class_context, address, hp_type_heaps) = determineContextAddress contexts defs tc hp_type_heaps
{class_dictionary={ds_index}} = defs.[glob_module].com_class_defs.[glob_object]
{class_dictionary={ds_index,ds_ident}} = defs.[glob_module].com_class_defs.[glob_object]
selector = selectFromDictionary glob_module ds_index me_offset defs
= (EI_Selection (generateClassSelection address [RecordSelection selector me_offset]) class_context.tc_var class_exprs,
({ heaps & hp_type_heaps = hp_type_heaps }, ptrs))
adjust_member_application defs contexts _ _ (CA_GlobalTypeCode {tci_index,tci_contexts}) _ heaps_and_ptrs
# (exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts tci_contexts heaps_and_ptrs
= (EI_TypeCode (TCE_Constructor tci_index (map expressionToTypeCodeExpression exprs)), heaps_and_ptrs)
......
frontend/parse.icl
View file @ 42a497e8
......@@ -1228,6 +1228,7 @@ wantGenericDefinition context pos pState
, gt_arity = length arg_vars
}
, gen_pos = pos
, gen_kinds_ptr = nilPtr
, gen_classes = []
, gen_isomap = MakeDefinedSymbol {id_name="",id_info=nilPtr} NoIndex 0
}
......
frontend/predef.dcl
View file @ 42a497e8
......@@ -105,20 +105,26 @@ PD_ConsPAIR :== 145
PD_TypeARROW :== 146
PD_ConsARROW :== 147
PD_isomap_ARROW_ :== 148
PD_isomap_ID :== 149
PD_TypeCONSInfo :== 148
PD_ConsCONSInfo :== 149
PD_cons_info :== 150
PD_TypeCONS :== 151
PD_ConsCONS :== 152
PD_isomap_ARROW_ :== 153
PD_isomap_ID :== 154
/* StdMisc */
PD_StdMisc :== 150
PD_abort :== 151
PD_undef :== 152
PD_StdMisc :== 155
PD_abort :== 156
PD_undef :== 157
PD_Start :== 153
PD_Start :== 158
// MW..
PD_DummyForStrictAliasFun :== 154
PD_DummyForStrictAliasFun :== 159
PD_NrOfPredefSymbols :== 155
PD_NrOfPredefSymbols :== 160
// ..MW
GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
......
frontend/predef.icl
View file @ 42a497e8
......@@ -103,20 +103,26 @@ PD_ConsPAIR :== 145
PD_TypeARROW :== 146
PD_ConsARROW :== 147
PD_isomap_ARROW_ :== 148
PD_isomap_ID :== 149
PD_TypeCONSInfo :== 148
PD_ConsCONSInfo :== 149
PD_cons_info :== 150
PD_TypeCONS :== 151
PD_ConsCONS :== 152
PD_isomap_ARROW_ :== 153
PD_isomap_ID :== 154
/* StdMisc */
PD_StdMisc :== 150
PD_abort :== 151
PD_undef :== 152
PD_StdMisc :== 155
PD_abort :== 156
PD_undef :== 157
PD_Start :== 153
PD_Start :== 158
// MW..
PD_DummyForStrictAliasFun :== 154
PD_DummyForStrictAliasFun :== 159
PD_NrOfPredefSymbols :== 155
PD_NrOfPredefSymbols :== 160
// ..MW
......@@ -211,6 +217,11 @@ where
<<- ("ARROW", IC_Expression, PD_ConsARROW)
<<- ("isomap_ARROW_", IC_Expression, PD_isomap_ARROW_)
<<- ("isomap_ID", IC_Expression, PD_isomap_ID)
<<- ("CONSInfo", IC_Type, PD_TypeCONSInfo)
<<- ("_CONSInfo", IC_Expression, PD_ConsCONSInfo)
<<- ("CONS", IC_Type, PD_TypeCONS)
<<- ("CONS", IC_Expression, PD_ConsCONS)
<<- ("_cons_info", IC_Expression, PD_cons_info)
<<- ("StdMisc", IC_Module, PD_StdMisc)
<<- ("abort", IC_Expression, PD_abort)
......
frontend/syntax.dcl
View file @ 42a497e8
......@@ -269,6 +269,7 @@ cNameLocationDependent :== True
, gen_member_name :: !Ident // the generics name in the IC_Member
, gen_type :: !GenericType
, gen_pos :: !Position
, gen_kinds_ptr :: !TypeVarInfoPtr // hack: contains all used kinds
, gen_classes :: !GenericClassInfos // generated classes
, gen_isomap :: !DefinedSymbol // isomap function
}
......@@ -865,6 +866,7 @@ cNonRecursiveAppl :== False
| TVI_Used /* to administer that this variable is encountered (in checkOpenTypes) */
| TVI_TypeCode !TypeCodeExpression
| TVI_CPSLocalTypeVar !Int /* MdM - the index of the variable as generated by the theorem prover */
| TVI_Kinds ![TypeKind] // AA: used to collect kinds during checking
| TVI_Normalized !Int /* MV - position of type variable in its definition */
:: TypeVarInfoPtr :== Ptr TypeVarInfo
......
frontend/syntax.icl
View file @ 42a497e8
......@@ -259,6 +259,7 @@ cNameLocationDependent :== True
, gen_member_name :: !Ident // the generics name in IC_Member
, gen_type :: !GenericType
, gen_pos :: !Position
, gen_kinds_ptr :: !TypeVarInfoPtr // hack: contains all used kinds
, gen_classes :: !GenericClassInfos // generated classes
, gen_isomap :: !DefinedSymbol // isomap function
}
......@@ -835,6 +836,7 @@ cNotVarNumber :== -1
| TVI_Used /* to adminster that this variable is encountered (in checkOpenTypes) */
| TVI_TypeCode !TypeCodeExpression
| TVI_CPSLocalTypeVar !Int /* MdM - the index of the variable as generated by the theorem prover */
| TVI_Kinds ![TypeKind] // AA: used to collect kinds during checking
| TVI_Normalized !Int /* MV - position of type variable in its definition */
:: TypeVarInfoPtr :== Ptr TypeVarInfo
......
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