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
91f39a06
Commit
91f39a06
authored
Dec 02, 2002
by
Diederik van Arkel
Browse files
add strictness annotations
parent
b214320a
Changes
3
Expand all
Hide whitespace changes
Inline
Side-by-side
frontend/classify.icl
View file @
91f39a06
...
...
@@ -437,6 +437,7 @@ instance consumerRequirements Case where
_
->
False
// use_context_default = not (case_explicit || has_default)
combine_counts
::
!
Int
!*{#
Int
}
!{#
Int
}
->
*{#
Int
}
combine_counts
0
accu
env
=
accu
combine_counts
i
accu
env
...
...
@@ -446,10 +447,12 @@ instance consumerRequirements Case where
accu
=
{
accu
&
[
i1
]
=
unify_counts
rca
rce
}
=
combine_counts
i1
accu
env
where
unify_counts
::
!
Int
!
Int
->
Int
unify_counts
0
x
=
x
unify_counts
1
x
=
if
(
x
==
2
)
2
(
inc
x
)
unify_counts
2
x
=
2
inspect_patterns
::
!{#.
CommonDefs
}
!.
Bool
!.
CasePatterns
![.
Bool
]
->
(!.
Bool
,!
Bool
)
inspect_patterns
common_defs
has_default
(
AlgebraicPatterns
{
glob_object
,
glob_module
}
algebraic_patterns
)
unsafe_bits
#
type_def
=
common_defs
.[
glob_module
].
com_type_defs
.[
glob_object
]
defined_symbols
=
case
type_def
.
td_rhs
of
...
...
@@ -535,6 +538,7 @@ instance consumerRequirements Case where
=
True
=
multimatch_loop
has_default
(
dropWhile
(\(
ds_index
,_,_)->
ds_index
==
cip
)
constructors_in_pattern
)
combine_pattern_counts
::
!.
Bool
!.
CasePatterns
![.
Bool
]
![{#.
Int
}]
!{#
Int
}
->
*{#
Int
}
combine_pattern_counts
has_default
patterns
unsafe_bits
guard_counts
default_counts
|
not
ok_pattern_type
=
createArray
(
size
default_counts
)
2
...
...
@@ -575,6 +579,7 @@ where
count_size
=
size
default_counts
zero_array
=
createArray
count_size
0
sort3
::
!.[
Int
]
!.[
a
]
!.[
b
]
->
.[(!
Int
,!
Int
,!
a
,!
b
)]
sort3
constr_indices
unsafe_bits
counts
=
sortBy
smaller
(
zip4
constr_indices
[
0
..]
unsafe_bits
counts
)
where
...
...
@@ -587,7 +592,7 @@ where
zip4
_
_
_
_
=
[]
count_loop
::
RefCounts
RefCounts
[(
Int
,
Int
,
Bool
,
RefCounts
)]
->
*
RefCounts
count_loop
::
!
RefCounts
!
RefCounts
!
[(
!
Int
,
!
Int
,
!
Bool
,
!
RefCounts
)]
->
*
RefCounts
count_loop
default_counts
unified_counts
[]
=
{
e
\\
e
<-:
unified_counts
}
count_loop
default_counts
unified_counts
[(
c_index
,
p_index
,
unsafe
,
counts
):
patterns
]
...
...
@@ -597,7 +602,7 @@ where
_
->
counts
=
count_loop
default_counts
(
unify_counts
ccount
unified_counts
)
next
where
splitWhile
::
(
a
->
.
Bool
)
!
u
:[
a
]
->
(.[
a
],
v
:[
a
]),
[
u
<=
v
];
splitWhile
::
!
(
a
->
.
Bool
)
!
u
:[
a
]
->
(
!
.[
a
],
!
v
:[
a
]),
[
u
<=
v
];
splitWhile
f
[]
=
([],[])
splitWhile
f
cons
=:[
a
:
x
]
...
...
@@ -606,7 +611,7 @@ where
=
([
a
:
t
],
d
)
=
([],
cons
)
count_constructor
::
RefCounts
RefCounts
[(
Int
,
Int
,
Bool
,
RefCounts
)]
->
RefCounts
count_constructor
::
!
RefCounts
!
RefCounts
!
[(
!
Int
,
!
Int
,
!
Bool
,
!
RefCounts
)]
->
RefCounts
count_constructor
default_counts
combined_counts
[]
=
combine_counts
combined_counts
default_counts
count_constructor
default_counts
combined_counts
[(_,_,
unsafe
,
counts
):
patterns
]
...
...
@@ -614,7 +619,7 @@ where
=
count_constructor
default_counts
(
combine_counts
combined_counts
counts
)
patterns
=
combine_counts
combined_counts
counts
combine_counts
::
RefCounts
RefCounts
->
RefCounts
combine_counts
::
!
RefCounts
!
RefCounts
->
RefCounts
combine_counts
c1
c2
=
{
unify_counts
e1
e2
\\
e1
<-:
c1
&
e2
<-:
c2
}
where
...
...
@@ -627,10 +632,12 @@ where
accu
=
{
accu
&
[
i1
]
=
unify_counts
rca
rce
}
=
combine
i1
accu
env
unify_counts
::
!
Int
!
Int
->
Int
unify_counts
0
x
=
x
unify_counts
1
x
=
if
(
x
==
2
)
2
(
inc
x
)
unify_counts
2
x
=
2
unify_counts
::
!
RefCounts
!
RefCounts
->
*
RefCounts
unify_counts
c1
c2
=
{
unify_counts
e1
e2
\\
e1
<-:
c1
&
e2
<-:
c2
}
where
...
...
@@ -644,11 +651,13 @@ where
accu
=
{
accu
&
[
i1
]
=
unify_counts
rce
rca
}
=
unify
i1
accu
env
unify_counts
::
!
Int
!
Int
->
Int
unify_counts
0
x
=
x
unify_counts
1
x
=
if
(
x
==
0
)
1
x
unify_counts
2
x
=
2
//consumer_requirements_of_guards :: !CasePatterns ConsumerAnalysisRO !*AnalyseInfo -> (!Int,.[Bool],!*AnalyseInfo)
consumer_requirements_of_guards
::
!.
CasePatterns
!.
ConsumerAnalysisRO
!*
AnalyseInfo
->
*(!
Int
,!.[
Bool
],![{#
Int
}],!*
AnalyseInfo
)
consumer_requirements_of_guards
(
AlgebraicPatterns
type
patterns
)
common_defs
ai
#
pattern_exprs
=
[
ap_expr
\\
{
ap_expr
}<-
patterns
]
...
...
@@ -686,7 +695,7 @@ bindPatternVars [fv=:{fv_info_ptr,fv_count} : vars] next_var next_var_of_fun var
bindPatternVars
[]
next_var
next_var_of_fun
var_heap
=
(
next_var
,
next_var_of_fun
,
var_heap
)
independentConsumerRequirements
::
!.[
Expression
]
ConsumerAnalysisRO
!*
AnalyseInfo
->
(!
ConsClass
,.[
Bool
],[
RefCounts
],!*
AnalyseInfo
)
independentConsumerRequirements
::
!.[
Expression
]
!
ConsumerAnalysisRO
!*
AnalyseInfo
->
(!
ConsClass
,
!
.[
Bool
],
!
[
RefCounts
],!*
AnalyseInfo
)
independentConsumerRequirements
exprs
info
ai
#
ref_counts
=
ai
.
ai_cur_ref_counts
#
(
count_size
,
ref_counts
)
=
usize
ref_counts
...
...
@@ -695,6 +704,7 @@ independentConsumerRequirements exprs info ai
#
(
counts
,
unsafe
)
=
unzip
counts_unsafe
=
(
cc
,
unsafe
,
counts
,{
ai
&
ai_cur_ref_counts
=
ref_counts
})
where
cons_reqs
::
!
Expression
!*(!.
Int
,!*
AnalyseInfo
)
->
*(!.(!{#
Int
},!
Bool
),!*(!
Int
,!*
AnalyseInfo
))
cons_reqs
expr
(
cc
,
ai
)
#
(
cce
,
unsafe
,
ai
)
=
consumerRequirements
expr
info
ai
#
cc
=
combineClasses
cce
cc
...
...
@@ -1214,17 +1224,19 @@ reanalyseFunction fun fun_info_ptr common_defs imported_funs main_dcl_module_n s
=
(
fun_cons_class
,
fun_defs
,
ai
.
ai_var_heap
,
ai
.
ai_fun_heap
,
ai_cons_class
)
fresh_variables
::
![.
FreeVar
]
!
Int
!
Int
!*(
Heap
VarInfo
)
->
*(!.[
Int
],!
Int
,!*(
Heap
VarInfo
))
fresh_variables
[{
fv_info_ptr
}
:
vars
]
arg_position
next_var_number
var_heap
#
var_heap
=
writePtr
fv_info_ptr
(
VI_AccVar
next_var_number
arg_position
)
var_heap
#
(
fresh_vars
,
last_var_number
,
var_heap
)
=
fresh_variables
vars
(
inc
arg_position
)
(
inc
next_var_number
)
var_heap
var_heap
=
writePtr
fv_info_ptr
(
VI_AccVar
next_var_number
arg_position
)
var_heap
=
([
next_var_number
:
fresh_vars
],
last_var_number
,
var_heap
)
fresh_variables
[]
_
next_var_number
var_heap
=
([],
next_var_number
,
var_heap
)
// count_locals determines number of local variables...
count_locals
::
!
Expression
!
Int
->
Int
count_locals
(
Var
_)
n
=
n
count_locals
(
App
{
app_args
})
n
...
...
frontend/trans.icl
View file @
91f39a06
This diff is collapsed.
Click to expand it.
frontend/transform.icl
View file @
91f39a06
...
...
@@ -923,8 +923,11 @@ unfoldMacro {fun_body =fun_body=: TransformedBody {tb_args,tb_rhs}, fun_info = {
with
new_fun_defs
::
*{!
FunDef
}
new_fun_defs
=>
{
fun_def
\\
(_,
fun_def
)<-
new_functions
}
->
({
if
(
i
<
size_fun_defs
)
es_fun_defs
.[
i
]
new_fun_defs
.[
i
-
size_fun_defs
]
\\
i
<-[
0
..
last_function_index
]}
// inefficient
,[
size_fun_defs
:
es_new_fun_def_numbers
])
// -> ({if (i<size_fun_defs) es_fun_defs.[i] new_fun_defs.[i-size_fun_defs] \\ i<-[0..last_function_index]} // inefficient
// ,[size_fun_defs:es_new_fun_def_numbers])
// #! new_fun_defs = arrayConcat es_fun_defs new_fun_defs // leads to backend crash!
#
new_fun_defs
=
arrayConcat
es_fun_defs
new_fun_defs
->
(
new_fun_defs
,
[
size_fun_defs
:
es_new_fun_def_numbers
])
#
(
calls
,
fun_defs
,
es_symbol_table
)
=
updateFunctionCalls
fi_calls
calls
es_fun_defs
es_symbol_table
|
isEmpty
let_binds
=
(
result_expr
,
(
calls
,
{
es
&
es_symbol_table
=
es_symbol_table
,
es_fun_defs
=
fun_defs
,
es_new_fun_def_numbers
=
es_new_fun_def_numbers
}))
...
...
@@ -1787,7 +1790,7 @@ where
Dynamic administration is rebuilt.
*/
class
collectVariables
a
::
!
a
![
FreeVar
]
![
DynamicPtr
]
!*
CollectState
->
(!
a
,
![
FreeVar
],[
DynamicPtr
],!*
CollectState
)
class
collectVariables
a
::
!
a
![
FreeVar
]
![
DynamicPtr
]
!*
CollectState
->
(!
a
,
![
FreeVar
],
!
[
DynamicPtr
],!*
CollectState
)
cContainsACycle
:==
True
cContainsNoCycle
:==
False
...
...
@@ -1807,7 +1810,7 @@ where
#
(
kase
,
cos
)
=
if_expression
e1
(
BasicExpr
(
BVB
True
))
e2
cos
=
(
kase
,
free_vars
,
dynamics
,
cos
)
where
if_expression
::
Expression
Expression
Expression
*
CollectState
->
(!
Expression
,!.
CollectState
);
if_expression
::
!
Expression
!
Expression
!
Expression
!
*
CollectState
->
(!
Expression
,!.
CollectState
);
if_expression
e1
e2
e3
cos
// # (new_info_ptr,symbol_heap) = newPtr EI_Empty cos.cos_symbol_heap
#
case_type
=
...
...
@@ -1903,6 +1906,7 @@ where
/* Remove all aliases from the list of lazy 'let'-binds. Add a _dummyForStrictAlias
function call for the strict aliases. Be careful with cycles! */
detect_cycles_and_handle_alias_binds
::
!.
Bool
!
u
:[
v
:(.
a
,
w
:
LetBind
)]
!*
CollectState
->
(!.
Bool
,!
x
:[
y
:(.
a
,
z
:
LetBind
)],!.
CollectState
),
[
u
<=
x
,
v
<=
y
,
w
<=
z
]
detect_cycles_and_handle_alias_binds
is_strict
[]
cos
=
(
cContainsNoCycle
,
[],
cos
)
// detect_cycles_and_handle_alias_binds is_strict [bind=:{bind_dst={fv_info_ptr}} : binds] cos
...
...
@@ -1925,6 +1929,7 @@ where
#
(
is_cyclic
,
binds
,
cos
)
=
detect_cycles_and_handle_alias_binds
is_strict
binds
cos
->
(
is_cyclic
,
[(
type
,
bind
)
:
binds
],
cos
)
where
is_cyclic
::
!.(
Ptr
VarInfo
)
!(
Ptr
VarInfo
)
!(
Heap
VarInfo
)
->
.
Bool
is_cyclic
orig_info_ptr
info_ptr
var_heap
|
orig_info_ptr
==
info_ptr
=
True
...
...
@@ -1935,6 +1940,7 @@ where
_
->
False
add_dummy_id_for_strict_alias
::
!.
Expression
!*
CollectState
->
(!.
Expression
,!.
CollectState
)
add_dummy_id_for_strict_alias
bind_src
cos
=:{
cos_symbol_heap
,
cos_predef_symbols_for_transform
}
#
(
new_app_info_ptr
,
cos_symbol_heap
)
=
newPtr
EI_Empty
cos_symbol_heap
{
pds_module
,
pds_def
}
=
cos_predef_symbols_for_transform
.
predef_alias_dummy
...
...
@@ -1948,12 +1954,14 @@ where
by examining the reference count.
*/
collect_variables_in_binds
::
![(.
a
,.
b
,.
LetBind
)]
!
u
:[
v
:(.
a
,.
b
,
w
:
LetBind
)]
![
FreeVar
]
![(
Ptr
ExprInfo
)]
!*
CollectState
->
(!
x
:[
y
:(.
a
,.
b
,
z
:
LetBind
)],![
FreeVar
],![(
Ptr
ExprInfo
)],!.
CollectState
),
[
u
<=
x
,
v
<=
y
,
w
<=
z
]
collect_variables_in_binds
binds
collected_binds
free_vars
dynamics
cos
#
(
continue
,
binds
,
collected_binds
,
free_vars
,
dynamics
,
cos
)
=
examine_reachable_binds
False
binds
collected_binds
free_vars
dynamics
cos
|
continue
=
collect_variables_in_binds
binds
collected_binds
free_vars
dynamics
cos
=
(
collected_binds
,
free_vars
,
dynamics
,
cos
)
examine_reachable_binds
::
!
u
:
Bool
![
v
:(.
a
,.
b
,
w
:
LetBind
)]
!
x
:[
y
:(.
a
,.
b
,
z
:
LetBind
)]
![.
FreeVar
]
![.(
Ptr
ExprInfo
)]
!*
CollectState
->
*(!
u0
:
Bool
,![
v0
:(.
a
,.
b
,
w0
:
LetBind
)],!
x0
:[
y0
:(.
a
,.
b
,
z0
:
LetBind
)],![
FreeVar
],![(
Ptr
ExprInfo
)],!*
CollectState
),
[
u
<=
u0
,
v
<=
v0
,
w
<=
w0
,
x
<=
x0
,
y
<=
y0
,
z
<=
z0
]
examine_reachable_binds
bind_found
[
bind
=:(
is_strict
,
type
,
letb
=:{
lb_dst
=
fv
=:{
fv_info_ptr
},
lb_src
})
:
binds
]
collected_binds
free_vars
dynamics
cos
#
(
bind_found
,
binds
,
collected_binds
,
free_vars
,
dynamics
,
cos
)
=
examine_reachable_binds
bind_found
binds
collected_binds
free_vars
dynamics
cos
#
(
VI_Count
count
is_global
,
cos_var_heap
)
=
readPtr
fv_info_ptr
cos
.
cos_var_heap
...
...
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