Skip to content
GitLab
Menu
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
403517b9
Commit
403517b9
authored
Dec 12, 2001
by
Ronny Wichers Schreur
🏘
Browse files
fixed bugs in merging explicit cases
parent
3018f259
Changes
2
Hide whitespace changes
Inline
Side-by-side
frontend/checkFunctionBodies.icl
View file @
403517b9
...
...
@@ -19,7 +19,7 @@ cEndWithSelection :== False
,
es_fun_defs
::
!.{#
FunDef
}
,
es_dynamic_expr_count
::
!
Int
// used to give each dynamic expr an unique id
}
::
ExpressionInput
=
{
ei_expr_level
::
!
Level
,
ei_fun_index
::
!
FunctionOrMacroIndex
...
...
@@ -902,7 +902,7 @@ where
#
(
let_expr
,
var_heap
,
expr_heap
,
error_admin
)
=
merge_case
let_expr
var_heap
expr_heap
error_admin
=
(
Let
{
lad
&
let_expr
=
let_expr
},
var_heap
,
expr_heap
,
error_admin
)
merge_case
(
Case
kees
)
var_heap
expr_heap
error_admin
#
cases
=
map
(
make_case
kees
.
case_expr
kees
.
case_explicit
)
(
split_patterns
kees
.
case_guards
)
#
cases
=
map
(
make_case
kees
.
case_expr
)
(
split_patterns
kees
.
case_guards
)
cases
=
init
cases
++
[{
last
cases
&
case_default
=
kees
.
case_default
}]
[
firstCase
:
otherCases
]
=
[(
Case
kees
,
NoPos
)
\\
kees
<-
cases
]
((
Case
{
case_guards
},_),
var_heap
,
expr_heap
,
error_admin
)
=
mergeCases
firstCase
otherCases
var_heap
expr_heap
error_admin
...
...
@@ -921,8 +921,8 @@ where
split_patterns
NoPattern
=
[
NoPattern
]
make_case
::
Expression
Bool
CasePatterns
->
Case
make_case
expr
explicit
guard
make_case
::
Expression
CasePatterns
->
Case
make_case
expr
guard
=
{
case_expr
=
expr
,
case_guards
=
guard
...
...
@@ -930,7 +930,7 @@ where
,
case_ident
=
No
,
case_info_ptr
=
nilPtr
,
case_default_pos
=
NoPos
,
case_explicit
=
explicit
,
case_explicit
=
False
}
merge_case
expr
var_heap
expr_heap
error_admin
=
(
expr
,
var_heap
,
expr_heap
,
error_admin
)
...
...
frontend/mergecases.icl
View file @
403517b9
...
...
@@ -36,34 +36,26 @@ instance GetSetPatternRhs DynamicPattern
mergeCases
::
!(!
Expression
,
!
Position
)
![(!
Expression
,
!
Position
)]
!*
VarHeap
!*
ExpressionHeap
!*
ErrorAdmin
->
*(!(!
Expression
,
!
Position
),
!*
VarHeap
,
!*
ExpressionHeap
,
!*
ErrorAdmin
)
mergeCases
expr_and_pos
exprs
var_heap
symbol_heap
error
=
mergeCaseWithCases
False
expr_and_pos
exprs
var_heap
symbol_heap
error
mergeNestedCases
:==
mergeCaseWithCases
True
mergeCaseWithCases
::
!
Bool
!(!
Expression
,
!
Position
)
![(!
Expression
,
!
Position
)]
!*
VarHeap
!*
ExpressionHeap
!*
ErrorAdmin
->
*(!(!
Expression
,
!
Position
),
!*
VarHeap
,
!*
ExpressionHeap
,
!*
ErrorAdmin
)
mergeCaseWithCases
_
expr_and_pos
[]
var_heap
symbol_heap
error
mergeCases
expr_and_pos
[]
var_heap
symbol_heap
error
=
(
expr_and_pos
,
var_heap
,
symbol_heap
,
error
)
mergeCase
WithCases
nested
(
Let
lad
=:{
let_expr
},
pos
)
exprs
var_heap
symbol_heap
error
#
((
let_expr
,
_),
var_heap
,
symbol_heap
,
error
)
=
mergeCase
WithCases
nested
(
let_expr
,
NoPos
)
exprs
var_heap
symbol_heap
error
mergeCase
s
(
Let
lad
=:{
let_expr
},
pos
)
exprs
var_heap
symbol_heap
error
#
((
let_expr
,
_),
var_heap
,
symbol_heap
,
error
)
=
mergeCase
s
(
let_expr
,
NoPos
)
exprs
var_heap
symbol_heap
error
=
((
Let
{
lad
&
let_expr
=
let_expr
},
pos
),
var_heap
,
symbol_heap
,
error
)
mergeCase
WithCases
nested
(
case_expr
=:(
Case
first_case
=:{
case_expr
=
Var
{
var_info_ptr
},
case_default
=
No
,
case_explicit
}),
case_pos
)
mergeCase
s
(
case_expr
=:(
Case
first_case
=:{
case_expr
=
Var
{
var_info_ptr
},
case_default
=
No
,
case_explicit
}),
case_pos
)
[(
expr
,
expr_pos
)
:
exprs
]
var_heap
symbol_heap
error
|
not
(
nested
&&
case_explicit
)
|
not
case_explicit
#
(
split_result
,
var_heap
,
symbol_heap
)
=
split_case
var_info_ptr
expr
var_heap
symbol_heap
=
case
split_result
of
Yes
{
case_guards
,
case_default
}
Yes
{
case_guards
,
case_default
,
case_explicit
,
case_ident
}
#
(
case_guards
,
var_heap
,
symbol_heap
,
error
)
=
merge_guards
first_case
.
case_guards
case_guards
var_heap
symbol_heap
error
->
mergeCase
WithCases
nested
(
Case
{
first_case
&
case_guards
=
case_guards
,
case_default
=
case_default
},
NoPos
)
->
mergeCase
s
(
Case
{
first_case
&
case_guards
=
case_guards
,
case_default
=
case_default
,
case_explicit
=
case_explicit
,
case_ident
=
case_ident
},
NoPos
)
exprs
var_heap
symbol_heap
error
No
#
((
case_default
,
pos
),
var_heap
,
symbol_heap
,
error
)
=
mergeCase
WithCases
nested
(
expr
,
expr_pos
)
exprs
var_heap
symbol_heap
error
#
((
case_default
,
pos
),
var_heap
,
symbol_heap
,
error
)
=
mergeCase
s
(
expr
,
expr_pos
)
exprs
var_heap
symbol_heap
error
->
((
Case
{
first_case
&
case_default
=
Yes
case_default
,
case_default_pos
=
pos
},
case_pos
),
var_heap
,
symbol_heap
,
error
)
where
split_case
split_var_info_ptr
(
Case
this_case
=:{
case_expr
=
Var
{
var_info_ptr
},
case_guards
,
case_default
})
var_heap
symbol_heap
split_case
split_var_info_ptr
(
Case
this_case
=:{
case_expr
=
Var
{
var_info_ptr
},
case_guards
,
case_default
,
case_explicit
})
var_heap
symbol_heap
|
split_var_info_ptr
==
skip_alias
var_info_ptr
var_heap
=
(
Yes
this_case
,
var_heap
,
symbol_heap
)
|
has_no_default
case_default
...
...
@@ -324,10 +316,10 @@ where
merge_algebraic_pattern_with_patterns
new_pattern
[
pattern
=:{
ap_symbol
,
ap_vars
,
ap_expr
}
:
patterns
]
var_heap
symbol_heap
error
|
new_pattern
.
ap_symbol
==
ap_symbol
|
isEmpty
new_pattern
.
ap_vars
#
((
ap_expr
,
_),
var_heap
,
symbol_heap
,
error
)
=
merge
Nested
Cases
(
ap_expr
,
NoPos
)
[(
new_pattern
.
ap_expr
,
NoPos
)]
var_heap
symbol_heap
error
#
((
ap_expr
,
_),
var_heap
,
symbol_heap
,
error
)
=
mergeCases
(
ap_expr
,
NoPos
)
[(
new_pattern
.
ap_expr
,
NoPos
)]
var_heap
symbol_heap
error
=
([{
pattern
&
ap_expr
=
ap_expr
}
:
patterns
],
var_heap
,
symbol_heap
,
error
)
#
(
new_expr
,
var_heap
,
symbol_heap
)
=
replace_variables
new_pattern
.
ap_vars
new_pattern
.
ap_expr
ap_vars
var_heap
symbol_heap
((
ap_expr
,
_),
var_heap
,
symbol_heap
,
error
)
=
merge
Nested
Cases
(
ap_expr
,
NoPos
)
[(
new_expr
,
NoPos
)]
var_heap
symbol_heap
error
((
ap_expr
,
_),
var_heap
,
symbol_heap
,
error
)
=
mergeCases
(
ap_expr
,
NoPos
)
[(
new_expr
,
NoPos
)]
var_heap
symbol_heap
error
=
([{
pattern
&
ap_expr
=
ap_expr
}
:
patterns
],
var_heap
,
symbol_heap
,
error
)
#
(
patterns
,
var_heap
,
symbol_heap
,
error
)
=
merge_algebraic_pattern_with_patterns
new_pattern
patterns
var_heap
symbol_heap
error
=
([
pattern
:
patterns
],
var_heap
,
symbol_heap
,
error
)
...
...
@@ -342,7 +334,7 @@ where
where
merge_basic_pattern_with_patterns
new_pattern
[
pattern
=:{
bp_value
,
bp_expr
}
:
patterns
]
var_heap
symbol_heap
error
|
new_pattern
.
bp_value
==
bp_value
#
((
bp_expr
,
_),
var_heap
,
symbol_heap
,
error
)
=
merge
Nested
Cases
(
bp_expr
,
NoPos
)
[(
new_pattern
.
bp_expr
,
NoPos
)]
var_heap
symbol_heap
error
#
((
bp_expr
,
_),
var_heap
,
symbol_heap
,
error
)
=
mergeCases
(
bp_expr
,
NoPos
)
[(
new_pattern
.
bp_expr
,
NoPos
)]
var_heap
symbol_heap
error
=
([{
pattern
&
bp_expr
=
bp_expr
}
:
patterns
],
var_heap
,
symbol_heap
,
error
)
#
(
patterns
,
var_heap
,
symbol_heap
,
error
)
=
merge_basic_pattern_with_patterns
new_pattern
patterns
var_heap
symbol_heap
error
=
([
pattern
:
patterns
],
var_heap
,
symbol_heap
,
error
)
...
...
@@ -389,18 +381,18 @@ where
incompatible_patterns_in_case_error
error
=
checkError
""
"incompatible patterns in case"
error
mergeCase
WithCases
nested
(
case_expr
=:(
Case
first_case
=:{
case_default
,
case_default_pos
,
case_explicit
}),
case_pos
)
[
expr
:
exprs
]
var_heap
symbol_heap
error
|
not
(
nested
&&
case_explicit
)
mergeCase
s
(
case_expr
=:(
Case
first_case
=:{
case_default
,
case_default_pos
,
case_explicit
}),
case_pos
)
[
expr
:
exprs
]
var_heap
symbol_heap
error
|
not
case_explicit
=
case
case_default
of
Yes
default_expr
#
((
default_expr
,
case_default_pos
),
var_heap
,
symbol_heap
,
error
)
=
mergeCase
WithCases
nested
(
default_expr
,
case_default_pos
)
[
expr
:
exprs
]
var_heap
symbol_heap
error
#
((
default_expr
,
case_default_pos
),
var_heap
,
symbol_heap
,
error
)
=
mergeCase
s
(
default_expr
,
case_default_pos
)
[
expr
:
exprs
]
var_heap
symbol_heap
error
->
((
Case
{
first_case
&
case_default
=
Yes
default_expr
,
case_default_pos
=
case_default_pos
},
case_pos
),
var_heap
,
symbol_heap
,
error
)
No
#
((
default_expr
,
pos
),
var_heap
,
symbol_heap
,
error
)
=
mergeCase
WithCases
nested
expr
exprs
var_heap
symbol_heap
error
#
((
default_expr
,
pos
),
var_heap
,
symbol_heap
,
error
)
=
mergeCase
s
expr
exprs
var_heap
symbol_heap
error
->
((
Case
{
first_case
&
case_default
=
Yes
default_expr
,
case_default_pos
=
pos
},
case_pos
),
var_heap
,
symbol_heap
,
error
)
mergeCase
WithCases
_
expr_and_pos
_
var_heap
symbol_heap
error
mergeCase
s
expr_and_pos
_
var_heap
symbol_heap
error
=
(
expr_and_pos
,
var_heap
,
symbol_heap
,
checkWarning
""
" alternative will never match"
error
)
isOverloaded
(
OverloadedList
_
_
_
_)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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