Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-compiler-and-rts
compiler
Commits
45b9b703
Commit
45b9b703
authored
Apr 20, 2001
by
Martin Wierich
Browse files
pepping up error messages
parent
d79ab730
Changes
3
Hide whitespace changes
Inline
Side-by-side
frontend/check.icl
View file @
45b9b703
...
...
@@ -374,7 +374,7 @@ where
=
check_member_instances
module_index
member_mod_index
(
inc
mem_offset
)
class_size
ins_members
class_members
class_name
ins_pos
ins_type
instance_types
member_defs
type_defs
modules
var_heap
type_heaps
{
cs
&
cs_error
=
checkError
class_member
.
ds_ident
"used with wrong arity"
cs
.
cs_error
}
#
({
me_type
,
me_class_vars
},
member_defs
,
modules
)
=
getMemberDef
member_mod_index
class_member
.
ds_index
module_index
member_defs
modules
#
({
me_type
,
me_class_vars
,
me_pos
},
member_defs
,
modules
)
=
getMemberDef
member_mod_index
class_member
.
ds_index
module_index
member_defs
modules
(
instance_type
,
_,
type_heaps
,
Yes
cs_error
)
=
determineTypeOfMemberInstance
me_type
me_class_vars
ins_type
SP_None
type_heaps
(
Yes
cs
.
cs_error
)
(
type_defs
,
modules
,
cs_error
)
=
checkTopLevelKinds
x_main_dcl_module_n
True
ins_pos
class_name
instance_type
type_defs
modules
cs_error
(
st_context
,
var_heap
)
=
initializeContextVariables
instance_type
.
st_context
var_heap
...
...
@@ -432,7 +432,7 @@ instantiateTypes old_type_vars old_attr_vars types type_contexts attr_env {ss_en
_
->
case
opt_error
of
No
->
No
Yes
error_admin
->
Yes
(
checkError
""
"instance type incompatible with class type"
->
Yes
(
checkError
"instance type incompatible with class type"
""
error_admin
)
// e.g.:class c a :: (a Int); instance c Real
=
(
inst_vars
,
inst_attr_vars
,
inst_types
,
inst_contexts
++
new_ss_context
,
inst_attr_env
,
special_subst_list
,
{
type_heaps
&
th_vars
=
th_vars
},
opt_error
)
...
...
@@ -489,7 +489,7 @@ determineTypeOfMemberInstance mem_st class_vars {it_types,it_vars,it_attr_vars,i
ss_context
=
it_context
,
ss_vars
=
it_vars
,
ss_attrs
=
it_attr_vars
}
(
st
,
specials
,
type_heaps
,
opt_error
)
=
determine_type_of_member_instance
mem_st
env
specials
type_heaps
opt_error
=
(
st
,
specials
,
type_heaps
,
opt_error
)
=
(
st
,
specials
,
type_heaps
,
opt_error
)
where
determine_type_of_member_instance
mem_st
=:{
st_context
}
env
(
SP_Substitutions
substs
)
type_heaps
opt_error
#
(
mem_st
,
substs
,
type_heaps
,
opt_error
)
...
...
@@ -603,7 +603,7 @@ checkTopLevelKinds x_main_dcl_module_n is_icl_module ins_pos class_ident st=:{st
#
cs_error
=
pushErrorAdmin
(
newPosition
class_ident
ins_pos
)
cs_error
cs_error
=
checkError
""
"instance types have wrong kind"
cs_error
=
checkError
"instance types have wrong kind"
""
cs_error
->
popErrorAdmin
cs_error
=
(
type_defs
,
modules
,
cs_error
)
where
...
...
@@ -983,13 +983,13 @@ where
=
add_macro_declaration
id_info
entry
decl
def_index
(
decl_index
-
first_macro_index
)
decl_index
(
conversion_table
,
icl_defs
,
cs_symbol_table
)
=
([
decl
:
moved_dcl_defs
],
conversion_table
,
icl_sizes
,
icl_defs
,
{
cs
&
cs_symbol_table
=
cs_symbol_table
})
#
cs_error
=
checkError
"definition module"
"undefined in implementation module"
(
setErrorAdmin
(
newPosition
decl_ident
decl_pos
)
cs
.
cs_error
)
#
cs_error
=
checkError
"undefined in implementation module"
""
(
setErrorAdmin
(
newPosition
decl_ident
decl_pos
)
cs
.
cs_error
)
=
(
moved_dcl_defs
,
conversion_table
,
icl_sizes
,
icl_defs
,
{
cs
&
cs_error
=
cs_error
,
cs_symbol_table
=
cs_symbol_table
})
|
ste_def_level
==
cGlobalScope
&&
ste_kind
==
decl_kind
#
def_index
=
toInt
decl_kind
decl_index
=
if
(
def_index
==
cMacroDefs
)
(
decl_index
-
first_macro_index
)
decl_index
=
(
moved_dcl_defs
,
{
conversion_table
&
[
def_index
].[
decl_index
]
=
ste_index
},
icl_sizes
,
icl_defs
,
{
cs
&
cs_symbol_table
=
cs_symbol_table
})
#
cs_error
=
checkError
"definition module"
"conflicting definition in implementation module"
#
cs_error
=
checkError
"conflicting definition in implementation module"
""
(
setErrorAdmin
(
newPosition
decl_ident
decl_pos
)
cs
.
cs_error
)
=
(
moved_dcl_defs
,
conversion_table
,
icl_sizes
,
icl_defs
,
{
cs
&
cs_error
=
cs_error
,
cs_symbol_table
=
cs_symbol_table
})
...
...
@@ -1030,7 +1030,7 @@ where
(
rt_fields
,
cs
)
=
redirect_field_symbols
td_pos
rt_fields
cs
=
([
{
td
&
td_rhs
=
RecordType
{
rt
&
rt_constructor
=
rt_constructor
,
rt_fields
=
rt_fields
}}
:
new_type_defs
],
cs
)
add_type_def
td
=:{
td_name
,
td_pos
,
td_rhs
=
AbstractType
_}
new_type_defs
cs
#
cs_error
=
checkError
"definition module"
"abstract type not defined in implementation module"
#
cs_error
=
checkError
"abstract type not defined in implementation module"
""
(
setErrorAdmin
(
newPosition
td_name
td_pos
)
cs
.
cs_error
)
=
(
new_type_defs
,
{
cs
&
cs_error
=
cs_error
})
add_type_def
td
new_type_defs
cs
...
...
@@ -1045,7 +1045,7 @@ where
({
ste_kind
,
ste_index
},
cs_symbol_table
)
=
readPtr
field
.
fs_name
.
id_info
cs
.
cs_symbol_table
|
is_field
ste_kind
=
({
new_fields
&
[
field_nr
]
=
{
field
&
fs_index
=
ste_index
}},
{
cs
&
cs_symbol_table
=
cs_symbol_table
})
#
cs_error
=
checkError
"definition module"
"conflicting definition in implementation module"
#
cs_error
=
checkError
"conflicting definition in implementation module"
""
(
setErrorAdmin
(
newPosition
field
.
fs_name
pos
)
cs
.
cs_error
)
=
(
new_fields
,
{
cs
&
cs_error
=
cs_error
,
cs_symbol_table
=
cs_symbol_table
})
...
...
@@ -1086,7 +1086,7 @@ where
#
({
ste_kind
,
ste_index
},
cs_symbol_table
)
=
readPtr
ds_ident
.
id_info
cs
.
cs_symbol_table
|
ste_kind
==
req_kind
=
({
ds
&
ds_index
=
ste_index
},
{
cs
&
cs_symbol_table
=
cs_symbol_table
})
#
cs_error
=
checkError
"definition module"
"conflicting definition in implementation module"
#
cs_error
=
checkError
"conflicting definition in implementation module"
""
(
setErrorAdmin
(
newPosition
ds_ident
pos
)
cs
.
cs_error
)
=
({
ds
&
ds_index
=
ste_index
},
{
cs
&
cs_error
=
cs_error
,
cs_symbol_table
=
cs_symbol_table
})
...
...
@@ -1289,8 +1289,8 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices
cs_error
=
pushErrorAdmin
ident_pos
cs_error
cs_error
=
checkError
""
"cyclic module dependencies not allowed in conjunction with Clean 1.3 import syntax"
=
checkError
"cyclic module dependencies not allowed in conjunction with Clean 1.3 import syntax"
""
cs_error
->
popErrorAdmin
cs_error
_
...
...
@@ -1730,7 +1730,14 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
(
icl_functions
,
e_info
,
heaps
,
{
cs_symbol_table
,
cs_predef_symbols
,
cs_error
,
cs_x
})
=
checkInstanceBodies
icl_instance_range
icl_functions
e_info
heaps
cs
(
icl_functions
,
hp_type_heaps
,
cs_error
)
=
// foldSt checkSpecifiedInstanceType instance_types
(
icl_functions
,
heaps
.
hp_type_heaps
,
cs_error
)
heaps
=
{
heaps
&
hp_type_heaps
=
hp_type_heaps
}
cs_symbol_table
=
removeDeclarationsFromSymbolTable
local_defs
cGlobalScope
cs_symbol_table
cs_symbol_table
...
...
@@ -1947,6 +1954,29 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
=
memcpy
com_type_defs
=
(
com_type_defs`
,
{
icl_common
&
com_type_defs
=
com_type_defs
})
checkSpecifiedInstanceType
(
index_of_member_fun
,
derived_symbol_type
)
(
icl_functions
,
type_heaps
,
cs_error
)
#
({
fun_type
,
fun_pos
,
fun_symb
},
icl_functions
)
=
icl_functions
![
index_of_member_fun
]
(
cs_error
,
type_heaps
)
=
case
fun_type
of
No
->
(
cs_error
,
type_heaps
)
Yes
specified_symbol_type
#
(
symbol_types_correspond
,
type_heaps
)
=
symbolTypesCorrespond
specified_symbol_type
derived_symbol_type
type_heaps
|
symbol_types_correspond
->
(
cs_error
,
type_heaps
)
#
cs_error
=
pushErrorAdmin
(
newPosition
fun_symb
fun_pos
)
cs_error
cs_error
=
checkError
"the specified member type is incorrect"
""
cs_error
->
(
popErrorAdmin
cs_error
,
type_heaps
)
=
(
icl_functions
,
type_heaps
,
cs_error
)
check_needed_modules_are_imported
mod_name
extension
cs
=:{
cs_x
={
x_needed_modules
}}
//AA..
#
cs
=
case
x_needed_modules
bitand
cNeedStdGeneric
of
...
...
frontend/checksupport.icl
View file @
45b9b703
...
...
@@ -162,15 +162,15 @@ newPosition id NoPos
checkError
::
!
a
!
b
!*
ErrorAdmin
->
*
ErrorAdmin
|
<<<
a
&
<<<
b
// PK
checkError
id
mess
error
=:{
ea_file
,
ea_loc
=[]}
=
{
error
&
ea_file
=
ea_file
<<<
"Error "
<<<
"
\"
"
<<<
id
<<<
"
\"
"
<<<
mess
<<<
'\n'
,
ea_ok
=
False
}
=
{
error
&
ea_file
=
ea_file
<<<
"Error "
<<<
"
"
<<<
id
<<<
" "
<<<
mess
<<<
'\n'
,
ea_ok
=
False
}
checkError
id
mess
error
=:{
ea_file
,
ea_loc
}
=
{
error
&
ea_file
=
ea_file
<<<
"Error "
<<<
hd
ea_loc
<<<
":
\"
"
<<<
id
<<<
"
\"
"
<<<
mess
<<<
'\n'
,
ea_ok
=
False
}
=
{
error
&
ea_file
=
ea_file
<<<
"Error "
<<<
hd
ea_loc
<<<
":
"
<<<
id
<<<
" "
<<<
mess
<<<
'\n'
,
ea_ok
=
False
}
checkWarning
::
!
a
!
b
!*
ErrorAdmin
->
*
ErrorAdmin
|
<<<
a
&
<<<
b
// PK
checkWarning
id
mess
error
=:{
ea_file
,
ea_loc
=[]}
=
{
error
&
ea_file
=
ea_file
<<<
"Warning "
<<<
"
\"
"
<<<
id
<<<
"
\"
"
<<<
mess
<<<
'\n'
}
=
{
error
&
ea_file
=
ea_file
<<<
"Warning "
<<<
"
"
<<<
id
<<<
" "
<<<
mess
<<<
'\n'
}
checkWarning
id
mess
error
=:{
ea_file
,
ea_loc
}
=
{
error
&
ea_file
=
ea_file
<<<
"Warning "
<<<
hd
ea_loc
<<<
":
\"
"
<<<
id
<<<
"
\"
"
<<<
mess
<<<
'\n'
}
=
{
error
&
ea_file
=
ea_file
<<<
"Warning "
<<<
hd
ea_loc
<<<
":
"
<<<
id
<<<
" "
<<<
mess
<<<
'\n'
}
checkErrorWithIdentPos
::
!
IdentPos
!
a
!*
ErrorAdmin
->
.
ErrorAdmin
|
<<<
a
;
...
...
@@ -326,7 +326,7 @@ addDefToSymbolTable level def_index def_ident=:{id_info} def_kind symbol_table e
|
entry
.
ste_kind
==
STE_Empty
||
entry
.
ste_def_level
<>
level
#
entry
=
{
ste_index
=
def_index
,
ste_kind
=
def_kind
,
ste_def_level
=
level
,
ste_previous
=
entry
}
=
(
symbol_table
<:=
(
id_info
,
entry
),
error
)
=
(
symbol_table
,
checkError
def_ident
"
already defined"
error
)
=
(
symbol_table
,
checkError
def_ident
"already defined"
error
)
addDeclarationsOfDclModToSymbolTable
::
.
Int
!{!
Declaration
}
!{!
Declaration
}
!*
CheckState
->
.
CheckState
;
addDeclarationsOfDclModToSymbolTable
ste_index
locals
imported
cs
...
...
@@ -437,7 +437,7 @@ where
->
addFieldToSelectorDefinition
selector_id
{
glob_module
=
NoIndex
,
glob_object
=
decl_index
}
cs
_
->
cs
=
{
cs
&
cs_error
=
checkErrorWithIdentPos
(
newPosition
ident
decl_pos
)
"
multiply defined"
cs
.
cs_error
}
=
{
cs
&
cs_error
=
checkErrorWithIdentPos
(
newPosition
ident
decl_pos
)
"multiply defined"
cs
.
cs_error
}
removeImportedSymbolsFromSymbolTable
::
Declaration
!*
SymbolTable
->
.
SymbolTable
removeImportedSymbolsFromSymbolTable
(
Declaration
{
decl_ident
=
decl_ident
=:{
id_info
},
decl_index
})
symbol_table
...
...
frontend/checktypes.icl
View file @
45b9b703
...
...
@@ -37,11 +37,11 @@ where
check_type_attribute
TA_Anonymous
type_attr
root_attr
error
|
try_to_combine_attributes
type_attr
root_attr
=
(
root_attr
,
error
)
=
(
TA_Multi
,
checkError
""
"conflicting attribution of type definition"
error
)
=
(
TA_Multi
,
checkError
"conflicting attribution of type definition"
""
error
)
check_type_attribute
TA_Unique
type_attr
root_attr
error
|
try_to_combine_attributes
TA_Unique
type_attr
||
try_to_combine_attributes
TA_Unique
root_attr
=
(
TA_Unique
,
error
)
=
(
TA_Multi
,
checkError
""
"conflicting attribution of type definition"
error
)
=
(
TA_Multi
,
checkError
"conflicting attribution of type definition"
""
error
)
check_type_attribute
(
TA_Var
var
)
_
_
error
=
(
TA_Multi
,
checkError
var
"attribute variable not allowed"
error
)
check_type_attribute
(
TA_RootVar
var
)
_
_
error
...
...
@@ -109,8 +109,8 @@ where
=
(
TA
{
type_cons
&
type_index
=
{
glob_object
=
type_index
,
glob_module
=
type_module
}}
types
,
cti_lhs_attribute
,
ts_ti_cs
)
=
(
TA
{
type_cons
&
type_index
=
{
glob_object
=
type_index
,
glob_module
=
type_module
}}
types
,
determine_type_attribute
td_attribute
,
ts_ti_cs
)
=
(
TE
/* JVG was: type */
,
TA_Multi
,
(
ts
,
ti
,
{
cs
&
cs_error
=
checkError
type_cons
.
type_name
"
used with wrong arity"
cs
.
cs_error
}))
=
(
TE
/* JVG was: type */
,
TA_Multi
,
(
ts
,
ti
,
{
cs
&
cs_error
=
checkError
type_cons
.
type_name
"
undefined"
cs
.
cs_error
}))
=
(
TE
/* JVG was: type */
,
TA_Multi
,
(
ts
,
ti
,
{
cs
&
cs_error
=
checkError
type_cons
.
type_name
"used with wrong arity"
cs
.
cs_error
}))
=
(
TE
/* JVG was: type */
,
TA_Multi
,
(
ts
,
ti
,
{
cs
&
cs_error
=
checkError
type_cons
.
type_name
"undefined"
cs
.
cs_error
}))
where
determine_type_attribute
TA_Unique
=
TA_Unique
determine_type_attribute
_
=
TA_Multi
...
...
@@ -139,7 +139,7 @@ addToAttributeEnviron (TA_Var attr_var) (TA_Var root_var) attr_env error
addToAttributeEnviron
(
TA_RootVar
attr_var
)
root_attr
attr_env
error
=
(
attr_env
,
error
)
addToAttributeEnviron
_
_
attr_env
error
=
(
attr_env
,
checkError
""
"inconsistent attribution of type definition"
error
)
=
(
attr_env
,
checkError
"inconsistent attribution of type definition"
""
error
)
bindTypesOfConstructors
::
!
CurrentTypeInfo
!
Index
![
TypeVar
]
![
AttributeVar
]
!
AType
![
DefinedSymbol
]
!(!*
TypeSymbols
,!*
TypeInfo
,!*
CheckState
)
->
(!*
TypeSymbols
,
!*
TypeInfo
,
!*
CheckState
)
...
...
@@ -718,7 +718,7 @@ checkInstanceType mod_index ins_class it=:{it_types,it_context} specials type_de
where
check_fully_polymorphity
it_types
it_context
cs_error
|
all
is_type_var
it_types
&&
not
(
isEmpty
it_context
)
=
checkError
""
"context restriction not allowed for fully polymorph instance"
cs_error
=
checkError
"context restriction not allowed for fully polymorph instance"
""
cs_error
=
cs_error
where
is_type_var
(
TV
_)
=
True
...
...
@@ -862,7 +862,7 @@ checkTypeContext mod_index tc=:{tc_class=tc_class=:{glob_object=class_name=:{ds_
=
(
tc
,
(
class_defs
,
ots
,
oti
,
{
cs
&
cs_error
=
checkError
id_name
"undefined"
cs
.
cs_error
}))
where
check_context_types
tc_class
[]
cs
=:{
cs_error
}
=
{
cs
&
cs_error
=
checkError
tc_class
"
type context should contain one or more type variables"
cs_error
}
=
{
cs
&
cs_error
=
checkError
tc_class
"type context should contain one or more type variables"
cs_error
}
check_context_types
tc_class
[
TV
_
:
types
]
cs
=
cs
check_context_types
tc_class
[
type
:
types
]
cs
...
...
@@ -881,14 +881,14 @@ where
where
check_class_variable
{
tv_name
}
cs
=:{
cs_symbol_table
,
cs_error
}
=
{
cs
&
cs_symbol_table
=
removeDefinitionFromSymbolTable
cGlobalScope
tv_name
cs_symbol_table
,
cs_error
=
checkError
tv_name
"
not defined or defined as class variable
"
cs_error
}
cs_error
=
checkError
tv_name
"
wrongly used or not used at all
"
cs_error
}
check_class_attributes
class_attributes
cs
=
foldSt
check_class_attribute
class_attributes
cs
where
check_class_attribute
{
av_name
}
cs
=:{
cs_symbol_table
,
cs_error
}
=
{
cs
&
cs_symbol_table
=
removeDefinitionFromSymbolTable
cGlobalScope
av_name
cs_symbol_table
,
cs_error
=
checkError
av_name
"
undefined"
cs_error
}
cs_error
=
checkError
av_name
"undefined"
cs_error
}
checkDynamicTypes
::
!
Index
![
ExprInfoPtr
]
!(
Optional
SymbolType
)
!
u
:{#
CheckedTypeDef
}
!
u
:{#
DclModule
}
!*
TypeHeaps
!*
ExpressionHeap
!*
CheckState
...
...
@@ -959,7 +959,7 @@ where
|
entry
.
ste_kind
==
STE_Empty
=
{
cs
&
cs_symbol_table
=
cs_symbol_table
}
=
{
cs
&
cs_symbol_table
=
cs_symbol_table
<:=
(
id_info
,
entry
.
ste_previous
),
cs_error
=
checkError
tv_name
.
id_name
"
global type variable not used in type of the function"
cs_error
}
cs_error
=
checkError
tv_name
.
id_name
"global type variable not used in type of the function"
cs_error
}
checkDynamics
mod_index
scope
dyn_type_ptrs
type_defs
modules
type_heaps
expr_heap
cs
=
foldSt
(
check_dynamic
mod_index
scope
)
dyn_type_ptrs
(
type_defs
,
modules
,
type_heaps
,
expr_heap
,
cs
)
...
...
@@ -974,7 +974,7 @@ where
|
isEmpty
loc_type_vars
->
(
type_defs
,
modules
,
type_heaps
,
expr_heap
<:=
(
dyn_info_ptr
,
EI_Dynamic
(
Yes
dyn_type
)),
cs
)
#
cs_symbol_table
=
removeVariablesFromSymbolTable
scope
loc_type_vars
cs
.
cs_symbol_table
cs_error
=
checkError
loc_type_vars
"
type variable(s) not defined"
cs
.
cs_error
cs_error
=
checkError
loc_type_vars
"type variable(s) not defined"
cs
.
cs_error
->
(
type_defs
,
modules
,
type_heaps
,
expr_heap
<:=
(
dyn_info_ptr
,
EI_Dynamic
(
Yes
dyn_type
)),
{
cs
&
cs_error
=
cs_error
,
cs_symbol_table
=
cs_symbol_table
})
No
...
...
@@ -1004,7 +1004,7 @@ where
#
cs_symbol_table
=
removeAttributesFromSymbolTable
oti_all_attrs
cs_symbol_table
=
({
dt
&
dt_uni_vars
=
dt_uni_vars
,
dt_global_vars
=
oti_global_vars
,
dt_type
=
dt_type
},
oti_all_vars
,
ots_type_defs
,
ots_modules
,
{
oti_heaps
&
th_vars
=
th_vars
},
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
(
hd
oti_all_attrs
).
av_name
"
type attribute variable not allowed"
cs
.
cs_error
})
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
(
hd
oti_all_attrs
).
av_name
"type attribute variable not allowed"
cs
.
cs_error
})
add_type_variable_to_symbol_table
::
!
Level
!
ATypeVar
!*(!*
TypeVarHeap
,!*
CheckState
)
->
(!
ATypeVar
,!(!*
TypeVarHeap
,
!*
CheckState
))
add_type_variable_to_symbol_table
scope
atv
=:{
atv_variable
=
atv_variable
=:{
tv_name
},
atv_attribute
}
(
type_var_heap
,
cs
=:{
cs_symbol_table
,
cs_error
})
...
...
@@ -1016,7 +1016,7 @@ where
(
var_info
,
{
ste_index
=
NoIndex
,
ste_kind
=
STE_TypeVariable
new_var_ptr
,
ste_def_level
=
scope
,
ste_previous
=
var_entry
})
=
({
atv
&
atv_attribute
=
TA_Multi
,
atv_variable
=
{
atv_variable
&
tv_info_ptr
=
new_var_ptr
}},
(
type_var_heap
,
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
check_attribute
atv_attribute
cs_error
}))
=
(
atv
,
(
type_var_heap
,
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
tv_name
.
id_name
"
type variable already defined"
cs_error
}))
=
(
atv
,
(
type_var_heap
,
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
tv_name
.
id_name
"type variable already defined"
cs_error
}))
check_attribute
TA_Unique
error
=
error
...
...
@@ -1025,7 +1025,7 @@ where
check_attribute
TA_None
error
=
error
check_attribute
attr
error
=
checkError
attr
"
attribute not allowed in type of dynamic"
error
=
checkError
attr
"attribute not allowed in type of dynamic"
error
checkSpecialTypeVars
::
!
Specials
!*
CheckState
->
(!
Specials
,
!*
CheckState
)
...
...
@@ -1038,7 +1038,7 @@ where
|
ste_kind
<>
STE_Empty
&&
ste_def_level
==
cGlobalScope
#
(
STE_TypeVariable
tv_info_ptr
)
=
ste_kind
=
({
bind
&
bind_dst
=
{
type_var
&
tv_info_ptr
=
tv_info_ptr
}},
{
cs
&
cs_symbol_table
=
cs_symbol_table
})
=
(
bind
,
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
id_name
"
type variable not defined"
cs_error
})
=
(
bind
,
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
id_name
"type variable not defined"
cs_error
})
checkSpecialTypeVars
SP_None
cs
=
(
SP_None
,
cs
)
/*
...
...
@@ -1115,7 +1115,7 @@ where
=
({
atv
&
atv_variable
=
atv_variable
,
atv_attribute
=
atv_attribute
},
(
attr_vars
,
heaps
,
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
cs_error
/* TD ... */
,
cs_x
=
{
cs
.
cs_x
&
x_type_var_position
=
inc
x_type_var_position
}
/* ... TD */
}))
=
(
atv
,
(
attr_vars
,
{
heaps
&
th_vars
=
th_vars
},
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
tv_name
.
id_name
"
type variable already defined"
cs_error
/* TD ... */
,
cs_x
=
{
cs
.
cs_x
&
x_type_var_position
=
inc
x_type_var_position
}
/* ... TD */
}))
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
tv_name
.
id_name
"type variable already defined"
cs_error
/* TD ... */
,
cs_x
=
{
cs
.
cs_x
&
x_type_var_position
=
inc
x_type_var_position
}
/* ... TD */
}))
check_attribute
::
!
TypeAttribute
!
String
![
AttributeVar
]
!*
AttrVarHeap
!*
ErrorAdmin
->
(!
TypeAttribute
,
![
AttributeVar
],
!*
AttrVarHeap
,
!*
ErrorAdmin
)
...
...
@@ -1154,7 +1154,7 @@ where
=
({
atv
&
atv_variable
=
atv_variable
,
atv_attribute
=
atv_attribute
},
(
heaps
,
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
cs_error
/* TD ... */
,
cs_x
=
{
cs
.
cs_x
&
x_type_var_position
=
inc
x_type_var_position
}
/* ... TD */
}))
=
(
atv
,
({
heaps
&
th_vars
=
th_vars
},
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
tv_name
.
id_name
"
type variable already defined"
cs_error
/* TD ... */
,
cs_x
=
{
cs
.
cs_x
&
x_type_var_position
=
inc
x_type_var_position
}
/* ... TD */
}))
{
cs
&
cs_symbol_table
=
cs_symbol_table
,
cs_error
=
checkError
tv_name
.
id_name
"type variable already defined"
cs_error
/* TD ... */
,
cs_x
=
{
cs
.
cs_x
&
x_type_var_position
=
inc
x_type_var_position
}
/* ... TD */
}))
check_attribute
::
!
TypeAttribute
!
TypeAttribute
!
String
!*
ErrorAdmin
->
(!
TypeAttribute
,
!*
ErrorAdmin
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment