diff options
Diffstat (limited to 'frontend/check.icl')
| -rw-r--r-- | frontend/check.icl | 22 |
1 files changed, 8 insertions, 14 deletions
diff --git a/frontend/check.icl b/frontend/check.icl index e48a2e8..ff9db8a 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -614,22 +614,16 @@ instantiateTypes old_type_vars old_attr_vars types type_contexts attr_env {ss_en (new_attr_vars, th_attrs) = foldSt build_attr_var_subst ss_attrs ([], th_attrs) type_heaps = foldSt build_type_subst ss_environ { type_heaps & th_vars = th_vars, th_attrs = th_attrs } - (ok1, new_ss_context, type_heaps) = substitute ss_context type_heaps + (new_ss_context, type_heaps) = substitute ss_context type_heaps (inst_vars, th_vars) = foldSt determine_free_var old_type_vars (new_type_vars, type_heaps.th_vars) (inst_attr_vars, th_attrs) = foldSt build_attr_var_subst old_attr_vars (new_attr_vars, type_heaps.th_attrs) (inst_types, (ok2, type_heaps)) = mapSt substitue_arg_type types (True, { type_heaps & th_vars = th_vars, th_attrs = th_attrs }) // (ok2, inst_types, type_heaps) = substitute types { type_heaps & th_vars = th_vars, th_attrs = th_attrs } - (ok3, inst_contexts, type_heaps) = substitute type_contexts type_heaps - (ok4, inst_attr_env, type_heaps) = substitute attr_env type_heaps + (inst_contexts, type_heaps) = substitute type_contexts type_heaps + (inst_attr_env, type_heaps) = substitute attr_env type_heaps (special_subst_list, th_vars) = mapSt adjust_special_subst special_subst_list type_heaps.th_vars - error = case ok1 && ok2 && ok3 && ok4 of - True - -> error - False - -> checkError "instance type incompatible with class type" "" error - = (inst_vars, inst_attr_vars, inst_types, new_ss_context ++ inst_contexts, inst_attr_env, special_subst_list, { type_heaps & th_vars = th_vars }, error) where clear_vars type_vars type_var_heap = foldSt (\tv -> writePtr tv.tv_info_ptr TVI_Empty) type_vars type_var_heap @@ -643,7 +637,7 @@ where -> (free_vars, type_var_heap) build_type_subst {bind_src,bind_dst} type_heaps - # (_, bind_src, type_heaps) = substitute bind_src type_heaps + # (bind_src, type_heaps) = substitute bind_src type_heaps // RWS ... /* FIXME: this is a patch for the following incorrect function type (in a dcl module) @@ -664,11 +658,11 @@ where substitue_arg_type at=:{at_type = TFA type_vars type} (was_ok, type_heaps) # (fresh_type_vars, type_heaps) = foldSt build_avar_subst type_vars ([], type_heaps) - (ok, new_at, type_heaps) = substitute {at & at_type = type} type_heaps - = ({ new_at & at_type = TFA fresh_type_vars new_at.at_type}, (was_ok && ok, type_heaps)) + (new_at, type_heaps) = substitute {at & at_type = type} type_heaps + = ({ new_at & at_type = TFA fresh_type_vars new_at.at_type}, (was_ok, type_heaps)) substitue_arg_type type (was_ok, type_heaps) - # (ok, type, type_heaps) = substitute type type_heaps - = (type, (was_ok && ok, type_heaps)) + # (type, type_heaps) = substitute type type_heaps + = (type, (was_ok, type_heaps)) build_var_subst var (free_vars, type_var_heap) # (new_info_ptr, type_var_heap) = newPtr TVI_Empty type_var_heap |