From f7634fa28a9c1c1dc450c50f7d69caf515e44058 Mon Sep 17 00:00:00 2001
From: sjakie
Date: Wed, 17 Nov 1999 10:42:41 +0000
Subject: bug fix: no crash after detecting an overloading error
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@55 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
frontend/overloading.icl | 32 +++++---------------------------
1 file changed, 5 insertions(+), 27 deletions(-)
(limited to 'frontend')
diff --git a/frontend/overloading.icl b/frontend/overloading.icl
index d65d436..d0e1417 100644
--- a/frontend/overloading.icl
+++ b/frontend/overloading.icl
@@ -100,9 +100,9 @@ instanceError symbol types err
format = { form_properties = cNoProperties, form_attr_position = No }
= { err & ea_file = err.ea_file <<< " \"" <<< symbol <<< "\" no instance available of type " <:: (format, types) <<< '\n' }
-contextError err
+contextError {tc_class={glob_object={ds_ident}}} err
# err = errorHeading "Overloading error" err
- = { err & ea_file = err.ea_file <<< " specified context is too general\n"}
+ = { err & ea_file = err.ea_file <<< " unresolved class \"" <<< ds_ident <<< "\" not occurring in specified type\n"}
uniqueError symbol types err
# err = errorHeading "Overloading/Uniqueness error" err
@@ -692,9 +692,9 @@ where
createBoundVar :: !TypeContext -> BoundVar
createBoundVar {tc_class={glob_object={ds_ident}}, tc_var}
- | isNilPtr tc_var
+/* | isNilPtr tc_var
= abort ("createBoundVar : NIL ptr" ---> ds_ident)
- = { var_name = { id_name = "_v" +++ ds_ident.id_name, id_info = nilPtr }, var_info_ptr = tc_var, var_expr_ptr = nilPtr }
+*/ = { var_name = { id_name = "_v" +++ ds_ident.id_name, id_info = nilPtr }, var_info_ptr = tc_var, var_expr_ptr = nilPtr }
createFreeVar :: !TypeContext -> FreeVar
createFreeVar {tc_class={glob_object={ds_ident}}, tc_var}
@@ -712,7 +712,7 @@ where
-> (!TypeContext, ![(Int, Global DefinedSymbol)], ![TypeContext], !*TypeHeaps, !*VarHeap, !*ErrorAdmin)
determine_context_and_address context [] has_context contexts defs type_heaps var_heap error
| has_context
- = (context, [], contexts, type_heaps, var_heap, contextError error)
+ = (context, [], contexts, type_heaps, var_heap, contextError context error)
#! (new_info_ptr, var_heap) = newPtr VI_Empty var_heap
# new_context = { context & tc_var = new_info_ptr}
= (new_context, [], [new_context : contexts], type_heaps, var_heap, error)
@@ -802,28 +802,6 @@ where
determine_class_arguments No type_contexts tb_args
= mapAppend (\tc -> createFreeVar tc) type_contexts tb_args
-/*
- type_contexts fun_symb fun_info_ptr tb_args symbol_heap error
- #! fun_info = sreadPtr fun_info_ptr symbol_heap
- = case fun_info of
- EI_Empty
- -> (mapAppend (\tc -> createFreeVar tc) type_contexts tb_args, symbol_heap, error)
- EI_Context class_expressions
- # (tb_args, error) = convert_class_expressions fun_symb class_expressions tb_args error
- -> (tb_args, symbol_heap, error)
- _
-// -> (tb_args, symbol_heap, contextError fun_symb error)
- -> (tb_args, symbol_heap, contextError error)
-
- convert_class_expressions fun_symb [] tb_args error
- = (tb_args, error)
- convert_class_expressions fun_symb [Var {var_name,var_info_ptr} : class_exprs] tb_args error
- # (tb_args, error) = convert_class_expressions fun_symb class_exprs tb_args error
- = ([ { fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = -1 } : tb_args], error)
- convert_class_expressions fun_symb [class_expr : class_exprs] tb_args error
-// = (tb_args, contextError fun_symb error)
- = (tb_args, contextError error)
-*/
convertDynamicTypes dyn_ptrs update_info
= foldSt update_dynamic dyn_ptrs update_info
where
--
cgit v1.2.3