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
61fc0103
Commit
61fc0103
authored
Dec 03, 2001
by
Ronny Wichers Schreur
🏢
Browse files
bug fix: uniqueness error in nested record/array updates
parent
d00fe0ec
Changes
6
Hide whitespace changes
Inline
Side-by-side
backend/backendconvert.icl
View file @
61fc0103
...
...
@@ -1796,6 +1796,8 @@ where
where
addKinds
NormalSelector
selections
=
[(
BESelector
,
selection
)
\\
selection
<-
selections
]
addKinds
NormalSelectorUniqueElementResult
selections
=
[(
BESelector
,
selection
)
\\
selection
<-
selections
]
addKinds
_
[
selection
]
=
[(
BESelector_U
,
selection
)]
addKinds
_
[
selection
:
selections
]
...
...
frontend/checkFunctionBodies.icl
View file @
61fc0103
...
...
@@ -1009,22 +1009,26 @@ where
cons_optional
No
variables
=
variables
checkExpression
free_vars
(
PE_Selection
is_unique
expr
[
PS_Array
index_expr
])
e_input
e_state
e_info
cs
checkExpression
free_vars
(
PE_Selection
selector_kind
expr
[
PS_Array
index_expr
])
e_input
e_state
e_info
cs
#
(
expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkExpression
free_vars
expr
e_input
e_state
e_info
cs
|
is_unique
#
(
glob_select_symb
,
cs
)
=
getPredefinedGlobalSymbol
PD_UnqArraySelectFun
PD_StdArray
STE_Member
2
cs
(
selector
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkArraySelection
glob_select_symb
free_vars
index_expr
e_input
e_state
e_info
cs
=
(
Selection
NormalSelector
expr
[
selector
],
free_vars
,
e_state
,
e_info
,
cs
)
#
(
glob_select_symb
,
cs
)
=
getPredefinedGlobalSymbol
PD_ArraySelectFun
PD_StdArray
STE_Member
2
cs
(
selector
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkArraySelection
glob_select_symb
free_vars
index_expr
e_input
e_state
e_info
cs
=
(
Selection
NormalSelector
expr
[
selector
],
free_vars
,
e_state
,
e_info
,
cs
)
checkExpression
free_vars
(
PE_Selection
is_unique
expr
selectors
)
e_input
e_state
e_info
cs
#
(
select_fun
,
selector_kind
)
=
case
selector_kind
of
ParsedNormalSelector
->
(
PD_ArraySelectFun
,
NormalSelector
)
ParsedUniqueSelector
_
->
(
PD_UnqArraySelectFun
,
NormalSelectorUniqueElementResult
)
#
(
glob_select_symb
,
cs
)
=
getPredefinedGlobalSymbol
select_fun
PD_StdArray
STE_Member
2
cs
(
selector
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkArraySelection
glob_select_symb
free_vars
index_expr
e_input
e_state
e_info
cs
=
(
Selection
selector_kind
expr
[
selector
],
free_vars
,
e_state
,
e_info
,
cs
)
checkExpression
free_vars
(
PE_Selection
selector_kind
expr
selectors
)
e_input
e_state
e_info
cs
#
(
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkSelectors
cEndWithSelection
free_vars
selectors
e_input
e_state
e_info
cs
(
expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkExpression
free_vars
expr
e_input
e_state
e_info
cs
|
is_unique
#
(
tuple_type
,
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleTypeIndex
2
)
PD_PredefinedModule
STE_Type
2
cs
=
(
Selection
(
UniqueSelector
tuple_type
False
)
expr
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
=
(
Selection
NormalSelector
expr
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
=
case
selector_kind
of
ParsedNormalSelector
->
(
Selection
NormalSelector
expr
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
ParsedUniqueSelector
unique_element
#
(
tuple_type
,
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleTypeIndex
2
)
PD_PredefinedModule
STE_Type
2
cs
->
(
Selection
(
UniqueSelector
tuple_type
)
expr
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
checkExpression
free_vars
(
PE_Update
expr1
selectors
expr2
)
e_input
e_state
e_info
cs
#
(
expr1
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkExpression
free_vars
expr1
e_input
e_state
e_info
cs
(
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkSelectors
cEndWithUpdate
free_vars
selectors
e_input
e_state
e_info
cs
...
...
@@ -2191,7 +2195,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections}
->
(
unq_select_symb
,
NormalSelector
,
cs
)
_
#
(
select_symb
,
cs
)
=
getPredefinedGlobalSymbol
PD_ArraySelectFun
PD_StdArray
STE_Member
2
cs
(
tuple_type
,
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleTypeIndex
2
)
PD_PredefinedModule
STE_Type
2
cs
->
(
select_symb
,
UniqueSelector
tuple_type
False
,
cs
)
->
(
select_symb
,
UniqueSelector
tuple_type
,
cs
)
e_state
=
{
e_state
&
es_var_heap
=
es_var_heap
,
es_expr_heap
=
es_expr_heap
}
(
index_exprs
,
(
free_vars
,
e_state
,
e_info
,
cs
))
...
...
frontend/parse.icl
View file @
61fc0103
...
...
@@ -2175,7 +2175,7 @@ where
|
token
==
DotToken
#
(
token
,
pState
)
=
nextToken
FunctionContext
pState
(
selectors
,
pState
)
=
wantSelectors
token
pState
=
(
PE_Selection
cNonUnique
Select
ion
exp
selectors
,
pState
)
=
(
PE_Selection
ParsedNormal
Select
or
exp
selectors
,
pState
)
|
token
==
ExclamationToken
#
(
token
,
pState
)
=
nextToken
FunctionContext
pState
// JVG added for strict lists:
...
...
@@ -2183,7 +2183,7 @@ where
=
(
exp
,
tokenBack
(
tokenBack
pState
))
//
#
(
selectors
,
pState
)
=
wantSelectors
token
pState
=
(
PE_Selection
c
UniqueSelect
ion
exp
selectors
,
pState
)
=
(
PE_Selection
(
Parsed
UniqueSelect
or
False
)
exp
selectors
,
pState
)
|
otherwise
=
(
exp
,
tokenBack
pState
)
...
...
@@ -2869,7 +2869,7 @@ where
#
(
shareIdent
,
pState
)
=
make_ident
optionalIdent
level
pState
select
=
PE_Selection
cNonUnique
Select
ion
(
PE_Ident
shareIdent
)
[
PS_Record
fieldIdent
final_record_type
]
=
PE_Selection
ParsedNormal
Select
or
(
PE_Ident
shareIdent
)
[
PS_Record
fieldIdent
final_record_type
]
(
update_expr
,
pState
)
=
transform_record_or_array_update
No
select
(
map
sub_update
updates
)
(
level
+1
)
pState
=
({
bind_dst
=
fieldIdent
,
bind_src
=
update_expr
},
(
Yes
shareIdent
,
record_type
,
pState
))
...
...
@@ -2941,7 +2941,7 @@ where
select_def
=
buildNodeDef
(
PE_Tuple
[
PE_Ident
element_id
,
PE_Ident
array_id
])
(
PE_Selection
c
UniqueSelect
ion
expr
(
reverse
[
PS_Array
(
PE_Ident
index_id
)
:
initial_selectors
]))
(
PE_Selection
(
Parsed
UniqueSelect
or
True
)
expr
(
reverse
[
PS_Array
(
PE_Ident
index_id
)
:
initial_selectors
]))
(
updated_element
,
pState
)
=
transform_record_update
No
(
PE_Ident
element_id
)
...
...
frontend/syntax.dcl
View file @
61fc0103
...
...
@@ -1028,8 +1028,10 @@ instance toString KindInfo
::
LocalDef
:==
ParsedDefinition
cUniqueSelection
:==
True
cNonUniqueSelection
:==
False
::
ParsedSelectorKind
=
ParsedNormalSelector
// .
|
ParsedUniqueSelector
// !
!
Bool
// is result element unique?
::
ParsedExpr
=
PE_List
![
ParsedExpr
]
|
PE_Ident
!
Ident
...
...
@@ -1041,7 +1043,7 @@ cNonUniqueSelection :== False
|
PE_ArrayPattern
![
ElemAssignment
]
|
PE_UpdateComprehension
!
ParsedExpr
!
ParsedExpr
!
ParsedExpr
![
Qualifier
]
|
PE_ArrayDenot
![
ParsedExpr
]
|
PE_Selection
!
Bool
!
ParsedExpr
![
ParsedSelection
]
|
PE_Selection
!
ParsedSelectorKind
!
ParsedExpr
![
ParsedSelection
]
|
PE_Update
!
ParsedExpr
[
ParsedSelection
]
ParsedExpr
|
PE_Case
!
Ident
!
ParsedExpr
[
CaseAlt
]
|
PE_If
!
Ident
!
ParsedExpr
!
ParsedExpr
!
ParsedExpr
...
...
@@ -1100,10 +1102,10 @@ cIsStrict :== True
cIsNotStrict
:==
False
::
SelectorKind
=
NormalSelector
// .
=
NormalSelector
|
NormalSelectorUniqueElementResult
|
UniqueSelector
// !
(
Global
DefinedSymbol
)
// tuple type
!
Bool
// is result element unique?
/*
:: SelectorKind = SEK_Normal | SEK_First | SEK_Next | SEK_Last
...
...
frontend/syntax.icl
View file @
61fc0103
...
...
@@ -1020,8 +1020,10 @@ cNotVarNumber :== -1
::
LocalDef
:==
ParsedDefinition
cUniqueSelection
:==
True
cNonUniqueSelection
:==
False
::
ParsedSelectorKind
=
ParsedNormalSelector
// .
|
ParsedUniqueSelector
// !
!
Bool
// is result element unique?
::
ParsedExpr
=
PE_List
![
ParsedExpr
]
|
PE_Ident
!
Ident
...
...
@@ -1033,7 +1035,7 @@ cNonUniqueSelection :== False
|
PE_ArrayPattern
![
ElemAssignment
]
|
PE_UpdateComprehension
!
ParsedExpr
!
ParsedExpr
!
ParsedExpr
![
Qualifier
]
|
PE_ArrayDenot
![
ParsedExpr
]
|
PE_Selection
!
Bool
!
ParsedExpr
![
ParsedSelection
]
|
PE_Selection
!
ParsedSelectorKind
!
ParsedExpr
![
ParsedSelection
]
|
PE_Update
!
ParsedExpr
[
ParsedSelection
]
ParsedExpr
|
PE_Case
!
Ident
!
ParsedExpr
[
CaseAlt
]
|
PE_If
!
Ident
!
ParsedExpr
!
ParsedExpr
!
ParsedExpr
...
...
@@ -1093,10 +1095,10 @@ cIsStrict :== True
cIsNotStrict
:==
False
::
SelectorKind
=
NormalSelector
// .
=
NormalSelector
|
NormalSelectorUniqueElementResult
|
UniqueSelector
// !
(
Global
DefinedSymbol
)
// tuple type
!
Bool
// is result element unique?
::
Expression
=
Var
!
BoundVar
|
App
!
App
...
...
@@ -1661,9 +1663,9 @@ where
instance
<<<
SelectorKind
where
(<<<)
file
NormalSelector
=
file
<<<
"
!
"
(<<<)
file
(
Unique
Selector
_
False
)
=
file
<<<
"!"
(<<<)
file
(
UniqueSelector
_
True
)
=
file
<<<
"!
*
"
(<<<)
file
NormalSelector
=
file
<<<
"
.
"
(<<<)
file
Normal
Selector
UniqueElementResult
=
file
<<<
"!
*
"
(<<<)
file
(
UniqueSelector
_)
=
file
<<<
"!"
instance
<<<
Selection
where
...
...
@@ -1695,7 +1697,7 @@ where
(<<<)
file
(
PE_List
exprs
)
=
file
<<<
exprs
(<<<)
file
(
PE_Tuple
args
)
=
file
<<<
'('
<<<
args
<<<
')'
(<<<)
file
(
PE_Basic
basic_value
)
=
file
<<<
basic_value
(<<<)
file
(
PE_Selection
is_unique
expr
selectors
)
=
file
<<<
expr
<<<
(
if
is_unique
'!'
'.'
)
<<<
selectors
(<<<)
file
(
PE_Selection
selector_kind
expr
selectors
)
=
file
<<<
expr
<<<
selector_kind
<<<
selectors
(<<<)
file
(
PE_Update
expr1
selections
expr2
)
=
file
<<<
'{'
<<<
expr1
<<<
" & "
<<<
selections
<<<
" = "
<<<
expr2
<<<
'}'
(<<<)
file
(
PE_Record
PE_Empty
_
fields
)
=
file
<<<
'{'
<<<
fields
<<<
'}'
(<<<)
file
(
PE_Record
rec
_
fields
)
=
file
<<<
'{'
<<<
rec
<<<
" & "
<<<
fields
<<<
'}'
...
...
@@ -1718,7 +1720,12 @@ where
->
file
<<<
"dynamic "
<<<
expr
(<<<)
file
_
=
file
<<<
"some expression"
instance
<<<
ParsedSelectorKind
where
(<<<)
file
ParsedNormalSelector
=
file
<<<
"."
(<<<)
file
(
ParsedUniqueSelector
False
)
=
file
<<<
"!"
(<<<)
file
(
ParsedUniqueSelector
True
)
=
file
<<<
"!*"
instance
<<<
ParsedSelection
where
(<<<)
file
(
PS_Record
selector
_)
=
file
<<<
selector
...
...
frontend/type.icl
View file @
61fc0103
...
...
@@ -1470,9 +1470,9 @@ where
requirements
ti
(
Selection
selector_kind
expr
selectors
)
reqs_ts
#
(
expr_type
,
opt_expr_ptr
,
(
reqs
,
ts
))
=
requirements
ti
expr
reqs_ts
=
case
selector_kind
of
UniqueSelector
{
glob_object
={
ds_ident
,
ds_index
,
ds_arity
},
glob_module
}
_
UniqueSelector
{
glob_object
={
ds_ident
,
ds_index
,
ds_arity
},
glob_module
}
#
(
var
,
ts
)
=
freshAttributedVariable
ts
(_,
result_type
,
(
reqs
,
ts
))
=
requirementsOfSelectors
ti
No
expr
selectors
False
var
expr
(
reqs
,
ts
)
(_,
result_type
,
(
reqs
,
ts
))
=
requirementsOfSelectors
ti
No
expr
selectors
False
False
var
expr
(
reqs
,
ts
)
tuple_type
=
MakeTypeSymbIdent
{
glob_object
=
ds_index
,
glob_module
=
glob_module
}
ds_ident
ds_arity
non_unique_type_var
=
{
at_attribute
=
TA_Multi
,
at_annotation
=
AN_None
,
at_type
=
TempV
ts
.
ts_var_store
}
req_type_coercions
...
...
@@ -1482,13 +1482,16 @@ where
result_type
=
{
at_type
=
TA
tuple_type
[
non_unique_type_var
,
var
],
at_attribute
=
TA_Unique
,
at_annotation
=
AN_None
}
->
(
result_type
,
No
,
({
reqs
&
req_type_coercions
=
req_type_coercions
},
{
ts
&
ts_var_store
=
inc
ts
.
ts_var_store
,
ts_expr_heap
=
storeAttribute
opt_expr_ptr
TA_Multi
ts
.
ts_expr_heap
}))
_
#
(_,
result_type
,
reqs_ts
)
=
requirementsOfSelectors
ti
No
expr
selectors
True
expr_type
expr
(
reqs
,
ts
)
NormalSelectorUniqueElementResult
#
(_,
result_type
,
reqs_ts
)
=
requirementsOfSelectors
ti
No
expr
selectors
True
True
expr_type
expr
(
reqs
,
ts
)
->
(
result_type
,
opt_expr_ptr
,
reqs_ts
)
NormalSelector
#
(_,
result_type
,
reqs_ts
)
=
requirementsOfSelectors
ti
No
expr
selectors
True
False
expr_type
expr
(
reqs
,
ts
)
->
(
result_type
,
opt_expr_ptr
,
reqs_ts
)
requirements
ti
(
Update
composite_expr
selectors
elem_expr
)
reqs_ts
#
(
composite_expr_type
,
opt_composite_expr_ptr
,
reqs_ts
)
=
requirements
ti
composite_expr
reqs_ts
(
has_array_selection
,
result_type
,
(
reqs
,
ts
))
=
requirementsOfSelectors
ti
(
Yes
elem_expr
)
composite_expr
selectors
True
composite_expr_type
composite_expr
reqs_ts
=
requirementsOfSelectors
ti
(
Yes
elem_expr
)
composite_expr
selectors
True
False
composite_expr_type
composite_expr
reqs_ts
|
has_array_selection
#
ts
=
{
ts
&
ts_expr_heap
=
storeAttribute
opt_composite_expr_ptr
TA_Unique
ts
.
ts_expr_heap
}
=
(
composite_expr_type
,
No
,
(
reqs
,
ts
))
...
...
@@ -1560,21 +1563,29 @@ where
=
(
abort
(
"Error in requirements
\n
"
--->
expr
),
No
,
reqs_ts
)
requirementsOfSelectors
ti
opt_expr
expr
[
selector
]
tc_coercible
sel_expr_type
sel_expr
reqs_ts
=
requirementsOfSelector
ti
opt_expr
expr
selector
tc_coercible
sel_expr_type
sel_expr
reqs_ts
requirementsOfSelectors
ti
opt_expr
expr
[
selector
:
selectors
]
tc_coercible
sel_expr_type
sel_expr
reqs_ts
#
(
has_array_selection
,
result_type
,
reqs_ts
)
=
requirementsOfSelector
ti
No
expr
selector
tc_coercible
sel_expr_type
sel_expr
reqs_ts
#
(
have_array_selection
,
result_type
,
reqs_ts
)
=
requirementsOfSelectors
ti
opt_expr
expr
selectors
tc_coercible
result_type
sel_expr
reqs_ts
requirementsOfSelectors
ti
opt_expr
expr
[
selector
]
tc_coercible
change_uselect
sel_expr_type
sel_expr
reqs_ts
=
requirementsOfSelector
ti
opt_expr
expr
selector
tc_coercible
change_uselect
sel_expr_type
sel_expr
reqs_ts
requirementsOfSelectors
ti
opt_expr
expr
[
selector
:
selectors
]
tc_coercible
change_uselect
sel_expr_type
sel_expr
reqs_ts
#
(
has_array_selection
,
result_type
,
reqs_ts
)
=
requirementsOfSelector
ti
No
expr
selector
tc_coercible
change_uselect
sel_expr_type
sel_expr
reqs_ts
#
(
have_array_selection
,
result_type
,
reqs_ts
)
=
requirementsOfSelectors
ti
opt_expr
expr
selectors
tc_coercible
False
result_type
sel_expr
reqs_ts
=
(
has_array_selection
||
have_array_selection
,
result_type
,
reqs_ts
)
requirementsOfSelector
ti
_
expr
(
RecordSelection
field
_)
tc_coercible
sel_expr_type
sel_expr
(
reqs
,
ts
)
requirementsOfSelector
ti
_
expr
(
RecordSelection
field
_)
tc_coercible
change_uselect
sel_expr_type
sel_expr
(
reqs
,
ts
)
#
({
tst_args
,
tst_result
,
tst_attr_env
},
ts
)
=
standardFieldSelectorType
(
CP_Expression
sel_expr
)
field
ti
ts
req_type_coercions
=
[{
tc_demanded
=
hd
tst_args
,
tc_offered
=
sel_expr_type
,
tc_position
=
CP_Expression
sel_expr
,
tc_coercible
=
tc_coercible
}
:
reqs
.
req_type_coercions
]
=
(
False
,
tst_result
,
({
reqs
&
req_type_coercions
=
req_type_coercions
},
ts
))
requirementsOfSelector
ti
opt_expr
expr
(
ArraySelection
{
glob_object
=
{
ds_ident
,
ds_index
,
ds_arity
},
glob_module
}
expr_ptr
index_expr
)
tc_coercible
sel_expr_type
sel_expr
(
reqs
,
ts
)
requirementsOfSelector
ti
opt_expr
expr
(
ArraySelection
{
glob_object
=
{
ds_ident
,
ds_index
,
ds_arity
},
glob_module
}
expr_ptr
index_expr
)
tc_coercible
change_uselect
sel_expr_type
sel_expr
(
reqs
,
ts
)
#
{
me_type
}
=
ti
.
ti_common_defs
.[
glob_module
].
com_member_defs
.[
ds_index
]
({
tst_attr_env
,
tst_args
,
tst_result
,
tst_context
},
ts
)
=
freshSymbolType
(
Yes
(
CP_Expression
expr
))
cWithFreshContextVars
me_type
ti
.
ti_common_defs
ts
#
(
tst_args
,
tst_result
,
ts
)
=
case
ds_ident
.
id_name
of
// RWS FIXME: use predef symbols
"uselect"
|
change_uselect
->
change_uselect_attributes
tst_args
tst_result
ts
_
->
(
tst_args
,
tst_result
,
ts
)
(
dem_array_type
,
dem_index_type
,
rest_type
)
=
array_and_index_type
tst_args
reqs
={
reqs
&
req_attr_coercions
=
tst_attr_env
++
reqs
.
req_attr_coercions
}
(
index_type
,
opt_expr_ptr
,
(
reqs
,
ts
))
=
requirements
ti
index_expr
(
reqs
,
ts
)
...
...
@@ -1601,6 +1612,24 @@ where
tc_position
=
CP_Expression
elem_expr
,
tc_coercible
=
True
}
:
reqs
.
req_type_coercions
]}
=
(
reqs
,
ts
)
/*
change
uselect :: !u:(a e) !Int -> ( e, !u:(a e)) | uselect_u e
to
uselect :: !u:(a .e) !Int -> (.e, !u:(a .e)) | uselect_u e
(necessary for uselects in updates)
*/
change_uselect_attributes
::
[
AType
]
AType
u
:
TypeState
->
([
AType
],
AType
,
u
:
TypeState
)
change_uselect_attributes
args
=:[
arg_array
=:{
at_type
=
aa
:@:
[
ae
]},
arg_int
]
result
=:{
at_type
=
TA
tuple_symb
[
result_element
,
result_array
=:{
at_type
=
ra
:@:
[
re
]}]}
ts
#
(
attribute
,
ts
)
=
freshAttribute
ts
#
args
=
[{
arg_array
&
at_type
=
aa
:@:
[{
ae
&
at_attribute
=
attribute
}]},
arg_int
]
#
result
=
{
result
&
at_type
=
TA
tuple_symb
[{
result_element
&
at_attribute
=
attribute
},
{
result_array
&
at_type
=
ra
:@:
[{
re
&
at_attribute
=
attribute
}]}]}
=
(
args
,
result
,
ts
)
change_uselect_attributes
_
_
ts
=
abort
"type.icl, change_uselect_attributes: wrong type for uselect"
possibly_accumulate_reqs_in_new_group
position
state_transition
reqs_ts
:==
possibly_accumulate_reqs
position
reqs_ts
where
...
...
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