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
a42774b8
Commit
a42774b8
authored
Jan 19, 2000
by
Sjaak Smetsers
Browse files
bug fix (changed syntax tree)
parent
3583d352
Changes
11
Hide whitespace changes
Inline
Side-by-side
frontend/check.icl
View file @
a42774b8
...
...
@@ -1402,7 +1402,7 @@ where
#
(
let_expr_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
(
var_binds
,
expr_heap
)
=
build_binds
vars
[]
expr_heap
let_binds
=
[{
bind_src
=
expr
,
bind_dst
=
hd
vars
}:
var_binds
]
=
(
Let
{
let_strict
=
cIsNotStrict
,
let
_binds
=
let_binds
,
let_expr
=
result_expr
,
let_info_ptr
=
let_expr_ptr
},
expr_heap
)
=
(
Let
{
let_strict
_binds
=
[],
let_lazy
_binds
=
let_binds
,
let_expr
=
result_expr
,
let_info_ptr
=
let_expr_ptr
},
expr_heap
)
where
build_binds
[
var
]
accu
expr_heap
=
(
accu
,
expr_heap
)
...
...
@@ -1673,7 +1673,9 @@ buildLetExpression [] is_strict expr expr_heap
=
(
expr
,
expr_heap
)
buildLetExpression
binds
is_strict
expr
expr_heap
#
(
let_expr_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
=
(
Let
{
let_strict
=
is_strict
,
let_binds
=
binds
,
let_expr
=
expr
,
let_info_ptr
=
let_expr_ptr
},
expr_heap
)
|
is_strict
=
(
Let
{
let_strict_binds
=
binds
,
let_lazy_binds
=
[],
let_expr
=
expr
,
let_info_ptr
=
let_expr_ptr
},
expr_heap
)
=
(
Let
{
let_strict_binds
=
[],
let_lazy_binds
=
binds
,
let_expr
=
expr
,
let_info_ptr
=
let_expr_ptr
},
expr_heap
)
checkLhssOfLocalDefs
def_level
mod_index
(
CollectedLocalDefs
{
loc_functions
={
ir_from
,
ir_to
},
loc_nodes
})
e_state
=:{
es_var_heap
,
es_fun_defs
}
e_info
cs
#
(
loc_defs
,
var_env
,
{
ps_fun_defs
,
ps_var_heap
},
e_info
,
cs
)
...
...
@@ -2063,14 +2065,14 @@ where
|
bind_dst
==
fv_info_ptr
#
(
var_expr_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
(
let_expr_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
->
(
Let
{
let_
strict
=
cIsStrict
,
le
t_binds
=
[
->
(
Let
{
let_
lazy_binds
=
[],
let_stric
t_binds
=
[
{
bind_src
=
Var
{
var_name
=
fv_name
,
var_info_ptr
=
fv_info_ptr
,
var_expr_ptr
=
var_expr_ptr
},
bind_dst
=
{
fv_name
=
name
,
fv_info_ptr
=
var_info
,
fv_def_level
=
NotALevel
,
fv_count
=
0
}}],
let_expr
=
result_expr
,
let_info_ptr
=
let_expr_ptr
},
var_store
,
expr_heap
,
opt_dynamics
,
cs
)
#
(
var_expr_ptr1
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
(
var_expr_ptr2
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
(
let_expr_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
->
(
Let
{
let_
strict
=
cIsStrict
,
le
t_binds
=
[
->
(
Let
{
let_
lazy_binds
=
[],
let_stric
t_binds
=
[
{
bind_src
=
Var
{
var_name
=
fv_name
,
var_info_ptr
=
fv_info_ptr
,
var_expr_ptr
=
var_expr_ptr1
},
bind_dst
=
{
fv_name
=
name
,
fv_info_ptr
=
var_info
,
fv_def_level
=
NotALevel
,
fv_count
=
0
}},
{
bind_src
=
Var
{
var_name
=
fv_name
,
var_info_ptr
=
fv_info_ptr
,
var_expr_ptr
=
var_expr_ptr2
},
...
...
@@ -2081,7 +2083,7 @@ where
->
(
result_expr
,
var_store
,
expr_heap
,
opt_dynamics
,
cs
)
#
(
var_expr_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
(
let_expr_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
->
(
Let
{
let_
strict
=
cIsStrict
,
le
t_binds
=
->
(
Let
{
let_
lazy_binds
=
[],
let_stric
t_binds
=
[{
bind_src
=
Var
{
var_name
=
fv_name
,
var_info_ptr
=
fv_info_ptr
,
var_expr_ptr
=
var_expr_ptr
},
bind_dst
=
{
fv_name
=
name
,
fv_info_ptr
=
var_info
,
fv_def_level
=
NotALevel
,
fv_count
=
0
}}],
let_expr
=
result_expr
,
let_info_ptr
=
let_expr_ptr
},
var_store
,
expr_heap
,
opt_dynamics
,
cs
)
...
...
@@ -2122,7 +2124,7 @@ where
(
var_expr_ptr2
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
(
let_expr_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
=
(
Var
{
var_name
=
fv_name
,
var_info_ptr
=
fv_info_ptr
,
var_expr_ptr
=
var_expr_ptr1
},
Let
{
let_strict
=
cIsNotStrict
,
let
_binds
=
Let
{
let_strict
_binds
=
[],
let_lazy
_binds
=
[{
bind_src
=
Var
{
var_name
=
fv_name
,
var_info_ptr
=
fv_info_ptr
,
var_expr_ptr
=
var_expr_ptr2
},
bind_dst
=
{
fv_name
=
bind_src
,
fv_info_ptr
=
bind_dst
,
fv_def_level
=
NotALevel
,
fv_count
=
0
}}],
let_expr
=
result_expr
,
let_info_ptr
=
let_expr_ptr
},
expr_heap
)
...
...
frontend/convertDynamics.icl
View file @
a42774b8
...
...
@@ -118,12 +118,13 @@ where
#
(
expr
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
expr
ci
(
exprs
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
exprs
ci
=
(
expr
@
exprs
,
ci
)
convertDynamics
cinp
bound_vars
default_expr
(
Let
letje
=:{
let_binds
,
let_expr
,
let_info_ptr
})
ci
convertDynamics
cinp
bound_vars
default_expr
(
Let
letje
=:{
let_
strict_binds
,
let_lazy_
binds
,
let_expr
,
let_info_ptr
})
ci
#
(
let_types
,
ci
)
=
determine_let_types
let_info_ptr
ci
bound_vars
=
bindVarsToTypes
[
bind
.
bind_dst
\\
bind
<-
let_binds
]
let_types
bound_vars
(
let_binds
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
let_binds
ci
(
let_expr
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
let_expr
ci
=
(
Let
{
letje
&
let_binds
=
let_binds
,
let_expr
=
let_expr
},
ci
)
bound_vars
=
bindVarsToTypes
[
bind
.
bind_dst
\\
bind
<-
let_strict_binds
++
let_lazy_binds
]
let_types
bound_vars
(
let_strict_binds
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
let_strict_binds
ci
(
let_lazy_binds
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
let_lazy_binds
ci
(
let_expr
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
let_expr
ci
=
(
Let
{
letje
&
let_strict_binds
=
let_strict_binds
,
let_lazy_binds
=
let_lazy_binds
,
let_expr
=
let_expr
},
ci
)
where
determine_let_types
let_info_ptr
ci
=:{
ci_expr_heap
}
#
(
EI_LetType
let_types
,
ci_expr_heap
)
=
readPtr
let_info_ptr
ci_expr_heap
...
...
@@ -183,12 +184,12 @@ where
app_args
=
[
dyn_expr
,
dyn_type_code
],
app_info_ptr
=
nilPtr
},
ci
)
_
#
(
let_info_ptr
,
ci
)
=
let_ptr
ci
->
(
Let
{
let_strict
=
False
,
let_binds
=
let_binds
,
let_expr
=
App
{
app_symb
=
twoTuple_symb
,
app_args
=
[
dyn_expr
,
dyn_type_code
],
app_info_ptr
=
nilPtr
},
let_info_ptr
=
let_info_ptr
},
ci
)
->
(
Let
{
let_strict
_binds
=
[]
,
let_
lazy_
binds
=
let_binds
,
let_expr
=
App
{
app_symb
=
twoTuple_symb
,
app_args
=
[
dyn_expr
,
dyn_type_code
],
app_info_ptr
=
nilPtr
},
let_info_ptr
=
let_info_ptr
},
ci
)
convertDynamics
cinp
bound_vars
default_expr
(
TypeCodeExpression
type_code
)
ci
=
convertTypecode
cinp
type_code
ci
convertDynamics
cinp
bound_vars
default_expr
EE
ci
...
...
@@ -283,7 +284,7 @@ convertDynamicPatterns cinp bound_vars {case_expr, case_guards = DynamicPatterns
(
addToBoundVars
c_1
result_type
(
add_dynamic_bound_vars
patterns
bound_vars
)))
(
binds
,
expr
,
ci
)
=
convert_dynamic_pattern
cinp
bound_vars
new_default
1
opened_dynamic
result_type
case_default
patterns
ci
(
let_info_ptr
,
ci
)
=
let_ptr
ci
=
(
Let
{
let_strict
=
False
,
let
_binds
=
[
dt_bind
:
binds
],
let_expr
=
expr
,
let_info_ptr
=
let_info_ptr
},
ci
)
=
(
Let
{
let_strict
_binds
=
[],
let_lazy
_binds
=
[
dt_bind
:
binds
],
let_expr
=
expr
,
let_info_ptr
=
let_info_ptr
},
ci
)
where
convert_dynamic_pattern
::
!
ConversionInput
!
BoundVariables
DefaultExpression
Int
OpenedDynamic
AType
(
Optional
Expression
)
![
DynamicPattern
]
*
ConversionInfo
->
(
Env
Expression
FreeVar
,
Expression
,
*
ConversionInfo
)
...
...
@@ -320,8 +321,8 @@ where
(
let_binds
,
ci
)
=
bind_indirection_var
ind_var
unify_result_var
twotuple
ci
a_ij_binds
=
add_x_i_bind
opened_dynamic
.
opened_dynamic_expr
dp_var
a_ij_binds
let_expr
=
Let
{
let_strict
=
False
,
let_binds
=
[{
bind_src
=
App
{
app_symb
=
unify_symb
,
app_args
=
[
opened_dynamic
.
opened_dynamic_type
,
type_code
],
app_info_ptr
=
nilPtr
},
let_expr
=
Let
{
let_strict
_binds
=
[]
,
let_
lazy_
binds
=
[{
bind_src
=
App
{
app_symb
=
unify_symb
,
app_args
=
[
opened_dynamic
.
opened_dynamic_type
,
type_code
],
app_info_ptr
=
nilPtr
},
bind_dst
=
unify_result_fv
},
{
bind_src
=
TupleSelect
twotuple
0
(
Var
unify_result_var
),
bind_dst
=
unify_bool_fv
}
:
let_binds
...
...
frontend/convertcases.icl
View file @
a42774b8
...
...
@@ -42,13 +42,16 @@ where
instance
convertCases
Let
where
convertCases
bound_vars
group_index
common_defs
lad
=:{
let_binds
,
let_expr
,
let_info_ptr
}
ci
=:{
ci_expr_heap
}
convertCases
bound_vars
group_index
common_defs
lad
=:{
let_
strict_binds
,
let_lazy_
binds
,
let_expr
,
let_info_ptr
}
ci
=:{
ci_expr_heap
}
#
(
let_info
,
ci_expr_heap
)
=
readPtr
let_info_ptr
ci_expr_heap
ci
=
{
ci
&
ci_expr_heap
=
ci_expr_heap
}
=
case
let_info
of
EI_LetType
let_type
#
((
let_binds
,
let_expr
),
ci
)
=
convertCases
(
addLetVars
let_binds
let_type
bound_vars
)
group_index
common_defs
(
let_binds
,
let_expr
)
ci
->
({
lad
&
let_binds
=
let_binds
,
let_expr
=
let_expr
},
ci
)
#
bound_vars
=
addLetVars
(
let_strict_binds
++
let_lazy_binds
)
let_type
bound_vars
#
(
let_strict_binds
,
ci
)
=
convertCases
bound_vars
group_index
common_defs
let_strict_binds
ci
#
(
let_lazy_binds
,
ci
)
=
convertCases
bound_vars
group_index
common_defs
let_lazy_binds
ci
#
(
let_expr
,
ci
)
=
convertCases
bound_vars
group_index
common_defs
let_expr
ci
->
({
lad
&
let_strict_binds
=
let_strict_binds
,
let_lazy_binds
=
let_lazy_binds
,
let_expr
=
let_expr
},
ci
)
_
->
abort
"convertCases [Let] (convertcases 53)"
// <<- let_info
...
...
@@ -483,7 +486,7 @@ where
convert_function
group_index
dcl_functions
common_defs
fun
(
fun_defs
,
collected_imports
,
ci
)
#!
fun_def
=
fun_defs
.[
fun
]
#
{
fun_body
,
fun_type
}
=
fun_def
(
fun_body
,
(
collected_imports
,
ci
))
=
eliminate_code_sharing_in_function
dcl_functions
common_defs
(
fun_body
==
>
(
"convert_function"
,
fun_def
.
fun_symb
))
(
collected_imports
,
ci
)
(
fun_body
,
(
collected_imports
,
ci
))
=
eliminate_code_sharing_in_function
dcl_functions
common_defs
fun_body
/*
(fun_body
---
> ("convert_function", fun_def.fun_symb
, fun_body
))
*/
(
collected_imports
,
ci
)
(
fun_body
,
ci
)
=
convert_cases_into_function_patterns
fun_body
fun_type
group_index
common_defs
ci
=
({
fun_defs
&
[
fun
]
=
{
fun_def
&
fun_body
=
fun_body
}},
collected_imports
,
ci
)
...
...
@@ -635,12 +638,13 @@ where
(
sd_type
,
imported_types
,
conses
,
type_heaps
,
var_heap
)
=
convertSymbolType
common_defs
sd_type
imported_types
conses
type_heaps
var_heap
=
(
imported_types
,
conses
,
type_heaps
,
var_heap
<:=
(
sd_type_ptr
,
VI_ExpandedType
sd_type
))
convertRootExpression
bound_vars
group_index
common_defs
default_ptr
(
Let
lad
=:{
let_binds
,
let_expr
,
let_info_ptr
})
ci
=:{
ci_expr_heap
}
convertRootExpression
bound_vars
group_index
common_defs
default_ptr
(
Let
lad
=:{
let_
strict_binds
,
let_lazy_
binds
,
let_expr
,
let_info_ptr
})
ci
=:{
ci_expr_heap
}
#
(
EI_LetType
let_type
,
ci_expr_heap
)
=
readPtr
let_info_ptr
ci_expr_heap
bound_vars
=
addLetVars
let_binds
let_type
bound_vars
(
let_binds
,
ci
)
=
convertCases
bound_vars
group_index
common_defs
let_binds
{
ci
&
ci_expr_heap
=
ci_expr_heap
}
(
let_expr
,
ci
)
=
convertRootExpression
bound_vars
group_index
common_defs
default_ptr
let_expr
ci
=
(
Let
{
lad
&
let_binds
=
let_binds
,
let_expr
=
let_expr
},
ci
)
bound_vars
=
addLetVars
(
let_strict_binds
++
let_lazy_binds
)
let_type
bound_vars
(
let_strict_binds
,
ci
)
=
convertCases
bound_vars
group_index
common_defs
let_strict_binds
{
ci
&
ci_expr_heap
=
ci_expr_heap
}
(
let_lazy_binds
,
ci
)
=
convertCases
bound_vars
group_index
common_defs
let_lazy_binds
ci
(
let_expr
,
ci
)
=
convertRootExpression
bound_vars
group_index
common_defs
default_ptr
let_expr
ci
=
(
Let
{
lad
&
let_strict_binds
=
let_strict_binds
,
let_lazy_binds
=
let_lazy_binds
,
let_expr
=
let_expr
},
ci
)
convertRootExpression
bound_vars
group_index
common_defs
default_ptr
(
Case
kees
=:{
case_expr
,
case_guards
,
case_default
,
case_info_ptr
})
ci
=
case
case_guards
of
BasicPatterns
BT_Bool
patterns
...
...
@@ -760,7 +764,7 @@ where
{
cp_info
&
cp_free_vars
=
[
(
var_info_ptr
,
type
)
:
cp_info
.
cp_free_vars
],
cp_var_heap
=
cp_var_heap
<:=
(
var_info_ptr
,
VI_FreeVar
var_name
new_info_ptr
1
type
)
})
_
->
abort
"copy [BoundVar] (convertcases, 612)"
//
<<- (var_info ---> (var_name, ptrToInt var_info_ptr))
->
abort
"copy [BoundVar] (convertcases, 612)"
<<-
(
var_info
--->
(
var_name
,
ptrToInt
var_info_ptr
))
instance
copy
Expression
where
...
...
@@ -773,10 +777,13 @@ where
copy
(
fun_expr
@
exprs
)
cp_info
#
((
fun_expr
,
exprs
),
cp_info
)
=
copy
(
fun_expr
,
exprs
)
cp_info
=
(
fun_expr
@
exprs
,
cp_info
)
copy
(
Let
lad
=:{
let_binds
,
let_expr
})
cp_info
=:{
cp_var_heap
,
cp_local_vars
}
#
(
cp_local_vars
,
cp_var_heap
)
=
foldSt
bind_let_var
let_binds
(
cp_local_vars
,
cp_var_heap
)
#
((
let_binds
,
let_expr
),
cp_info
)
=
copy
(
let_binds
,
let_expr
)
{
cp_info
&
cp_var_heap
=
cp_var_heap
,
cp_local_vars
=
cp_local_vars
}
=
(
Let
{
lad
&
let_expr
=
let_expr
,
let_binds
=
let_binds
},
cp_info
)
copy
(
Let
lad
=:{
let_strict_binds
,
let_lazy_binds
,
let_expr
})
cp_info
=:{
cp_var_heap
,
cp_local_vars
}
#
(
cp_local_vars
,
cp_var_heap
)
=
foldSt
bind_let_var
let_strict_binds
(
cp_local_vars
,
cp_var_heap
)
#
(
cp_local_vars
,
cp_var_heap
)
=
foldSt
bind_let_var
let_lazy_binds
(
cp_local_vars
,
cp_var_heap
)
#
(
let_strict_binds
,
cp_info
)
=
copy
let_strict_binds
{
cp_info
&
cp_var_heap
=
cp_var_heap
,
cp_local_vars
=
cp_local_vars
}
#
(
let_lazy_binds
,
cp_info
)
=
copy
let_lazy_binds
cp_info
#
(
let_expr
,
cp_info
)
=
copy
let_expr
cp_info
=
(
Let
{
lad
&
let_strict_binds
=
let_strict_binds
,
let_lazy_binds
=
let_lazy_binds
,
let_expr
=
let_expr
},
cp_info
)
where
bind_let_var
{
bind_dst
}
(
local_vars
,
var_heap
)
=
([
bind_dst
:
local_vars
],
var_heap
<:=
(
bind_dst
.
fv_info_ptr
,
VI_LocalVar
))
...
...
@@ -977,7 +984,8 @@ where
=
weightedRefCount
dcl_functions
common_defs
depth
app
rc_info
weightedRefCount
dcl_functions
common_defs
depth
(
fun_expr
@
exprs
)
rc_info
=
weightedRefCount
dcl_functions
common_defs
depth
(
fun_expr
,
exprs
)
rc_info
weightedRefCount
dcl_functions
common_defs
depth
(
Let
{
let_binds
,
let_expr
,
let_info_ptr
})
rc_info
=:{
rc_var_heap
}
weightedRefCount
dcl_functions
common_defs
depth
(
Let
{
let_strict_binds
,
let_lazy_binds
,
let_expr
,
let_info_ptr
})
rc_info
=:{
rc_var_heap
}
#
let_binds
=
let_strict_binds
++
let_lazy_binds
#
rc_info
=
weightedRefCount
dcl_functions
common_defs
depth
let_expr
{
rc_info
&
rc_var_heap
=
foldSt
store_binding
let_binds
rc_var_heap
}
(
let_info
,
rc_expr_heap
)
=
readPtr
let_info_ptr
rc_info
.
rc_expr_heap
rc_info
=
{
rc_info
&
rc_expr_heap
=
rc_expr_heap
}
...
...
@@ -1270,24 +1278,22 @@ where
distributeLets
depth
(
TupleSelect
tuple_symbol
arg_nr
expr
)
dl_info
#
(
expr
,
dl_info
)
=
distributeLets
depth
expr
dl_info
=
(
TupleSelect
tuple_symbol
arg_nr
expr
,
dl_info
)
distributeLets
depth
(
Let
lad
=:{
let_binds
,
let_
expr
,
let_strict
,
let_info_ptr
})
dl_info
=:{
di_expr_heap
,
di_var_heap
}
distributeLets
depth
(
Let
lad
=:{
let_
strict_
binds
,
let_
lazy_binds
,
let_expr
,
let_info_ptr
})
dl_info
=:{
di_expr_heap
,
di_var_heap
}
#
(
let_info
,
di_expr_heap
)
=
readPtr
let_info_ptr
di_expr_heap
ok
=
case
let_info
of
EI_LetTypeAndRefCounts
let_type
ref_counts
->
True
x
->
abort
(
"abort [distributeLets (EI_LetTypeAndRefCounts)]"
)
// ->> x)
|
ok
#
(
EI_LetTypeAndRefCounts
let_type
ref_counts
)
=
let_info
di_var_heap
=
set_let_expression_info
depth
let_strict
let_binds
ref_counts
let_type
di_var_heap
(
let_expr
,
dl_info
)
=
distributeLets
depth
let_expr
{
dl_info
&
di_var_heap
=
di_var_heap
,
di_expr_heap
=
di_expr_heap
}
=
(
let_expr
,
foldSt
(
distribute_lets_in_non_distributed_let
depth
)
let_binds
dl_info
)
=
undef
#
(
EI_LetTypeAndRefCounts
let_type
ref_counts
)
=
let_info
let_binds
=
[(
True
,
bind
)
\\
bind
<-
let_strict_binds
]
++
[(
False
,
bind
)
\\
bind
<-
let_lazy_binds
]
di_var_heap
=
set_let_expression_info
depth
let_binds
ref_counts
let_type
di_var_heap
(
let_expr
,
dl_info
)
=
distributeLets
depth
let_expr
{
dl_info
&
di_var_heap
=
di_var_heap
,
di_expr_heap
=
di_expr_heap
}
dl_info
=
foldSt
(
distribute_lets_in_non_distributed_let
depth
)
let_strict_binds
dl_info
dl_info
=
foldSt
(
distribute_lets_in_non_distributed_let
depth
)
let_lazy_binds
dl_info
=
(
let_expr
,
dl_info
)
where
set_let_expression_info
depth
let_strict
[
{
bind_src
,
bind_dst
}:
binds
][
ref_count
:
ref_counts
][
type
:
types
]
var_heap
set_let_expression_info
depth
[(
let_strict
,
{
bind_src
,
bind_dst
}
)
:
binds
][
ref_count
:
ref_counts
][
type
:
types
]
var_heap
#
(
new_info_ptr
,
var_heap
)
=
newPtr
VI_Empty
var_heap
lei
=
{
lei_count
=
ref_count
,
lei_depth
=
depth
,
lei_strict
=
let_strict
,
/* lei_moved = False, */
lei_var
=
{
bind_dst
&
fv_info_ptr
=
new_info_ptr
},
lei_expression
=
bind_src
,
lei_type
=
type
,
lei_status
=
LES_Untouched
}
=
set_let_expression_info
depth
let_strict
binds
ref_counts
types
(
var_heap
<:=
(
bind_dst
.
fv_info_ptr
,
VI_LetExpression
lei
))
set_let_expression_info
depth
let_strict
[]
_
_
var_heap
=
set_let_expression_info
depth
binds
ref_counts
types
(
var_heap
<:=
(
bind_dst
.
fv_info_ptr
,
VI_LetExpression
lei
))
set_let_expression_info
depth
[]
_
_
var_heap
=
var_heap
distribute_lets_in_non_distributed_let
depth
{
bind_dst
={
fv_name
,
fv_info_ptr
}}
dl_info
=:{
di_var_heap
}
...
...
@@ -1422,18 +1428,10 @@ distributeLetsInLetExpression depth let_var_info_ptr lei=:{lei_expression, lei_s
buildLetExpr
::
![
VarInfoPtr
]
!
Expression
!*(!*
VarHeap
,
!*
ExpressionHeap
)
->
(!
Expression
,
!(!*
VarHeap
,
!*
ExpressionHeap
))
buildLetExpr
let_vars
let_expr
(
var_heap
,
expr_heap
)
#
(
strict_binds
,
strict_bind_types
,
lazy_binds
,
lazy_binds_types
,
var_heap
)
=
foldr
build_bind
([],
[],
[],
[],
var_heap
)
let_vars
|
isEmpty
strict_binds
|
isEmpty
lazy_binds
=
(
let_expr
,
(
var_heap
,
expr_heap
))
#
(
let_info_ptr
,
expr_heap
)
=
newPtr
(
EI_LetType
lazy_binds_types
)
expr_heap
=
(
Let
{
let_binds
=
lazy_binds
,
let_strict
=
cIsNotStrict
,
let_expr
=
let_expr
,
let_info_ptr
=
let_info_ptr
},
(
var_heap
,
expr_heap
))
|
isEmpty
lazy_binds
#
(
let_info_ptr
,
expr_heap
)
=
newPtr
(
EI_LetType
strict_bind_types
)
expr_heap
=
(
Let
{
let_binds
=
strict_binds
,
let_strict
=
cIsStrict
,
let_expr
=
let_expr
,
let_info_ptr
=
let_info_ptr
},
(
var_heap
,
expr_heap
))
#
(
strict_let_info_ptr
,
expr_heap
)
=
newPtr
(
EI_LetType
strict_bind_types
)
expr_heap
(
lazy_let_info_ptr
,
expr_heap
)
=
newPtr
(
EI_LetType
lazy_binds_types
)
expr_heap
=
(
Let
{
let_binds
=
strict_binds
,
let_strict
=
cIsStrict
,
let_info_ptr
=
strict_let_info_ptr
,
let_expr
=
Let
{
let_binds
=
lazy_binds
,
let_strict
=
cIsNotStrict
,
let_info_ptr
=
lazy_let_info_ptr
,
let_expr
=
let_expr
}},
(
var_heap
,
expr_heap
))
|
isEmpty
strict_binds
&&
isEmpty
lazy_binds
=
(
let_expr
,
(
var_heap
,
expr_heap
))
#
(
let_info_ptr
,
expr_heap
)
=
newPtr
(
EI_LetType
(
strict_bind_types
++
lazy_binds_types
))
expr_heap
=
(
Let
{
let_strict_binds
=
strict_binds
,
let_lazy_binds
=
lazy_binds
,
let_expr
=
let_expr
,
let_info_ptr
=
let_info_ptr
},
(
var_heap
,
expr_heap
))
where
build_bind
::
!
VarInfoPtr
!(!
Env
Expression
FreeVar
,
![
AType
],
!
Env
Expression
FreeVar
,
![
AType
],
!*
VarHeap
)
...
...
frontend/explicitimports.icl
View file @
a42774b8
...
...
@@ -788,8 +788,8 @@ instance consequences InstanceType
consequences
{
it_types
,
it_context
}
=
consequences
it_types
++
consequences
it_context
instance
consequences
Let
where
consequences
{
let_binds
,
let_expr
}
=
consequences
let_expr
++(
flatten
[
consequences
bind_src
\\
{
bind_src
}<-
let_binds
]
)
where
consequences
{
let_
strict_binds
,
let_lazy_
binds
,
let_expr
}
=
consequences
let_expr
++(
flatten
[
consequences
bind_src
\\
{
bind_src
}<-
let_
strict_binds
++
let_lazy_
binds
]
)
instance
consequences
MemberDef
where
...
...
frontend/overloading.icl
View file @
a42774b8
...
...
@@ -1018,9 +1018,11 @@ where
updateExpression
group_index
type_contexts
(
expr
@
exprs
)
ui
#
((
expr
,
exprs
),
ui
)
=
updateExpression
group_index
type_contexts
(
expr
,
exprs
)
ui
=
(
expr
@
exprs
,
ui
)
updateExpression
group_index
type_contexts
(
Let
lad
=:{
let_binds
,
let_expr
})
ui
#
((
let_binds
,
let_expr
),
ui
)
=
updateExpression
group_index
type_contexts
(
let_binds
,
let_expr
)
ui
=
(
Let
{
lad
&
let_binds
=
let_binds
,
let_expr
=
let_expr
},
ui
)
updateExpression
group_index
type_contexts
(
Let
lad
=:{
let_lazy_binds
,
let_strict_binds
,
let_expr
})
ui
#
(
let_lazy_binds
,
ui
)
=
updateExpression
group_index
type_contexts
let_lazy_binds
ui
#
(
let_strict_binds
,
ui
)
=
updateExpression
group_index
type_contexts
let_strict_binds
ui
#
(
let_expr
,
ui
)
=
updateExpression
group_index
type_contexts
let_expr
ui
=
(
Let
{
lad
&
let_lazy_binds
=
let_lazy_binds
,
let_strict_binds
=
let_strict_binds
,
let_expr
=
let_expr
},
ui
)
updateExpression
group_index
type_contexts
(
Case
kees
=:{
case_expr
,
case_guards
,
case_default
})
ui
#
((
case_expr
,(
case_guards
,
case_default
)),
ui
)
=
updateExpression
group_index
type_contexts
(
case_expr
,(
case_guards
,
case_default
))
ui
=
(
Case
{
kees
&
case_expr
=
case_expr
,
case_guards
=
case_guards
,
case_default
=
case_default
},
ui
)
...
...
frontend/refmark.icl
View file @
a42774b8
...
...
@@ -95,19 +95,20 @@ where
=
refMark
free_vars
NotASelector
app_args
var_heap
refMark
free_vars
sel
(
fun
@
args
)
var_heap
=
refMark
free_vars
NotASelector
args
(
refMark
free_vars
NotASelector
fun
var_heap
)
refMark
free_vars
sel
(
Let
{
let_strict
,
let_binds
,
let_expr
})
var_heap
#
let_vars
=
[
bind_dst
\\
{
bind_dst
}
<-
let_binds
]
new_free_vars
=
[
let_vars
:
free_vars
]
|
let_strict
#
(
observing
,
var_heap
)
=
binds_are_observing
let_binds
var_heap
refMark
free_vars
sel
(
Let
{
let_strict_binds
,
let_lazy_binds
,
let_expr
})
var_heap
|
isEmpty
let_lazy_binds
#
new_free_vars
=
[
[
bind_dst
\\
{
bind_dst
}
<-
let_strict_binds
]
:
free_vars
]
#
(
observing
,
var_heap
)
=
binds_are_observing
let_strict_binds
var_heap
|
observing
#
var_heap
=
saveOccurrences
free_vars
var_heap
var_heap
=
refMark
new_free_vars
NotASelector
let_binds
var_heap
var_heap
=
refMark
new_free_vars
NotASelector
let_
strict_
binds
var_heap
var_heap
=
saveOccurrences
new_free_vars
var_heap
var_heap
=
refMark
new_free_vars
sel
let_expr
var_heap
=
let_combine
free_vars
var_heap
=
refMark
new_free_vars
sel
let_expr
(
refMark
new_free_vars
NotASelector
let_binds
var_heap
)
#
var_heap
=
foldSt
bind_variable
let_binds
var_heap
=
refMark
new_free_vars
sel
let_expr
(
refMark
new_free_vars
NotASelector
let_strict_binds
var_heap
)
#
new_free_vars
=
[
[
bind_dst
\\
{
bind_dst
}
<-
let_strict_binds
++
let_lazy_binds
]
:
free_vars
]
var_heap
=
foldSt
bind_variable
let_strict_binds
var_heap
var_heap
=
foldSt
bind_variable
let_lazy_binds
var_heap
=
refMark
new_free_vars
sel
let_expr
var_heap
where
...
...
frontend/syntax.dcl
View file @
a42774b8
...
...
@@ -1025,13 +1025,21 @@ cIsNotStrict :== False
,
case_ident
::
!
Optional
Ident
,
case_info_ptr
::
!
ExprInfoPtr
}
/*
:: Let =
{ let_strict :: !Bool
, let_binds :: !(Env Expression FreeVar)
, let_expr :: !Expression
, let_info_ptr :: !ExprInfoPtr
}
*/
::
Let
=
{
let_strict_binds
::
!
Env
Expression
FreeVar
,
let_lazy_binds
::
!
Env
Expression
FreeVar
,
let_expr
::
!
Expression
,
let_info_ptr
::
!
ExprInfoPtr
}
::
Conditional
=
{
if_cond
::
!
Expression
...
...
frontend/syntax.icl
View file @
a42774b8
...
...
@@ -964,13 +964,12 @@ cIsNotStrict :== False
}
::
Let
=
{
let_strict
::
!
Bool
,
let_binds
::
!
(
Env
Expression
FreeVar
)
,
let_expr
::
!
Expression
,
let_info_ptr
::
!
ExprInfoPtr
{
let_strict
_binds
::
!
Env
Expression
FreeVar
,
let_
lazy_
binds
::
!
Env
Expression
FreeVar
,
let_expr
::
!
Expression
,
let_info_ptr
::
!
ExprInfoPtr
}
::
DynamicExpr
=
{
dyn_expr
::
!
Expression
,
dyn_opt_type
::
!
Optional
DynamicType
...
...
@@ -1332,7 +1331,7 @@ where
// = file <<< app_symb <<< ' ' <<< app_args
=
file
<<<
app_symb
<<<
" <"
<<<
ptrToInt
app_info_ptr
<<<
"> "
<<<
app_args
(<<<)
file
(
f_exp
@
a_exp
)
=
file
<<<
'('
<<<
f_exp
<<<
" @ "
<<<
a_exp
<<<
')'
(<<<)
file
(
Let
{
let_info_ptr
,
let_binds
,
let_expr
})
=
write_binds
(
file
<<<
"let"
<<<
'\n'
)
let_
binds
<<<
"in
\n
"
<<<
let_expr
(<<<)
file
(
Let
{
let_info_ptr
,
let_
strict_binds
,
let_lazy_
binds
,
let_expr
})
=
write_binds
(
file
<<<
"let"
<<<
'\n'
)
(
let_
strict_binds
++
let_lazy_binds
)
<<<
"in
\n
"
<<<
let_expr
where
write_binds
file
[]
=
file
...
...
frontend/trans.icl
View file @
a42774b8
...
...
@@ -220,7 +220,8 @@ instance consumerRequirements Expression where
#
(
cc_fun
,
_,
ai
)
=
consumerRequirements
fun_expr
common_defs
ai
ai_class_subst
=
unifyClassifications
cActive
cc_fun
ai
.
ai_class_subst
=
consumerRequirements
exprs
common_defs
{
ai
&
ai_class_subst
=
ai_class_subst
}
consumerRequirements
(
Let
{
let_binds
,
let_expr
})
common_defs
ai
=:{
ai_next_var
,
ai_next_var_of_fun
,
ai_var_heap
}
consumerRequirements
(
Let
{
let_strict_binds
,
let_lazy_binds
,
let_expr
})
common_defs
ai
=:{
ai_next_var
,
ai_next_var_of_fun
,
ai_var_heap
}
#
let_binds
=
let_strict_binds
++
let_lazy_binds
#
(
new_next_var
,
new_ai_next_var_of_fun
,
ai_var_heap
)
=
init_variables
let_binds
ai_next_var
ai_next_var_of_fun
ai_var_heap
#
ai
=
acc_requirements_of_let_binds
let_binds
ai_next_var
common_defs
{
ai
&
ai_next_var
=
new_next_var
,
ai_next_var_of_fun
=
new_ai_next_var_of_fun
,
ai_var_heap
=
ai_var_heap
}
...
...
@@ -646,13 +647,15 @@ where
->
transformApplication
app
exprs
ro
ti
_
->
(
expr
@
exprs
,
ti
)
transform
(
Let
lad
=:{
let_binds
,
let_expr
})
ro
ti
transform
(
Let
lad
=:{
let_
strict_binds
,
let_lazy_
binds
,
let_expr
})
ro
ti
#
ti
=
store_type_info_of_bindings_in_heap
lad
ti
(
let_binds
,
ti
)
=
transform
let_binds
ro
ti
(
let_strict_binds
,
ti
)
=
transform
let_strict_binds
ro
ti
(
let_lazy_binds
,
ti
)
=
transform
let_lazy_binds
ro
ti
(
let_expr
,
ti
)
=
transform
let_expr
ro
ti
=
(
Let
{
lad
&
let_binds
=
let_binds
,
let_expr
=
let_expr
},
ti
)
=
(
Let
{
lad
&
let_
lazy_
binds
=
let_
lazy_binds
,
let_strict_binds
=
let_strict_
binds
,
let_expr
=
let_expr
},
ti
)
where
store_type_info_of_bindings_in_heap
{
let_binds
,
let_info_ptr
}
ti
store_type_info_of_bindings_in_heap
{
let_strict_binds
,
let_lazy_binds
,
let_info_ptr
}
ti
#
let_binds
=
let_strict_binds
++
let_lazy_binds
#
(
EI_LetType
var_types
,
ti_symbol_heap
)
=
readExprInfo
let_info_ptr
ti
.
ti_symbol_heap
ti_var_heap
=
foldSt
(\(
var_type
,
{
bind_dst
={
fv_info_ptr
}})
var_heap
->
setExtendedVarInfo
fv_info_ptr
(
EVI_VarType
var_type
)
var_heap
)
...
...
@@ -800,9 +803,10 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
Let
lad
|
not
is_active
->
skip_over
this_case
ro
ti
#
(
new_let_binds
,
ti
)
=
transform
lad
.
let_binds
{
ro
&
ro_root_case_mode
=
NotRootCase
}
ti
#
(
let_strict_binds
,
ti
)
=
transform
lad
.
let_strict_binds
{
ro
&
ro_root_case_mode
=
NotRootCase
}
ti
(
let_lazy_binds
,
ti
)
=
transform
lad
.
let_lazy_binds
{
ro
&
ro_root_case_mode
=
NotRootCase
}
ti
(
new_let_expr
,
ti
)
=
transform
(
Case
{
this_case
&
case_expr
=
lad
.
let_expr
})
ro
ti
->
(
Let
{
lad
&
let_expr
=
new_let_expr
,
let_binds
=
new_let
_binds
},
ti
)
->
(
Let
{
lad
&
let_expr
=
new_let_expr
,
let_
strict_
binds
=
let_strict_binds
,
let_lazy_binds
=
let_lazy
_binds
},
ti
)
_
->
skip_over
this_case
ro
ti
where
equal
(
SK_Function
glob_index1
)
(
SK_Function
glob_index2
)
...
...
@@ -917,10 +921,10 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
#
{
cons_type
}
=
ro
.
ro_common_defs
.[
glob_module
].
com_cons_defs
.[
glob_index
]
let_type
=
filterWith
not_unfoldable
cons_type
.
st_args
(
new_info_ptr
,
ti_symbol_heap
)
=
newPtr
(
EI_LetType
let_type
)
ti_symbol_heap
=
(
Let
{
let_strict
=
False
,
let_binds
=
[
{
bind_src
=
bind_src
,
bind_dst
=
bind_dst
}
\\
(
bind_dst
,
bind_src
)<-
non_unfoldable_args
]
,
let_expr
=
ap_expr
,
let_info_ptr
=
new_info_ptr
=
(
Let
{
let_strict
_binds
=
[]
,
let_
lazy_
binds
=
[
{
bind_src
=
bind_src
,
bind_dst
=
bind_dst
}
\\
(
bind_dst
,
bind_src
)<-
non_unfoldable_args
]
,
let_expr
=
ap_expr
,
let_info_ptr
=
new_info_ptr
}
,
ti_symbol_heap
)
...
...
@@ -2088,8 +2092,9 @@ where
=
freeVariables
app_args
fvi
freeVariables
(
fun
@
args
)
fvi
=
freeVariables
args
(
freeVariables
fun
fvi
)
freeVariables
(
Let
{
let_binds
,
let_expr
,
let_info_ptr
})
fvi
=:{
fvi_variables
=
global_variables
}
#
(
removed_variables
,
fvi_var_heap
)
=
removeVariables
global_variables
fvi
.
fvi_var_heap
freeVariables
(
Let
{
let_strict_binds
,
let_lazy_binds
,
let_expr
,
let_info_ptr
})
fvi
=:{
fvi_variables
=
global_variables
}
#
let_binds
=
let_strict_binds
++
let_lazy_binds
(
removed_variables
,
fvi_var_heap
)
=
removeVariables
global_variables
fvi
.
fvi_var_heap
fvi
=
freeVariables
let_binds
{
fvi
&
fvi_variables
=
[],
fvi_var_heap
=
fvi_var_heap
}
{
fvi_expr_heap
,
fvi_variables
,
fvi_var_heap
,
fvi_expr_ptrs
}
=
freeVariables
let_expr
fvi
(
fvi_variables
,
fvi_var_heap
)
=
removeLocalVariables
[
bind_dst
\\
{
bind_dst
}
<-
let_binds
]
fvi_variables
[]
fvi_var_heap
...
...
frontend/transform.icl
View file @
a42774b8
...
...
@@ -43,9 +43,11 @@ where
lift
(
expr
@
exprs
)
ls
#
((
expr
,
exprs
),
ls
)
=
lift
(
expr
,
exprs
)
ls
=
(
expr
@
exprs
,
ls
)
lift
(
Let
lad
=:{
let_binds
,
let_expr
})
ls
#
((
let_binds
,
let_expr
),
ls
)
=
lift
(
let_binds
,
let_expr
)
ls
=
(
Let
{
lad
&
let_binds
=
let_binds
,
let_expr
=
let_expr
},
ls
)
lift
(
Let
lad
=:{
let_strict_binds
,
let_lazy_binds
,
let_expr
})
ls
#
(
let_strict_binds
,
ls
)
=
lift
let_strict_binds
ls
(
let_lazy_binds
,
ls
)
=
lift
let_lazy_binds
ls
(
let_expr
,
ls
)
=
lift
let_expr
ls
=
(
Let
{
lad
&
let_strict_binds
=
let_strict_binds
,
let_lazy_binds
=
let_lazy_binds
,
let_expr
=
let_expr
},
ls
)
lift
(
Case
case_expr
)
ls
#
(
case_expr
,
ls
)
=
lift
case_expr
ls
=
(
Case
case_expr
,
ls
)
...
...
@@ -406,13 +408,16 @@ where
instance
unfold
Let
where
unfold
lad
=:{
let_binds
,
let_expr
,
let_info_ptr
}
us
#
(
let_binds
,
us
)
=
copy_bound_vars
let_binds
us
#
((
let_binds
,
let_expr
),
us
)
=
unfold
(
let_binds
,
let_expr
)
us
unfold
lad
=:{
let_strict_binds
,
let_lazy_binds
,
let_expr
,
let_info_ptr
}
us
#
(
let_strict_binds
,
us
)
=
copy_bound_vars
let_strict_binds
us
#
(
let_lazy_binds
,
us
)
=
copy_bound_vars
let_lazy_binds
us
#
(
let_strict_binds
,
us
)
=
unfold
let_strict_binds
us
#
(
let_lazy_binds
,
us
)
=
unfold
let_lazy_binds
us
#
(
let_expr
,
us
)
=
unfold
let_expr
us
(
old_let_info
,
us_symbol_heap
)
=
readPtr
let_info_ptr
us
.
us_symbol_heap
(
new_let_info
,
us_opt_type_heaps
)
=
substitute_let_or_case_type
old_let_info
us
.
us_opt_type_heaps
(
new_info_ptr
,
us_symbol_heap
)
=
newPtr
new_let_info
us_symbol_heap
=
({
lad
&
let_binds
=
let_binds
,
let_expr
=
let_expr
,
let_info_ptr
=
new_info_ptr
},
=
({
lad
&
let_
strict_
binds
=
let_
strict_binds
,
let_lazy_binds
=
let_lazy_
binds
,
let_expr
=
let_expr
,
let_info_ptr
=
new_info_ptr
},
{
us
&
us_symbol_heap
=
us_symbol_heap
,
us_opt_type_heaps
=
us_opt_type_heaps
})
where
copy_bound_vars
[
bind
=:{
bind_dst
}
:
binds
]
us
...
...
@@ -498,7 +503,7 @@ unfoldMacro {fun_body = TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls}}
|
isEmpty
let_binds
=
(
result_expr
,
fun_defs
,
(
calls
,
{
es
&
es_var_heap
=
us_var_heap
,
es_symbol_heap
=
us_symbol_heap
,
es_symbol_table
=
es_symbol_table
}))
#
(
new_info_ptr
,
us_symbol_heap
)
=
newPtr
EI_Empty
us_symbol_heap
=
(
Let
{
let_strict
=
cIsNotStrict
,
let
_binds
=
let_binds
,
let_expr
=
result_expr
,
let_info_ptr
=
new_info_ptr
},
fun_defs
,
=
(
Let
{
let_strict
_binds
=
[],
let_lazy
_binds
=
let_binds
,
let_expr
=
result_expr
,
let_info_ptr
=
new_info_ptr
},
fun_defs
,
(
calls
,
{
es
&
es_var_heap
=
us_var_heap
,
es_symbol_heap
=
us_symbol_heap
,
es_symbol_table
=
es_symbol_table
}))
where
...
...
@@ -1033,9 +1038,11 @@ where
expand
(
expr
@
exprs
)
fun_and_macro_defs
mod_index
modules
es
#
((
expr
,
exprs
),
fun_and_macro_defs
,
modules
,
es
)
=
expand
(
expr
,
exprs
)
fun_and_macro_defs
mod_index
modules
es
=
(
expr
@
exprs
,
fun_and_macro_defs
,
modules
,
es
)
expand
(
Let
lad
=:{
let_binds
,
let_expr
})
fun_and_macro_defs
mod_index
modules
es
#
((
let_binds
,
let_expr
),
fun_and_macro_defs
,
modules
,
es
)
=
expand
(
let_binds
,
let_expr
)
fun_and_macro_defs
mod_index
modules
es
=
(
Let
{
lad
&
let_expr
=
let_expr
,
let_binds
=
let_binds
},
fun_and_macro_defs
,
modules
,
es
)
expand
(
Let
lad
=:{
let_strict_binds
,
let_lazy_binds
,
let_expr
})
fun_and_macro_defs
mod_index
modules
es
#
(
let_strict_binds
,
fun_and_macro_defs
,
modules
,
es
)
=
expand
let_strict_binds
fun_and_macro_defs
mod_index
modules
es
#
(
let_lazy_binds
,
fun_and_macro_defs
,
modules
,
es
)
=
expand
let_lazy_binds
fun_and_macro_defs
mod_index
modules
es
#
(
let_expr
,
fun_and_macro_defs
,
modules
,
es
)
=
expand
let_expr
fun_and_macro_defs
mod_index
modules
es
=
(
Let
{
lad
&
let_expr
=
let_expr
,
let_strict_binds
=
let_strict_binds
,
let_lazy_binds
=
let_lazy_binds
},
fun_and_macro_defs
,
modules
,
es
)
expand
(
Case
case_expr
)
fun_and_macro_defs
mod_index
modules
es
#
(
case_expr
,
fun_and_macro_defs
,
modules
,
es
)
=
expand
case_expr
fun_and_macro_defs
mod_index
modules
es
=
(
Case
case_expr
,
fun_and_macro_defs
,
modules
,
es
)
...
...
@@ -1177,17 +1184,21 @@ where
collectVariables
(
expr
@
exprs
)
free_vars
cos
#
((
expr
,
exprs
),
free_vars
,
cos
)
=
collectVariables
(
expr
,
exprs
)
free_vars
cos
=
(
expr
@
exprs
,
free_vars
,
cos
)
collectVariables
(
Let
lad
=:{
let_binds
,
let_expr
})
free_vars
cos
=:{
cos_var_heap
}
#
cos_var_heap
=
determine_aliases
let_binds
cos_var_heap
(
is_cyclic
,
let_binds
,
cos_var_heap
)
=
detect_cycles_and_remove_alias_binds
let_binds
cos_var_heap
|
is_cyclic
=
(
Let
{
lad
&
let_binds
=
let_binds
},
free_vars
,
{
cos
&
cos_var_heap
=
cos_var_heap
,
cos_error
=
checkError
""
"cyclic let definition"
cos
.
cos_error
})
collectVariables
(
Let
lad
=:{
let_strict_binds
,
let_lazy_binds
,
let_expr
})
free_vars
cos
=:{
cos_var_heap
}
#
cos_var_heap
=
determine_aliases
let_strict_binds
cos_var_heap
#
cos_var_heap
=
determine_aliases
let_lazy_binds
cos_var_heap
(
is_cyclic_s
,
let_strict_binds
,
cos_var_heap
)
=
detect_cycles_and_remove_alias_binds
let_strict_binds
cos_var_heap
(
is_cyclic_l
,
let_lazy_binds
,
cos_var_heap
)
=
detect_cycles_and_remove_alias_binds
let_lazy_binds
cos_var_heap
|
is_cyclic_s
||
is_cyclic_l
=
(
Let
{
lad
&
let_strict_binds
=
let_strict_binds
,
let_lazy_binds
=
let_lazy_binds
},
free_vars
,
{
cos
&
cos_var_heap
=
cos_var_heap
,
cos_error
=
checkError
""
"cyclic let definition"
cos
.
cos_error
})
|
otherwise
#
(
let_expr
,
free_vars
,
cos
)
=
collectVariables
let_expr
free_vars
{
cos
&
cos_var_heap
=
cos_var_heap
}
(
let_binds
,
free_vars
,
cos
)
=
collect_variables_in_binds
let_binds
[]
free_vars
cos
|
isEmpty
let_binds
#
(
let_expr
,
free_vars
,
cos
)
=
collectVariables
let_expr
free_vars
{
cos
&
cos_var_heap
=
cos_var_heap
}