Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
16
Issues
16
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
clean-compiler-and-rts
compiler
Commits
403517b9
Commit
403517b9
authored
Dec 12, 2001
by
Ronny Wichers Schreur
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
fixed bugs in merging explicit cases
parent
3018f259
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
22 additions
and
30 deletions
+22
-30
frontend/checkFunctionBodies.icl
frontend/checkFunctionBodies.icl
+5
-5
frontend/mergecases.icl
frontend/mergecases.icl
+17
-25
No files found.
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
Markdown
is supported
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