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
b94e5f7b
Commit
b94e5f7b
authored
Oct 01, 2001
by
Diederik van Arkel
Browse files
Add fusion commandline flag
parent
089cde2b
Changes
7
Hide whitespace changes
Inline
Side-by-side
frontend/compilerSwitches.dcl
View file @
b94e5f7b
...
...
@@ -5,8 +5,6 @@ PA_BUG on off :== off
switch_import_syntax
one_point_three
two_point_zero
:==
one_point_three
/* when finally removing this switch also remove the argument of STE_Instance and ID_OldSyntax */
SwitchFusion
fuse
dont_fuse
:==
dont_fuse
SwitchPreprocessor
preprocessor
no_preprocessor
:==
preprocessor
// MV...
...
...
frontend/compilerSwitches.icl
View file @
b94e5f7b
...
...
@@ -5,8 +5,6 @@ PA_BUG on off :== off
switch_import_syntax
one_point_three
two_point_zero
:==
one_point_three
/* when finally removing this switch also remove the argument of STE_Instance and ID_OldSyntax */
SwitchFusion
fuse
dont_fuse
:==
dont_fuse
SwitchPreprocessor
preprocessor
no_preprocessor
:==
preprocessor
// MV...
...
...
frontend/frontend.dcl
View file @
b94e5f7b
...
...
@@ -8,8 +8,9 @@ from general import Optional, Yes, No
import
checksupport
,
transform
,
overloading
::
FrontEndOptions
=
{
feo_up_to_phase
::
!
FrontEndPhase
,
feo_generics
::
!
Bool
=
{
feo_up_to_phase
::
!
FrontEndPhase
,
feo_generics
::
!
Bool
,
feo_fusion
::
!
Bool
}
::
FrontEndSyntaxTree
...
...
frontend/frontend.icl
View file @
b94e5f7b
...
...
@@ -10,7 +10,8 @@ SwitchGenerics on off :== off
::
FrontEndOptions
=
{
feo_up_to_phase
::
!
FrontEndPhase
,
feo_generics
::
!
Bool
,
feo_generics
::
!
Bool
,
feo_fusion
::
!
Bool
}
::
FrontEndSyntaxTree
...
...
@@ -234,8 +235,10 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an
# (cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap)
= analyseGroups common_defs imported_funs array_instances.ali_instances_range main_dcl_module_n stdStrictLists_module_n (components -*-> "Analyse") fun_defs var_heap expression_heap
// # (components, fun_defs, error) = showComponents2 components 0 fun_defs acc_args error
(components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
= transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n (components -*-> "Transform") fun_defs acc_args common_defs imported_funs dcl_types used_conses_in_dynamics type_def_infos var_heap type_heaps expression_heap
= transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n (components -*-> "Transform") fun_defs acc_args common_defs imported_funs dcl_types used_conses_in_dynamics type_def_infos var_heap type_heaps expression_heap
options.feo_fusion
| options.feo_up_to_phase == FrontEndPhaseTransformGroups
# heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap}
...
...
@@ -345,18 +348,21 @@ where
= show_component funs show_types fun_defs (file <<< fun_def)
// = show_component funs show_types fun_defs (file <<< fun_def.fun_symb)
showComponents2 :: !{! Group} !Int !*{# FunDef} !{! ConsClasses} !*File -> (!*{# FunDef},!*File)
showComponents2 :: !
*
{! Group} !Int !*{# FunDef} !{! ConsClasses} !*File -> (!*{
! Group},!*{
# FunDef},!*File)
showComponents2 comps comp_index fun_defs acc_args file
| comp_index >= (size comps)
= (fun_defs, file)
# (fun_defs, file) = show_component comps.[comp_index].group_members fun_defs acc_args file
= (comps, fun_defs, file)
# (comp, comps) = comps![comp_index]
# (fun_defs, file) = show_component comp.group_members fun_defs acc_args file
= showComponents2 comps (inc comp_index) fun_defs acc_args file
where
show_component [] fun_defs _ file
= (fun_defs, file <<< '\n')
show_component [fun:funs] fun_defs acc_args file
# (fd, fun_defs) = fun_defs![fun]
# file = show_accumulating_arguments acc_args.[fun].cc_args (file <<< fd.fun_symb <<< '.' <<< fun <<< " (")
# file = file <<< fd.fun_symb <<< '.' <<< fun <<< " ("
# file = show_accumulating_arguments acc_args.[fun].cc_args file
# file = show_linear_arguments acc_args.[fun].cc_linear_bits file
= show_component funs fun_defs acc_args (file <<< ") ")
show_accumulating_arguments [ cc : ccs] file
...
...
@@ -366,10 +372,19 @@ where
= show_accumulating_arguments ccs (file <<< 'c')
| cc == cAccumulating
= show_accumulating_arguments ccs (file <<< 'a')
| cc == cVarOfMultimatchCase
= show_accumulating_arguments ccs (file <<< 'm')
= show_accumulating_arguments ccs (file <<< '?')
show_accumulating_arguments [] file
= file
show_linear_arguments [ cc : ccs] file
| cc == True
= show_linear_arguments ccs (file <<< 'l')
= show_linear_arguments ccs (file <<< 'n')
show_linear_arguments [] file
= file
//show_components comps fun_defs = map (show_component fun_defs) comps
show_component fun_defs [] = []
...
...
frontend/trans.dcl
View file @
b94e5f7b
...
...
@@ -4,9 +4,10 @@ import StdEnv
import
syntax
,
transform
cPassive
:==
-1
cActive
:==
-2
cAccumulating
:==
-3
cPassive
:==
-1
cActive
:==
-2
cAccumulating
:==
-3
cVarOfMultimatchCase
:==
-4
::
CleanupInfo
...
...
@@ -14,7 +15,7 @@ analyseGroups :: !{# CommonDefs} !{#{#FunType}} !IndexRange !Int !Int !*{! Group
->
(!
CleanupInfo
,
!*{!
ConsClasses
},
!*{!
Group
},
!*{#
FunDef
},
!*
VarHeap
,
!*
ExpressionHeap
)
transformGroups
::
!
CleanupInfo
!
Int
!
Int
!*{!
Group
}
!*{#
FunDef
}
!{!.
ConsClasses
}
!{#
CommonDefs
}
!{#
{#
FunType
}
}
!*{#{#
CheckedTypeDef
}}
!
ImportedConstructors
!*
TypeDefInfos
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
!*{#{#
CheckedTypeDef
}}
!
ImportedConstructors
!*
TypeDefInfos
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
!
Bool
->
(!*{!
Group
},
!*{#
FunDef
},
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
)
partitionateFunctions
::
!*{#
FunDef
}
![
IndexRange
]
->
(!*{!
Group
},
!*{#
FunDef
})
...
...
frontend/trans.icl
View file @
b94e5f7b
...
...
@@ -2,8 +2,13 @@ implementation module trans
import
StdEnv
import
syntax
,
transform
,
checksupport
,
StdCompare
,
check
,
utilities
,
unitype
,
typesupport
,
type
,
compilerSwitches
import
syntax
,
transform
,
checksupport
,
StdCompare
,
check
,
utilities
,
unitype
,
typesupport
,
type
SwitchCaseFusion
fuse
dont_fuse
:==
fuse
SwitchGeneratedFusion
fuse
dont_fuse
:==
fuse
SwitchFunctionFusion
fuse
dont_fuse
:==
fuse
SwitchConstructorFusion
fuse
dont_fuse
:==
fuse
SwitchCurriedFusion
fuse
dont_fuse
:==
fuse
::
PartitioningInfo
=
{
pi_marks
::
!.{#
Int
}
...
...
@@ -13,6 +18,9 @@ import syntax, transform, checksupport, StdCompare, check, utilities, unitype, t
,
pi_deps
::
![
Int
]
}
(-!->)
infix
::
!.
a
!
b
->
.
a
|
<<<
b
(-!->)
a
b
=
a
// ---> b
NotChecked
:==
-1
implies
a
b
:==
not
a
||
b
...
...
@@ -451,10 +459,6 @@ instance consumerRequirements Case where
=
True
=
multimatch_loop
has_default
(
dropWhile
(\(
ds_index
,_,_)->
ds_index
==
cip
)
constructors_in_pattern
)
instance
consumerRequirements
DynamicExpr
where
consumerRequirements
{
dyn_expr
}
common_defs
ai
=
consumerRequirements
dyn_expr
common_defs
ai
bindPatternVars
[
fv
=:{
fv_info_ptr
,
fv_count
}
:
vars
]
next_var
next_var_of_fun
var_heap
|
fv_count
>
0
=
bindPatternVars
vars
(
inc
next_var
)
(
inc
next_var_of_fun
)
(
writePtr
fv_info_ptr
(
VI_AccVar
next_var
next_var_of_fun
)
var_heap
)
...
...
@@ -478,6 +482,37 @@ consumer_requirements_of_guards (OverloadedListPatterns type _ patterns) common_
ai
=
{
ai
&
ai_var_heap
=
ai_var_heap
,
ai_next_var
=
ai_next_var
,
ai_next_var_of_fun
=
ai_next_var_of_fun
}
=
independentConsumerRequirements
pattern_exprs
common_defs
ai
independentConsumerRequirements
exprs
common_defs
ai
=:{
ai_cur_ref_counts
}
// reference counting happens independently for each pattern expression
#!
s
=
size
ai_cur_ref_counts
zero_array
=
createArray
s
0
(_,
cc
,
r_unsafe_bits
,
ai
)
=
foldSt
(
independent_consumer_requirements
common_defs
)
exprs
(
zero_array
,
cPassive
,
[],
ai
)
=
(
cc
,
reverse
r_unsafe_bits
,
ai
)
where
independent_consumer_requirements
common_defs
expr
(
zero_array
,
cc
,
unsafe_bits_accu
,
ai
=:{
ai_cur_ref_counts
})
#!
s
=
size
ai_cur_ref_counts
ai
=
{
ai
&
ai_cur_ref_counts
=
zero_array
}
(
cce
,
is_unsafe_case
,
ai
)
=
consumerRequirements
expr
common_defs
ai
(
unused
,
unified_ref_counts
)
=
unify_ref_count_arrays
s
ai_cur_ref_counts
ai
.
ai_cur_ref_counts
ai
=
{
ai
&
ai_cur_ref_counts
=
unified_ref_counts
}
=
({
unused
&
[
i
]=
0
\\
i
<-[
0
..
s
-1
]},
combineClasses
cce
cc
,
[
is_unsafe_case
:
unsafe_bits_accu
],
ai
)
unify_ref_count_arrays
0
src1
src2_dest
=
(
src1
,
src2_dest
)
unify_ref_count_arrays
i
src1
src2_dest
#!
i1
=
dec
i
rc1
=
src1
.[
i1
]
rc2
=
src2_dest
.[
i1
]
=
unify_ref_count_arrays
i1
src1
{
src2_dest
&
[
i1
]=
unify_ref_counts
rc1
rc2
}
// unify_ref_counts outer_ref_count ref_count_in_pattern
unify_ref_counts
0
x
=
if
(
x
==
2
)
2
0
unify_ref_counts
1
x
=
if
(
x
==
0
)
1
2
unify_ref_counts
2
_
=
2
instance
consumerRequirements
DynamicExpr
where
consumerRequirements
{
dyn_expr
}
common_defs
ai
=
consumerRequirements
dyn_expr
common_defs
ai
instance
consumerRequirements
BasicPattern
where
consumerRequirements
{
bp_expr
}
common_defs
ai
=
consumerRequirements
bp_expr
common_defs
ai
...
...
@@ -506,33 +541,6 @@ instance consumerRequirements (Bind a b) | consumerRequirements a where
consumerRequirements
{
bind_src
}
common_defs
ai
=
consumerRequirements
bind_src
common_defs
ai
independentConsumerRequirements
exprs
common_defs
ai
=:{
ai_cur_ref_counts
}
// reference counting happens independently for each pattern expression
#!
s
=
size
ai_cur_ref_counts
zero_array
=
createArray
s
0
(_,
cc
,
r_unsafe_bits
,
ai
)
=
foldSt
(
independent_consumer_requirements
common_defs
)
exprs
(
zero_array
,
cPassive
,
[],
ai
)
=
(
cc
,
reverse
r_unsafe_bits
,
ai
)
where
independent_consumer_requirements
common_defs
expr
(
zero_array
,
cc
,
unsafe_bits_accu
,
ai
=:{
ai_cur_ref_counts
})
#!
s
=
size
ai_cur_ref_counts
ai
=
{
ai
&
ai_cur_ref_counts
=
zero_array
}
(
cce
,
is_unsafe_case
,
ai
)
=
consumerRequirements
expr
common_defs
ai
(
unused
,
unified_ref_counts
)
=
unify_ref_count_arrays
s
ai_cur_ref_counts
ai
.
ai_cur_ref_counts
ai
=
{
ai
&
ai_cur_ref_counts
=
unified_ref_counts
}
=
({
unused
&
[
i
]=
0
\\
i
<-[
0
..
s
-1
]},
combineClasses
cce
cc
,
[
is_unsafe_case
:
unsafe_bits_accu
],
ai
)
unify_ref_count_arrays
0
src1
src2_dest
=
(
src1
,
src2_dest
)
unify_ref_count_arrays
i
src1
src2_dest
#!
i1
=
dec
i
rc1
=
src1
.[
i1
]
rc2
=
src2_dest
.[
i1
]
=
unify_ref_count_arrays
i1
src1
{
src2_dest
&
[
i1
]=
unify_ref_counts
rc1
rc2
}
// unify_ref_counts outer_ref_count ref_count_in_pattern
unify_ref_counts
0
x
=
if
(
x
==
2
)
2
0
unify_ref_counts
1
x
=
if
(
x
==
0
)
1
2
unify_ref_counts
2
_
=
2
analyseGroups
::
!{#
CommonDefs
}
!{#{#
FunType
}}
!
IndexRange
!
Int
!
Int
!*{!
Group
}
!*{#
FunDef
}
!*
VarHeap
!*
ExpressionHeap
->
(!
CleanupInfo
,
!*{!
ConsClasses
},
!*{!
Group
},
!*{#
FunDef
},
!*
VarHeap
,
!*
ExpressionHeap
)
analyseGroups
common_defs
imported_funs
{
ir_from
,
ir_to
}
main_dcl_module_n
stdStrictLists_module_n
groups
fun_defs
var_heap
expr_heap
...
...
@@ -668,10 +676,16 @@ mapAndLength f []
::
ReadOnlyTI
=
{
ro_imported_funs
::
!{#
{#
FunType
}
}
,
ro_common_defs
::
!{#
CommonDefs
}
,
ro_root_case_mode
::
!
RootCaseMode
,
ro_fun
::
!
SymbIdent
,
ro_fun_args
::
![
FreeVar
]
,
ro_main_dcl_module_n
::
!
Int
// the following four are used when possibly generating functions for cases...
,
ro_root_case_mode
::
!
RootCaseMode
,
ro_fun_root
::
!
SymbIdent
// original function
,
ro_fun_case
::
!
SymbIdent
// original function or possibly generated case
,
ro_fun_args
::
![
FreeVar
]
// args of above
,
ro_main_dcl_module_n
::
!
Int
,
ro_transform_fusion
::
!
Bool
// fusion switch
,
ro_stdStrictLists_module_n
::
!
Int
}
...
...
@@ -794,7 +808,7 @@ unfold_state_to_ti us ti
:==
{
ti
&
ti_var_heap
=
us
.
us_var_heap
,
ti_symbol_heap
=
us
.
us_symbol_heap
,
ti_cleanup_info
=
us
.
us_cleanup_info
}
transformCase
this_case
=:{
case_expr
,
case_guards
,
case_default
,
case_ident
,
case_info_ptr
}
ro
ti
|
SwitchFusion
False
True
|
Switch
Case
Fusion
(
not
ro
.
ro_transform_fusion
)
True
-!->
(
"transformCase"
,
Case
this_case
)
=
skip_over
this_case
ro
ti
#
(
case_info
,
ti_symbol_heap
)
=
readPtr
case_info_ptr
ti
.
ti_symbol_heap
ti
=
{
ti
&
ti_symbol_heap
=
ti_symbol_heap
}
...
...
@@ -859,11 +873,11 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
(
new_next_fun_nr
,
app_symb
)
=
case
ro
.
ro_root_case_mode
of
RootCaseOfZombie
#
(
ro_fun
=:{
symb_kind
=
SK_GeneratedFunction
fun_info_ptr
_})
=
ro
.
ro_fun
#
(
ro_fun
=:{
symb_kind
=
SK_GeneratedFunction
fun_info_ptr
_})
=
ro
.
ro_fun
_case
->
(
inc
ti_next_fun_nr
,
{
ro_fun
&
symb_kind
=
SK_GeneratedFunction
fun_info_ptr
ti_next_fun_nr
})
RootCase
->
(
ti_next_fun_nr
,
ro
.
ro_fun
)
->
(
ti_next_fun_nr
,
ro
.
ro_fun
_root
)
ti
=
{
ti
&
ti_next_fun_nr
=
new_next_fun_nr
,
ti_recursion_introduced
=
Yes
ti_next_fun_nr
}
app_args1
=
replace_arg
[
fv_info_ptr
\\
{
fv_info_ptr
}<-
aci_params
]
app_args
variables
(
app_args2
,
ti
)
=
transform
app_args1
{
ro
&
ro_root_case_mode
=
NotRootCase
}
ti
...
...
@@ -1043,7 +1057,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
{
fvi_var_heap
,
fvi_expr_heap
,
fvi_variables
,
fvi_expr_ptrs
}
=
freeVariables
(
Case
kees
)
fvi
ti
=
{
ti
&
ti_var_heap
=
fvi_var_heap
,
ti_symbol_heap
=
fvi_expr_heap
,
ti_cleanup_info
=
fvi_expr_ptrs
}
->
(
fvi_variables
,
ti
)
(
outer_fun_def
,
outer_cons_args
,
ti_fun_defs
,
ti_fun_heap
)
=
get_fun_def_and_cons_args
ro
.
ro_fun
.
symb_kind
ti
.
ti_cons_args
ti
.
ti_fun_defs
ti
.
ti_fun_heap
(
outer_fun_def
,
outer_cons_args
,
ti_fun_defs
,
ti_fun_heap
)
=
get_fun_def_and_cons_args
ro
.
ro_fun
_root
.
symb_kind
ti
.
ti_cons_args
ti
.
ti_fun_defs
ti
.
ti_fun_heap
// ti.ti_cons_args shared
outer_arguments
=
case
outer_fun_def
.
fun_body
of
TransformedBody
{
tb_args
}
->
tb_args
...
...
@@ -1056,9 +1070,9 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
\\
{
var_name
,
var_info_ptr
}
<-
free_vars
|
not
(
isMember
var_info_ptr
outer_info_ptrs
)]
all_args
=
lifted_arguments
++
arguments_from_outer_fun
(
fun_info_ptr
,
ti_fun_heap
)
=
newPtr
FI_Empty
ti_fun_heap
fun_ident
=
{
id_name
=
ro
.
ro_fun
.
symb_name
.
id_name
+++
"_case"
,
id_info
=
nilPtr
}
fun_ident
=
{
id_name
=
ro
.
ro_fun
_root
.
symb_name
.
id_name
+++
"_case"
,
id_info
=
nilPtr
}
fun_symb
=
{
symb_name
=
fun_ident
,
symb_kind
=
SK_GeneratedFunction
fun_info_ptr
undeff
,
symb_arity
=
length
all_args
}
new_ro
=
{
ro
&
ro_root_case_mode
=
RootCaseOfZombie
,
ro_fun
=
fun_symb
,
ro_fun_args
=
all_args
}
new_ro
=
{
ro
&
ro_root_case_mode
=
RootCaseOfZombie
,
ro_fun
_case
=
fun_symb
,
ro_fun_args
=
all_args
}
ti
=
{
ti
&
ti_fun_defs
=
ti_fun_defs
,
ti_fun_heap
=
ti_fun_heap
,
ti_recursion_introduced
=
No
}
(
new_expr
,
ti
)
=
transformCase
kees
new_ro
ti
(
ti_recursion_introduced
,
ti
)
=
ti
!
ti_recursion_introduced
...
...
@@ -1084,7 +1098,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
=
(
gf_fun_def
,
gf_cons_args
,
fun_defs
,
fun_heap
)
generate_case_function
old_ti_recursion_introduced
fun_index
case_info_ptr
new_expr
outer_fun_def
outer_cons_args
used_mask
{
ro_fun
=
ro_fun
=:{
symb_kind
=
SK_GeneratedFunction
fun_info_ptr
_},
ro_fun_args
}
ti
{
ro_fun
_case
=
ro_fun
=:{
symb_kind
=
SK_GeneratedFunction
fun_info_ptr
_},
ro_fun_args
}
ti
// | False->>"generate_case_function"
// = undef
#
fun_arity
=
length
ro_fun_args
...
...
@@ -1548,11 +1562,13 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi
(
tb_rhs
,
{
us_var_heap
,
us_symbol_heap
,
us_opt_type_heaps
=
Yes
ti_type_heaps
,
us_cleanup_info
})
=
unfold
tb_rhs
ui
us
// | False--->("unfolded:", tb_rhs) = undef
#
ro_fun
=
{
symb_name
=
fd
.
fun_symb
,
symb_kind
=
SK_GeneratedFunction
fun_def_ptr
ti_next_fun_nr
,
symb_arity
=
fun_arity
}
#
ro
=
{
ro
&
ro_root_case_mode
=
case
tb_rhs
of
Case
_
->
RootCase
_
->
NotRootCase
,
ro_fun
=
{
symb_name
=
fd
.
fun_symb
,
symb_kind
=
SK_GeneratedFunction
fun_def_ptr
ti_next_fun_nr
,
symb_arity
=
fun_arity
},
ro_fun_root
=
ro_fun
,
ro_fun_case
=
ro_fun
,
ro_fun_args
=
new_fun_args
}
ti_trace
...
...
@@ -2082,9 +2098,6 @@ instance replaceIntegers AType where
(
at_type
,
used
)
=
replaceIntegers
at_type
input
used
=
({
atype
&
at_attribute
=
at_attribute
,
at_type
=
at_type
},
used
)
(-!->)
infix
::
!.
a
!
b
->
.
a
|
<<<
b
(-!->)
a
b
=
a
--->
b
bind_to_fresh_type_variable
{
tv_name
,
tv_info_ptr
}
th_vars
#
(
new_tv_info_ptr
,
th_vars
)
=
newPtr
TVI_Empty
th_vars
tv
=
{
tv_name
=
tv_name
,
tv_info_ptr
=
new_tv_info_ptr
}
...
...
@@ -2248,7 +2261,7 @@ transformSelection opt_type selectors expr ti
// XXX store linear_bits and cc_args together ?
determineProducers
::
Bool
[
a
]
[
Int
]
[
Expression
]
Int
*{!
Producer
}
ReadOnlyTI
*
TransformInfo
->
*(!*{!
Producer
},![
Expression
],!*
TransformInfo
);
determineProducers
::
Bool
[
Bool
]
[
Int
]
[
Expression
]
Int
*{!
Producer
}
ReadOnlyTI
*
TransformInfo
->
*(!*{!
Producer
},![
Expression
],!*
TransformInfo
);
determineProducers
_
_
_
[]
_
producers
_
ti
=
(
producers
,
[],
ti
)
determineProducers
is_applied_to_macro_fun
[
linear_bit
:
linear_bits
]
[
cons_arg
:
cons_args
]
[
arg
:
args
]
prod_index
producers
ro
ti
...
...
@@ -2289,7 +2302,7 @@ determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{ sy
Expanding
_
->
False
(
TransformedBody
{
tb_rhs
})
->
Switch
Fusion
(
linear_bit
&&
is_sexy_body
tb_rhs
)
False
->
Switch
GeneratedFusion
(
ro
.
ro_transform_fusion
&&
linear_bit
&&
is_sexy_body
tb_rhs
)
False
|
is_good_producer
=
({
producers
&
[
prod_index
]
=
(
PR_GeneratedFunction
symb
fun_index
)},
app_args
++
new_args
,
ti
)
=
(
producers
,
[
App
app
:
new_args
],
ti
)
...
...
@@ -2311,7 +2324,7 @@ determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{sym
#
({
fun_body
},
ti_fun_defs
)
=
(
ti
.
ti_fun_defs
)![
glob_object
]
ti
=
{
ti
&
ti_fun_defs
=
ti_fun_defs
}
(
TransformedBody
{
tb_rhs
})
=
fun_body
is_good_producer
=
SwitchFu
sion
(
linear_bit
&&
is_sexy_body
tb_rhs
)
False
is_good_producer
=
SwitchFu
nctionFusion
(
ro
.
ro_transform_fusion
&&
linear_bit
&&
is_sexy_body
tb_rhs
)
False
|
is_good_producer
=
({
producers
&
[
prod_index
]
=
(
PR_Function
symb
glob_object
)},
app_args
++
new_args
,
ti
)
=
(
producers
,
[
App
app
:
new_args
],
ti
)
...
...
@@ -2408,10 +2421,10 @@ renewVariables exprs var_heap
::
ImportedFunctions
:==
[
Global
Index
]
transformGroups
::
!
CleanupInfo
!
Int
!
Int
!*{!
Group
}
!*{#
FunDef
}
!{!.
ConsClasses
}
!{#
CommonDefs
}
!{#
{#
FunType
}
}
!*{#{#
CheckedTypeDef
}}
!
ImportedConstructors
!*
TypeDefInfos
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
!*{#{#
CheckedTypeDef
}}
!
ImportedConstructors
!*
TypeDefInfos
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
!
Bool
->
(!*{!
Group
},
!*{#
FunDef
},
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
)
transformGroups
cleanup_info
main_dcl_module_n
stdStrictLists_module_n
groups
fun_defs
cons_args
common_defs
imported_funs
imported_types
collected_imports
type_def_infos
var_heap
type_heaps
symbol_heap
collected_imports
type_def_infos
var_heap
type_heaps
symbol_heap
compile_with_fusion
#!
nr_of_funs
=
size
fun_defs
#
(
groups
,
imported_types
,
collected_imports
,
ti
)
=
transform_groups
0
groups
common_defs
imported_funs
imported_types
collected_imports
...
...
@@ -2447,13 +2460,16 @@ transformGroups cleanup_info main_dcl_module_n stdStrictLists_module_n groups fu
ti_var_heap
=
fold2St
(\{
fv_info_ptr
}
a_type
ti_var_heap
->
setExtendedVarInfo
fv_info_ptr
(
EVI_VarType
a_type
)
ti_var_heap
)
tb
.
tb_args
st_args
ti_var_heap
ro
=
{
ro_imported_funs
=
imported_funs
,
ro_common_defs
=
common_defs
,
ro_root_case_mode
=
get_root_case_mode
tb
,
ro_fun
=
fun_def_to_symb_ident
fun
fun_def
,
ro_fun_args
=
tb
.
tb_args
,
ro_main_dcl_module_n
=
main_dcl_module_n
,
ro_stdStrictLists_module_n
=
stdStrictLists_module_n
ro_fun
=
fun_def_to_symb_ident
fun
fun_def
ro
=
{
ro_imported_funs
=
imported_funs
,
ro_common_defs
=
common_defs
,
ro_root_case_mode
=
get_root_case_mode
tb
,
ro_fun_root
=
ro_fun
,
ro_fun_case
=
ro_fun
,
ro_fun_args
=
tb
.
tb_args
,
ro_main_dcl_module_n
=
main_dcl_module_n
,
ro_transform_fusion
=
compile_with_fusion
,
ro_stdStrictLists_module_n
=
stdStrictLists_module_n
}
(
fun_rhs
,
ti
)
=
transform
tb
.
tb_rhs
ro
{
ti
&
ti_fun_defs
=
ti_fun_defs
,
ti_var_heap
=
ti_var_heap
}
=
{
ti
&
ti_fun_defs
=
{
ti
.
ti_fun_defs
&
[
fun
]
=
{
fun_def
&
fun_body
=
TransformedBody
{
tb
&
tb_rhs
=
fun_rhs
}}}}
...
...
main/compile.icl
View file @
b94e5f7b
...
...
@@ -19,6 +19,9 @@ import portToNewSyntax
// MV ...
,
compile_for_dynamics
::
!
Bool
// ... MV
// DvA ...
,
compile_with_fusion
::
!
Bool
// ... DvA
}
InitialCoclOptions
=
...
...
@@ -32,6 +35,9 @@ InitialCoclOptions =
// MV ...
,
compile_for_dynamics
=
False
// ... MV
// DvA ...
,
compile_with_fusion
=
False
// ... DvA
}
::
DclCache
=
{
...
...
@@ -85,6 +91,12 @@ parseCommandLine [arg1=:"-dynamics":args] options
#
(
args
,
modules
,
options
)=
parseCommandLine
args
{
options
&
compile_for_dynamics
=
True
}
=
(
args
,
modules
,
options
)
// ... MV
// DvA ...
parseCommandLine
[
arg1
=:
"-fusion"
:
args
]
options
// switch on fusion transformations
#
(
args
,
modules
,
options
)=
parseCommandLine
args
{
options
&
compile_with_fusion
=
True
}
=
(
args
,
modules
,
options
)
// ... DvA
parseCommandLine
[
arg
:
args
]
options
|
arg
.[
0
]
==
'-'
#
(
args
,
modules
,
options
)=
parseCommandLine
args
options
...
...
@@ -183,7 +195,7 @@ compileModule options commandLineArgs {dcl_modules,functions_and_macros,predef_s
#
({
boxed_ident
=
moduleIdent
},
hash_table
)
=
putIdentInHashTable
options
.
moduleName
IC_Module
hash_table
#
list_inferred_types
=
if
(
isMember
"-lt"
commandLineArgs
)
(
Yes
(
not
(
isMember
"-lattr"
commandLineArgs
)))
No
#
(
optionalSyntaxTree
,
cached_functions_and_macros
,
cached_dcl_mods
,
n_functions_and_macros_in_dcl_modules
,
main_dcl_module_n
,
predef_symbols
,
hash_table
,
files
,
error
,
io
,
out
,
tcl_file
,
heaps
)
=
frontEndInterface
{
feo_up_to_phase
=
FrontEndPhaseAll
,
feo_generics
=
False
}
moduleIdent
options
.
searchPaths
dcl_modules
functions_and_macros
list_inferred_types
predef_symbols
hash_table
files
error
io
out
tcl_file
heaps
=
frontEndInterface
{
feo_up_to_phase
=
FrontEndPhaseAll
,
feo_generics
=
False
,
feo_fusion
=
options
.
compile_with_fusion
}
moduleIdent
options
.
searchPaths
dcl_modules
functions_and_macros
list_inferred_types
predef_symbols
hash_table
files
error
io
out
tcl_file
heaps
#
unique_copy_of_predef_symbols
={
predef_symbol
\\
predef_symbol
<-:
predef_symbols
}
#
(
closed
,
files
)
=
closeTclFile
tcl_file
files
...
...
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