aboutsummaryrefslogtreecommitdiff
path: root/frontend
diff options
context:
space:
mode:
Diffstat (limited to 'frontend')
-rw-r--r--frontend/overloading.dcl3
-rw-r--r--frontend/overloading.icl44
-rw-r--r--frontend/type.icl58
3 files changed, 24 insertions, 81 deletions
diff --git a/frontend/overloading.dcl b/frontend/overloading.dcl
index 3435fba..b04b2ab 100644
--- a/frontend/overloading.dcl
+++ b/frontend/overloading.dcl
@@ -50,6 +50,3 @@ tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos, Ind
removeOverloadedFunctions :: ![Index] ![LocalTypePatternVariable] !Int !*{#FunDef} !*{! FunctionType} !*ExpressionHeap
!*TypeCodeInfo !*VarHeap !*ErrorAdmin !*{#PredefinedSymbol} //!*{#PredefinedSymbol}
-> (!*{#FunDef}, !*{! FunctionType}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin, !*{#PredefinedSymbol})
-
-updateDynamics :: ![Index] ![LocalTypePatternVariable] !Int !*{#FunDef} !*{! FunctionType} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin !*{#PredefinedSymbol}
- -> (!*{#FunDef}, !*{! FunctionType}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin, !*{#PredefinedSymbol})
diff --git a/frontend/overloading.icl b/frontend/overloading.icl
index f9f304d..26d3381 100644
--- a/frontend/overloading.icl
+++ b/frontend/overloading.icl
@@ -1089,39 +1089,6 @@ getClassVariable symb var_info_ptr var_heap error
# (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
-> (symb, new_info_ptr, var_heap <:= (var_info_ptr, VI_ClassVar symb new_info_ptr 1), overloadingError symb error)
-updateDynamics :: ![Index] ![LocalTypePatternVariable] !Int !*{#FunDef} !*{! FunctionType} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin !*{#PredefinedSymbol}
- -> (!*{#FunDef}, !*{! FunctionType}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin, !*{#PredefinedSymbol})
-updateDynamics funs type_pattern_vars main_dcl_module_n fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols
- | error.ea_ok
- = update_dynamics funs type_pattern_vars fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols
- = (fun_defs, fun_env, symbol_heap, type_code_info, var_heap, error, predef_symbols)
-where
- update_dynamics [] type_pattern_vars fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols
- = (fun_defs, fun_env, symbol_heap, type_code_info, var_heap, error, predef_symbols)
- update_dynamics [fun:funs] type_pattern_vars fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols
- # (fun_def, fun_defs) = fun_defs![fun]
- # {fun_body,fun_ident,fun_info} = fun_def
- # {fi_group_index, fi_dynamics, fi_local_vars} = fun_info
- | isEmpty fi_dynamics
- = update_dynamics funs type_pattern_vars fun_defs fun_env symbol_heap type_code_info var_heap error predef_symbols
- # (type_code_info, symbol_heap, type_pattern_vars, var_heap, error)
- = convertDynamicTypes fi_dynamics (type_code_info, symbol_heap, type_pattern_vars, var_heap, error)
- (TransformedBody tb) = fun_body
- (tb_rhs,ui)
- = updateExpression fi_group_index tb.tb_rhs
- { ui_instance_calls = [], ui_symbol_heap = symbol_heap, ui_fun_defs = fun_defs, ui_local_vars = fi_local_vars,
- ui_fun_env = fun_env, ui_var_heap = var_heap, ui_error = error,
- ui_has_type_codes = False,
- ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n}}
- # { ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_error,
- ui_x = {x_type_code_info, x_predef_symbols = predef_symbols}}
- = ui
-
- fun_def = { fun_def & fun_body = TransformedBody {tb & tb_rhs = tb_rhs}, fun_info = { fun_info & fi_local_vars = ui_local_vars}}
- = update_dynamics funs type_pattern_vars ({ ui_fun_defs & [fun] = fun_def })
- ui_fun_env ui_symbol_heap x_type_code_info ui_var_heap ui_error predef_symbols
-
-
removeOverloadedFunctions :: ![Index] ![LocalTypePatternVariable] !Int !*{#FunDef} !*{! FunctionType} !*ExpressionHeap
!*TypeCodeInfo !*VarHeap !*ErrorAdmin !*{#PredefinedSymbol}
-> (!*{#FunDef}, !*{! FunctionType}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin, !*{#PredefinedSymbol})
@@ -1141,7 +1108,6 @@ where
(type_code_info, symbol_heap, type_pattern_vars, var_heap, error)
= convertDynamicTypes fun_info.fi_dynamics (type_code_info, symbol_heap, type_pattern_vars, var_heap, error)
-// (tb_rhs, {ui_instance_calls, ui_local_vars, ui_symbol_heap, ui_var_heap, ui_fun_defs, ui_fun_env, ui_error, ui_x = {x_type_code_info = type_code_info, x_predef_symbols = predef_symbols}})
(tb_rhs, ui)
= updateExpression fun_info.fi_group_index tb_rhs { ui_instance_calls = [], ui_local_vars = fun_info.fi_local_vars, ui_symbol_heap = symbol_heap,
ui_var_heap = var_heap, ui_fun_defs = fun_defs, ui_fun_env = fun_env, ui_error = error,
@@ -1392,7 +1358,7 @@ where
, x_predef_symbols :: !.{#PredefinedSymbol}
, x_main_dcl_module_n :: !Int
}
-
+
class updateExpression e :: !Index !e !*UpdateInfo -> (!e, !*UpdateInfo)
instance updateExpression Expression
@@ -1504,6 +1470,7 @@ where
= foldSt (examine_calls_bind) let_lazy_binds (examine_calls_in_expr let_expr ui)
examine_calls_in_expr _ ui
= ui
+
examine_calls_bind {lb_src,lb_dst} ui=:{ui_local_vars}
= examine_calls_in_expr lb_src { ui & ui_local_vars = [lb_dst : ui_local_vars ]}
@@ -1688,13 +1655,6 @@ where
adjustClassExpression symb_ident expr ui
= (expr, ui)
-let_ptr nr_of_binds ui=:{ui_symbol_heap}
- # (expr_info_ptr, ui_symbol_heap) = newPtr (EI_LetType (repeatn nr_of_binds empty_attributed_type)) ui_symbol_heap
- = (expr_info_ptr, {ui & ui_symbol_heap = ui_symbol_heap})
-where
- empty_attributed_type :: AType
- empty_attributed_type = { at_attribute = TA_Multi, at_type = TE }
-
class equalTypes a :: !a !a !*TypeVarHeap -> (!Bool, !*TypeVarHeap)
instance equalTypes AType
diff --git a/frontend/type.icl b/frontend/type.icl
index 5d90d97..6574e31 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -1164,7 +1164,7 @@ standardTupleSelectorType pos {ds_index} arg_nr {ti_common_defs} ts
= freshSymbolType (Yes pos) cWithFreshContextVars { cons_type & st_args = [cons_type.st_result], st_result = cons_type.st_args !! arg_nr } ti_common_defs ts
standardRhsConstructorType pos index mod arity {ti_common_defs} ts
- # {cons_ident, cons_type=ct=:{st_vars,st_attr_vars}, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index]
+ # {cons_type=ct=:{st_vars,st_attr_vars}, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index]
(st_vars, st_attr_vars) = foldSt add_vars_and_attr cons_exi_vars (st_vars, st_attr_vars)
cons_type = { ct & st_vars = st_vars, st_attr_vars = st_attr_vars }
(fresh_type, ts) = freshSymbolType (Yes pos) cWithFreshContextVars cons_type ti_common_defs ts
@@ -1178,10 +1178,8 @@ where
= [ avar : attr_variables ]
add_attr_var attr attr_variables
= attr_variables
-
-// ---> ("standardRhsConstructorType", cons_ident, fresh_type)
-standardLhsConstructorType pos index mod arity {ti_common_defs} ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_exis_variables}
+standardLhsConstructorType pos index mod {ti_common_defs} ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_exis_variables}
# {cons_ident, cons_type, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index]
(new_exis_variables, ts_var_store, ts_attr_store, ts_type_heaps) = freshExistentialVariables cons_exi_vars ts_var_store ts_attr_store ts_type_heaps
// -?-> (not (isEmpty cons_exi_vars), ("standardLhsConstructorType", cons_exi_vars, cons_type))
@@ -1665,7 +1663,7 @@ where
# cp = CP_Expression expression
(rhs, ts) = standardRhsConstructorType cp ds_index glob_module ds_arity ti ts
(expression_type, opt_expr_ptr, reqs_ts) = requirements ti expression (reqs, ts)
- (lhs_args, reqs_ts) = determine_record_type cp ds_index glob_module ds_arity ti expression expression_type opt_expr_ptr reqs_ts
+ (lhs_args, reqs_ts) = determine_record_type cp ds_index glob_module ti expression expression_type opt_expr_ptr reqs_ts
(reqs, ts) = requirements_of_fields ti expression expressions rhs.tst_args lhs_args reqs_ts
// ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr lhs_result.at_attribute ts.ts_expr_heap }
// coercion = { tc_demanded = lhs_result, tc_offered = expression_type, tc_position = CP_Expression expression, tc_coercible = True }
@@ -1689,7 +1687,7 @@ where
coercion = { tc_demanded = dem_field_type, tc_offered = expr_type, tc_position = CP_Expression bind_src, tc_coercible = True }
= ({ reqs & req_type_coercions = [ coercion : reqs.req_type_coercions ]}, ts)
- determine_record_type cp cons_index mod_index arity ti (Var var) expression_type opt_expr_ptr (reqs, ts=:{ts_var_heap})
+ determine_record_type cp cons_index mod_index ti (Var var) expression_type opt_expr_ptr (reqs, ts=:{ts_var_heap})
# (type_info, ts_var_heap) = getTypeInfoOfVariable var ts_var_heap
ts = { ts & ts_var_heap = ts_var_heap}
= case type_info of
@@ -1700,12 +1698,12 @@ where
| cons_index==constructor_index && mod_index==module_index
-> (arg_types, (reqs, ts))
_
- -> new_lhs_constructor_type cp cons_index mod_index arity ti expression_type opt_expr_ptr (reqs, ts)
- determine_record_type cp cons_index mod_index arity ti _ expression_type opt_expr_ptr reqs_ts
- = new_lhs_constructor_type cp cons_index mod_index arity ti expression_type opt_expr_ptr reqs_ts
+ -> new_lhs_constructor_type cp cons_index mod_index ti expression_type opt_expr_ptr (reqs, ts)
+ determine_record_type cp cons_index mod_index ti _ expression_type opt_expr_ptr reqs_ts
+ = new_lhs_constructor_type cp cons_index mod_index ti expression_type opt_expr_ptr reqs_ts
- new_lhs_constructor_type cp cons_index mod_index arity ti expression_type opt_expr_ptr (reqs, ts)
- # (lhs, ts) = standardLhsConstructorType cp cons_index mod_index arity ti ts
+ new_lhs_constructor_type cp cons_index mod_index ti expression_type opt_expr_ptr (reqs, ts)
+ # (lhs, ts) = standardLhsConstructorType cp cons_index mod_index ti ts
ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr lhs.tst_result.at_attribute ts.ts_expr_heap }
coercion = { tc_demanded = lhs.tst_result, tc_offered = expression_type, tc_position = cp, tc_coercible = True }
req_type_coercions = [ coercion : reqs.req_type_coercions ]
@@ -1744,7 +1742,7 @@ where
pd_cons_index==PD_UnboxedConsSymbol || pd_cons_index==PD_UnboxedTailStrictConsSymbol || pd_cons_index==PD_OverloadedConsSymbol)
= requirements ti expr reqs_ts
# cp = CP_Expression expr
- ({tst_result,tst_args,tst_attr_env}, ts) = standardLhsConstructorType cp ds_index glob_module ds_arity ti ts
+ ({tst_result,tst_args,tst_attr_env}, ts) = standardLhsConstructorType cp ds_index glob_module ti ts
(e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr (reqs, ts)
reqs = { reqs & req_attr_coercions = tst_attr_env ++ reqs.req_attr_coercions,
req_type_coercions = [{ tc_demanded = tst_result, tc_offered = e_type, tc_position = cp, tc_coercible = True } : reqs.req_type_coercions ] }
@@ -2432,30 +2430,18 @@ where
| not ts.ts_error.ea_ok
= (True, os_predef_symbols, os_special_instances, out, create_erroneous_function_types comp
{ ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_cons_variables = [], ts_exis_variables = [], ts_error = { ts.ts_error & ea_ok = True }})
- | isEmpty over_info
- # ts_type_heaps = ts.ts_type_heaps
- type_code_info = { tci_type_var_heap = ts_type_heaps.th_vars, tci_attr_var_heap = ts_type_heaps.th_attrs,
- tci_dcl_modules = dcl_modules, tci_common_defs = ti_common_defs }
- # (fun_defs, ts_fun_env, ts_expr_heap, {tci_type_var_heap,tci_attr_var_heap}, ts_var_heap, ts_error, os_predef_symbols)
- = updateDynamics comp local_pattern_variables main_dcl_module_n ts.ts_fun_defs ts.ts_fun_env ts.ts_expr_heap type_code_info ts.ts_var_heap ts.ts_error os_predef_symbols
- = ( type_error || not ts_error.ea_ok,
- os_predef_symbols, os_special_instances, out,
- { ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_cons_variables = [], ts_exis_variables = [],
- ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True },
- ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap, th_attrs = tci_attr_var_heap },
- ts_fun_env = ts_fun_env, ts_fun_defs=fun_defs})
- # ts_type_heaps = ts.ts_type_heaps
- type_code_info = { tci_type_var_heap = ts_type_heaps.th_vars, tci_attr_var_heap = ts_type_heaps.th_attrs,
- tci_dcl_modules = dcl_modules, tci_common_defs = ti_common_defs }
- (fun_defs, ts_fun_env, ts_expr_heap, {tci_type_var_heap,tci_attr_var_heap}, ts_var_heap, ts_error, os_predef_symbols)
- = removeOverloadedFunctions comp local_pattern_variables main_dcl_module_n ts.ts_fun_defs ts.ts_fun_env
- ts.ts_expr_heap type_code_info ts.ts_var_heap ts.ts_error os_predef_symbols
- = ( type_error || not ts_error.ea_ok,
- os_predef_symbols, os_special_instances, out,
- { ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_cons_variables = [], ts_exis_variables = [],
- ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True },
- ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap, th_attrs = tci_attr_var_heap },
- ts_fun_env = ts_fun_env, ts_fun_defs=fun_defs})
+ # ts_type_heaps = ts.ts_type_heaps
+ type_code_info = { tci_type_var_heap = ts_type_heaps.th_vars, tci_attr_var_heap = ts_type_heaps.th_attrs,
+ tci_dcl_modules = dcl_modules, tci_common_defs = ti_common_defs }
+ (fun_defs, ts_fun_env, ts_expr_heap, {tci_type_var_heap,tci_attr_var_heap}, ts_var_heap, ts_error, os_predef_symbols)
+ = removeOverloadedFunctions comp local_pattern_variables main_dcl_module_n ts.ts_fun_defs ts.ts_fun_env
+ ts.ts_expr_heap type_code_info ts.ts_var_heap ts.ts_error os_predef_symbols
+ = ( type_error || not ts_error.ea_ok,
+ os_predef_symbols, os_special_instances, out,
+ { ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_cons_variables = [], ts_exis_variables = [],
+ ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True },
+ ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap, th_attrs = tci_attr_var_heap },
+ ts_fun_env = ts_fun_env, ts_fun_defs=fun_defs})
add_unicity_of_essentially_unique_types_for_function ti_common_defs fun (ts_fun_env, coercions)
# (env_type, ts_fun_env) = ts_fun_env![fun]