Commit 8275a77f authored by Sjaak Smetsers's avatar Sjaak Smetsers
Browse files

improvement of error messages during type checking

parent ae6b5170
......@@ -95,21 +95,25 @@ where
= Equal
instanceError symbol types err=:{ea_file,ea_loc}
# ea_file = ea_file <<< "Overloading error " <<< hd ea_loc <<< ": \"" <<< symbol <<< "\" no instance available of type " <<< types <<< '\n'
= { err & ea_file = ea_file, ea_ok = False}
contextError err=:{ea_file,ea_loc}
# ea_file = ea_file <<< "Overloading Error " <<< hd ea_loc <<< ": specified context is too general\n"
= { err & ea_file = ea_file, ea_ok = False}
uniqueError symbol types err=:{ea_file, ea_loc}
# ea_file = ea_file <<< "Overloading/Uniqueness Error " <<< hd ea_loc <<< ": \"" <<< symbol <<< "\" uniqueness specification of instance conflicts with current application " <<< types <<< '\n'
= { err & ea_file = ea_file, ea_ok = False}
unboxError type err=:{ea_file,ea_loc}
# ea_file = ea_file <<< "Overloading error " <<< hd ea_loc <<< ": instance cannot be unboxed" <<< type <<< '\n'
= { err & ea_file = ea_file, ea_ok = False}
instanceError symbol types err
# err = errorHeading "Overloading error" err
format = { form_properties = cNoProperties, form_position = [] }
= { err & ea_file = err.ea_file <<< " \"" <<< symbol <<< "\" no instance available of type " <:: (format, types) <<< '\n' }
contextError err
# err = errorHeading "Overloading error" err
= { err & ea_file = err.ea_file <<< " specified context is too general\n"}
uniqueError symbol types err
# err = errorHeading "Overloading/Uniqueness error" err
format = { form_properties = cAnnotated, form_position = [] }
= { err & ea_file = err.ea_file <<< " \"" <<< symbol
<<< "\" uniqueness specification of instance conflicts with current application " <:: (format, types) <<< '\n'}
unboxError type err
# err = errorHeading "Overloading error of Array class" err
format = { form_properties = cNoProperties, form_position = [] }
= { err & ea_file = err.ea_file <<< ' ' <:: (format, type) <<< " instance cannot be unboxed\n"}
get :: !a !(Env a b) -> b | == a
get elem_id []
......
......@@ -1122,7 +1122,7 @@ instance == ModuleKind, Ident
instance <<< Module a | <<< a, ParsedDefinition, InstanceType, AttributeVar, TypeVar, SymbolType, Expression, Type, Ident, Global object | <<< object,
Position, CaseAlt, AType, FunDef, ParsedExpr, TypeAttribute, Bind a b | <<< a & <<< b, ParsedConstructor, TypeDef a | <<< a, TypeVarInfo,
BasicValue, ATypeVar, TypeRhs, FunctionPattern, (Import from_symbol) | <<< from_symbol, ImportDeclaration, ImportedIdent, CasePatterns,
Optional a | <<< a
Optional a | <<< a, ConsVariable, BasicType, Annotation
instance == TypeAttribute
instance == Annotation
......
......@@ -161,9 +161,11 @@ where
contains_var var_id _
= False
cannotUnify t1 t2 position err=:{ea_file,ea_loc}
# ea_file = ea_file <<< hd ea_loc <<< ": cannot unify " <<< t1 <<< " with " <<< t2 <<< " near " <<< position <<< '\n'
= { err & ea_file = ea_file, ea_ok = False}
cannotUnify t1 t2 position err
# err = errorHeading "Type error" err
format = { form_properties = cNoProperties, form_position = [] }
= { err & ea_file = err.ea_file <<< " cannot unify " <:: (format, t1) <<< " with " <:: (format, t2) <<< " near " <<< position <<< '\n' }
/*
simplifyType ta=:(type :@: type_args)
......@@ -572,9 +574,9 @@ freshAttribute ts=:{ts_attr_store}
, prop_error :: !.ErrorAdmin
}
attribute_error type_attr err
= TypeError "* attribute expected insted of" type_attr "" err
# err = errorHeading "Type error" err
= { err & ea_file = err.ea_file <<< "* attribute expected instead of " <<< type_attr <<< '\n' }
addPropagationAttributesToAType modules type=:{at_type = TA cons_id=:{type_index={glob_object,glob_module}} cons_args, at_attribute} ps
# (cons_args, props, ps=:{prop_td_infos,prop_type_heaps,prop_attr_vars,prop_attr_env,prop_error})
......@@ -1287,7 +1289,9 @@ where
specification_error type err
= TypeError "specified type conflicts with derived type" type "" err
# err = errorHeading "Type error" err
format = { form_properties = cAttributed, form_position = []}
= { err & ea_file = err.ea_file <<< " specified type conflicts with derived type " <:: (format, type) <<< '\n' }
cleanUpAndCheckFunctionTypes [] defs type_contexts coercion_env attr_partition type_var_env attr_var_env fun_defs ts
= (fun_defs, ts)
......
......@@ -4,7 +4,20 @@ import checksupport, StdCompare
from unitype import Coercions, CoercionTree, AttributePartition
TypeError :: !String !mess !String !*ErrorAdmin -> *ErrorAdmin | <<< mess
errorHeading :: !String !*ErrorAdmin -> *ErrorAdmin
class (<::) infixl a :: !*File (!Format, !a) -> *File
:: Format =
{ form_properties :: !BITVECT
, form_position :: ![Int]
}
cNoProperties :== 0
cAttributed :== 4
cAnnotated :== 8
instance <:: SymbolType, Type, AType, [a] | <:: a
:: AttributeEnv :== {! TypeAttribute }
:: VarEnv :== {! Type }
......
......@@ -179,23 +179,23 @@ where
# (ok, (t,ts), env) = cleanUpClosed (t,ts) env
= (ok, [t:ts], env)
TypeError :: !String !mess !String !*ErrorAdmin -> *ErrorAdmin | <<< mess
TypeError err_pref err_msg err_post err=:{ea_file,ea_loc}
| isEmpty ea_loc
# ea_file = ea_file <<< "Type error: " <<< err_pref <<< ' ' <<< err_msg <<< ' ' <<< err_post <<< '\n'
= { err & ea_file = ea_file, ea_ok = False}
# ea_file = ea_file <<< "Type error " <<< hd ea_loc <<< ": " <<< err_pref <<< ' ' <<< err_msg <<< ' ' <<< err_post <<< '\n'
= { err & ea_file = ea_file, ea_ok = False}
errorHeading :: !String !*ErrorAdmin -> *ErrorAdmin
errorHeading error_kind err=:{ea_file,ea_loc = []}
= { err & ea_file = ea_file <<< error_kind <<< ':', ea_ok = False }
errorHeading error_kind err=:{ea_file,ea_loc = [ loc : _ ]}
= { err & ea_file = ea_file <<< error_kind <<< ' ' <<< loc <<< ':', ea_ok = False }
overloadingError class_symb err
= TypeError "internal overloading of class" class_symb "is unsolvable" err
# err = errorHeading "Type error" err
= { err & ea_file = err.ea_file <<< "internal overloading of class " <<< class_symb <<< " is unsolvable\n" }
existentialError err
= TypeError "existential" "type variable" "appears in the derived type specification" err
# err = errorHeading "Type error" err
= { err & ea_file = err.ea_file <<< "existential type variable appears in the derived type specification\n" }
liftedError var err
= TypeError "type variable of type of lifted argument" var "appears in the specified type" err
# err = errorHeading "Type error" err
= { err & ea_file = err.ea_file <<< "type variable of type of lifted argument " <<< var <<< " appears in the specified type\n" }
clean_up_type_contexts [] env error
= ([], env, error)
......@@ -738,6 +738,134 @@ where
= (True, attr_env)
= contains_coercion offered next_offered attr_env
:: Format =
{ form_properties :: !BITVECT
, form_position :: ![Int]
}
cNoProperties :== 0
cCommaSeperator :== 1
cBrackets :== 2
cAttributed :== 4
cAnnotated :== 8
checkProperty form property :== not (form.form_properties bitand property == 0)
setProperty form property :== {form & form_properties = form.form_properties bitor property}
clearProperty form property :== {form & form_properties = form.form_properties bitand (bitnot property)}
class (<::) infixl a :: !*File (!Format, !a) -> *File
instance <:: SymbolType
where
(<::) file (form, {st_args, st_arity, st_result, st_context, st_attr_env})
| st_arity > 0
= show_environment form (show_context form (file <:: (form, st_args) <<< " -> " <:: (form, st_result)) st_context) st_attr_env
= show_environment form ((show_context form (file <:: (form, st_result))) st_context) st_attr_env
where
show_context form file []
= file
show_context form file contexts
= file <<< " | " <:: (setProperty form cCommaSeperator, contexts)
show_environment form file []
= file
show_environment form file environ
= file <<< ", " <:: (setProperty form cCommaSeperator, environ)
instance <:: TypeContext
where
(<::) file (form, {tc_class={glob_object={ds_ident}}, tc_types})
= file <<< ds_ident <<< ' ' <:: (form, tc_types)
instance <:: AttrInequality
where
(<::) file (form, {ai_demanded, ai_offered})
= file <<< ai_offered <<< " <= " <<< ai_demanded
instance <:: AType
where
(<::) file (form, {at_attribute, at_annotation, at_type})
| checkProperty form cAnnotated
= show_attributed_type (file <<< at_annotation) form at_attribute at_type
= show_attributed_type file form at_attribute at_type
where
show_attributed_type file form TA_Multi type
= file <:: (form, type)
show_attributed_type file form attr type
| checkProperty form cAttributed
= file <<< attr <:: (setProperty form cBrackets, type)
= file <:: (form, type)
instance <:: Type
where
(<::) file (form, TV varid)
= file <<< varid
(<::) file (form, TempV tv_number)
= file <<< 'v' <<< tv_number
(<::) file (form, TA {type_name,type_index,type_arity} types)
| is_predefined type_index
| is_list type_name
= file <<< '[' <:: (setProperty form cCommaSeperator, types) <<< ']'
| is_lazy_array type_name
= file <<< '{' <:: (setProperty form cCommaSeperator, types) <<< '}'
| is_strict_array type_name
= file <<< "{!" <:: (setProperty form cCommaSeperator, types) <<< '}'
| is_unboxed_array type_name
= file <<< "{#" <:: (setProperty form cCommaSeperator, types) <<< '}'
| is_tuple type_name type_arity
= file <<< '(' <:: (setProperty form cCommaSeperator, types) <<< ')'
| checkProperty form cBrackets && type_arity > 0
= file <<< '(' <<< type_name <<< ' ' <:: (form, types) <<< ')'
= file <<< type_name <<< ' ' <:: (setProperty form cBrackets, types)
| checkProperty form cBrackets && type_arity > 0
= file <<< '(' <<< type_name <<< ' ' <:: (form, types) <<< ')'
= file <<< type_name <<< ' ' <:: (setProperty form cBrackets, types)
where
is_predefined {glob_module} = glob_module == cPredefinedModuleIndex
is_list {id_name} = id_name == "_list"
is_tuple {id_name} tup_arity = id_name == "_tuple" +++ toString tup_arity
is_lazy_array {id_name} = id_name == "_array"
is_strict_array {id_name} = id_name == "_!array"
is_unboxed_array {id_name} = id_name == "_#array"
(<::) file (form, arg_type --> res_type)
| checkProperty form cBrackets
= file <<< '(' <:: (form, arg_type) <<< " -> " <:: (form, res_type) <<< ')'
= file <:: (setProperty form cBrackets, arg_type) <<< " -> " <:: (setProperty form cBrackets, res_type)
(<::) file (form, type :@: types)
| checkProperty form cBrackets
= file <<< '(' <<< type <<< ' ' <:: (form, types) <<< ')'
= file <<< type <<< ' ' <:: (setProperty form cBrackets, types)
(<::) file (form, TB tb)
= file <<< tb
(<::) file (form, TQV varid)
= file <<< "E." <<< varid
(<::) file (form, TempQV tv_number)
= file <<< "E." <<< tv_number <<< ' '
(<::) file (form, TE)
= file <<< "__"
instance <:: [a] | <:: a
where
(<::) file (form, [type])
| checkProperty form cCommaSeperator
= file <:: (clearProperty form cCommaSeperator, type)
= file <:: (setProperty form cBrackets, type)
(<::) file (form, [type : types])
| checkProperty form cCommaSeperator
= file <:: (clearProperty form cCommaSeperator, type) <<< ',' <:: (form, types)
= file <:: (setProperty form cBrackets, type) <<< ' ' <:: (form, types)
(<::) file (form, [])
= file
from compare_constructor import equal_constructor
instance == Format
where
(==) form1 form2 = equal_constructor form1 form2
instance <<< TypeContext
where
(<<<) file tc = file <<< tc.tc_class.glob_object.ds_ident <<< ' ' <<< tc.tc_types
......
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