Commit 696ccff4 authored by Martijn Vervoort's avatar Martijn Vervoort

solved multiple defined moduleIDs in lets

parent 8cc76114
......@@ -226,8 +226,31 @@ where
| isEmpty fun_info.fi_dynamics
= (fun_defs, ci)
# ci
= { ci & ci_used_tcs = [], ci_generated_global_tc_placeholders = False }
# (fun_body, ci) = convert_dynamics_in_body {cinp_st_args = [], cinp_glob_type_inst = global_type_instances, cinp_group_index = group_nr} fun_body fun_type ci
= { ci & ci_used_tcs = [], ci_generated_global_tc_placeholders = False, ci_module_id = No }
# (TransformedBody fun_body=:{tb_rhs}, ci) = convert_dynamics_in_body {cinp_st_args = [], cinp_glob_type_inst = global_type_instances, cinp_group_index = group_nr} fun_body fun_type ci
/*
:: TransformedBody =
{ tb_args :: ![FreeVar]
, tb_rhs :: !Expression
}
# (let_info_ptr, ci) = let_ptr 1 ci
# letje
= Let { let_strict_binds = [],
let_lazy_binds = [let_bind],
let_expr = dyn_type_code,
let_info_ptr = let_info_ptr,
let_expr_position = NoPos
}
*/
# (tb_rhs,ci)
= build_type_identification tb_rhs ci
# fun_body
= TransformedBody {fun_body & tb_rhs = tb_rhs}
// TransformedBody
= ({fun_defs & [fun] = { fun_def & fun_body = fun_body, fun_info = { fun_info & fi_local_vars = ci.ci_new_variables ++ fun_info.fi_local_vars }}},
{ ci & ci_new_variables = [] })
// MV ..
......@@ -418,9 +441,7 @@ where
/* Sjaak ... */
convertDynamics cinp bound_vars default_expr (DynamicExpr {dyn_expr, dyn_info_ptr, dyn_type_code}) ci=:{ci_symb_ident}
# (dyn_expr, ci) = convertDynamics cinp bound_vars default_expr dyn_expr ci
(_,dyn_type_code, _, _, ci) = convertTypecode2 cinp dyn_type_code False [] [] {ci & ci_module_id = No}
# (dyn_type_code,ci)
= build_type_identification dyn_type_code ci
(_,dyn_type_code, _, _, ci) = convertTypecode2 cinp dyn_type_code False [] [] ci
= (App { app_symb = ci_symb_ident,
app_args = [dyn_expr, dyn_type_code],
app_info_ptr = nilPtr }, ci)
......@@ -861,9 +882,7 @@ where
/*** convert the elements of this pattern ***/
(a_ij_binds, ci) = createVariables dp_type_patterns_vars [] ci
(generate_coerce,type_code,_,martijn, ci) = convertTypecode2 cinp dp_type_code True /* should be changed to True for type dependent functions */ /* WAS: a_ij_binds*/ [] [] {ci & ci_module_id = No} // ci
# (type_code,ci)
= build_type_identification type_code ci
(generate_coerce,type_code,_,martijn, ci) = convertTypecode2 cinp dp_type_code True /* should be changed to True for type dependent functions */ /* WAS: a_ij_binds*/ [] [] ci //{ci & ci_module_id = No} // ci
// collect ...
# (is_last_dynamic_pattern,dp_rhs)
......@@ -928,27 +947,6 @@ where
// sel_type = Selection No (Var unify_result_var) [RecordSelection type_defined_symbol sd_type_field_nr]
/*
// TIJDELIJK...
# (ci=:{ci_predef_symb})
= ci;
# ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![PD_ModuleConsSymbol]
# pds_ident = predefined_idents.[PD_ModuleConsSymbol]
# module_symb1 = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} }
# ci
= { ci & ci_predef_symb = ci_predef_symb };
# module_symb =
{ app_symb = module_symb1
, app_args = []
, app_info_ptr = nilPtr
}
# module_symb =
App module_symb
// ...TIJDELIJK
*/
/* Sjaak ... */
(let_info_ptr, ci) = let_ptr (2 + length let_binds) ci
(case_info_ptr, ci) = bool_case_ptr ci
......
......@@ -1015,8 +1015,11 @@ where
# (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_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}})
// MV (WAS) ...
// (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, x_predef_symbols = predef_symbols}})
// ... (WAS) MV
(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,
......@@ -1025,9 +1028,30 @@ where
// ... MV
// WAS: ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n}}
// MV ...
# (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, x_predef_symbols = predef_symbols}})
= build_type_identification tb_rhs ui
// ... MV
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
// MV ...
build_type_identification dyn_type_code ui=:{ui_x={x_module_id=No}}
= (dyn_type_code,ui)
build_type_identification dyn_type_code ui=:{ui_x={x_module_id=Yes let_bind}}
# (let_info_ptr, ui) = let_ptr ui
# letje
= Let { let_strict_binds = [],
let_lazy_binds = [let_bind],
let_expr = dyn_type_code,
let_info_ptr = let_info_ptr,
let_expr_position = NoPos
}
= (letje,ui)
// ... MV
removeOverloadedFunctions :: ![Index] ![LocalTypePatternVariable] !Int !*{#FunDef} !*{! FunctionType} !*ExpressionHeap
!*TypeCodeInfo !*VarHeap !*ErrorAdmin !*{#PredefinedSymbol}
......@@ -1052,11 +1076,16 @@ 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_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,
// MV ...
ui_x = {x_type_code_info=type_code_info, x_predef_symbols=predef_symbols,x_main_dcl_module_n=main_dcl_module_n,x_internal_type_id = module_id_app,x_module_id = No}}
# (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}})
= build_type_identification tb_rhs ui
#
// ... MV
(tb_args, var_heap) = foldSt retrieve_class_argument rev_variables (tb_args, ui_var_heap)
fun_def = { fun_def & fun_body = TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}, fun_arity = length tb_args,
......@@ -1505,6 +1534,8 @@ where
updateExpression group_index l ui
= mapSt (updateExpression group_index) l ui
import RWSDebug
adjustClassExpressions symb_name exprs tail_exprs ui
= mapAppendSt (adjustClassExpression symb_name) exprs tail_exprs ui
where
......@@ -1518,29 +1549,8 @@ where
# (expr, ui) = adjustClassExpression symb_name expr ui
= (Selection opt_type expr selectors, ui)
adjustClassExpression symb_name (TypeCodeExpression type_code_expression) ui
// MV ...
# (type_code,ui)
= convertTypecode type_code_expression ui
= build_type_identification type_code ui
// ... MV
= convertTypecode type_code_expression ui
where
// MV ...
// identification of types generated by the compiler. If there is no TypeConsSymbol, then
// no identification is necessary.
build_type_identification dyn_type_code ui=:{ui_x={x_module_id=No}}
= (dyn_type_code,ui)
build_type_identification dyn_type_code ui=:{ui_x={x_module_id=Yes let_bind}}
# (let_info_ptr, ui) = let_ptr ui
# letje
= Let { let_strict_binds = [],
let_lazy_binds = [let_bind],
let_expr = dyn_type_code,
let_info_ptr = let_info_ptr,
let_expr_position = NoPos
}
= (letje,ui)
// ... MV
convertTypecode TCE_Empty ui
= (EE, ui)
convertTypecode (TCE_Var var_info_ptr) ui
......@@ -1663,16 +1673,17 @@ where
varToFreeVar {var_name, var_info_ptr} count
= {fv_def_level = NotALevel, fv_name = var_name, fv_info_ptr = var_info_ptr, fv_count = count}
let_ptr ui=:{ui_symbol_heap}
# (expr_info_ptr, ui_symbol_heap) = newPtr (EI_LetType (repeat 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_annotation = AN_None, at_type = TE }
adjustClassExpression symb_name expr ui
= (expr, ui)
let_ptr ui=:{ui_symbol_heap}
# (expr_info_ptr, ui_symbol_heap) = newPtr (EI_LetType (repeat 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_annotation = AN_None, at_type = TE }
class equalTypes a :: !a !a !*TypeVarHeap -> (!Bool, !*TypeVarHeap)
instance equalTypes AType
......
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