Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Stefan Gränitz
Frama Clang
Commits
004084f0
Commit
004084f0
authored
Jul 20, 2021
by
Stefan Gränitz
Browse files
[WIP] Attempt to generate a unique name for each overload
parent
ec027a59
Pipeline
#36728
failed with stages
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
convert.ml
View file @
004084f0
...
...
@@ -28,13 +28,15 @@ let fresh_names s =
let
nb
=
ref
(
-
1
)
in
fun
()
->
incr
nb
;
if
!
nb
=
0
then
s
else
s
^
"_"
^
string_of_int
!
nb
s
^
"_"
^
string_of_int
!
nb
let
lambda_def_name
=
"__fc_lambda_def"
let
lambda_apply_name
=
"__fc_lambda_apply"
let
new_lambda_def_name
=
fresh_names
lambda_def_name
let
unique_lambda_def_name
=
fresh_names
lambda_def_name
let
unique_lambda_apply_name
=
fresh_names
lambda_apply_name
let
make_lambda_cons_name
s1
=
s1
^
"_cons"
...
...
@@ -1345,8 +1347,9 @@ and convert_expr_node ?(drop_temp=false) env aux e does_remove_virtual =
convert_list_expr
env
aux
args
does_remove_virtual
in
let
args
=
mk_addrof
env
callee
::
args
in
let
apply_name
=
select_overload
lambda
args
in
env
,
aux
,
CALL
(
mk_expr_l
loc
(
MEMBEROF
(
callee
,
lambda_
apply_name
))
,
args
,
[]
)
CALL
(
mk_expr_l
loc
(
MEMBEROF
(
callee
,
apply_name
))
,
args
,
[]
)
|
Static_call
(
name
,
signature
,
kind
,
args
,
t
,
is_extern_c
)
->
let
cname
=
if
is_extern_c
then
name
.
decl_name
...
...
@@ -1732,6 +1735,12 @@ and convert_expr_node ?(drop_temp=false) env aux e does_remove_virtual =
in
env
,
aux
,
mk_expr
env
node
(* Bad hack! TODO: Figure out how to access the correct overload! *)
and
select_overload
lambda_expr
args
=
let
_unused
=
lambda_expr
in
let
_unused
=
args
in
lambda_apply_name
^
"_0"
and
convert_lambda_instatiations
env
lam_name
lam_decl
closure_type
insts
closure
aux
=
match
insts
with
|
[]
->
(
env
,
aux
)
...
...
@@ -1744,11 +1753,12 @@ and convert_lambda_instatiations env lam_name lam_decl closure_type insts closur
insts
closure
aux
and
convert_lambda_single_instance
env
lam_name
lam_decl
closure_type
inst
closure
aux
=
let
apply_name
=
unique_lambda_apply_name
()
in
let
arg_types
=
(
List
.
map
(
fun
x
->
x
.
arg_type
)
inst
.
arg_decls
)
in
let
type_def
=
convert_lambda_type
env
closure_type
inst
.
return_type
arg_types
closure
in
let
type_def
=
convert_lambda_type
env
closure_type
inst
.
return_type
arg_types
apply_name
closure
in
let
env
=
Convert_env
.
add_c_global
env
type_def
in
let
cons_def
=
convert_lambda_constructor
env
closure_type
inst
.
return_type
arg_types
closure
convert_lambda_constructor
env
closure_type
inst
.
return_type
arg_types
apply_name
closure
in
let
env
=
Convert_env
.
add_c_global
env
cons_def
in
let
env
=
Convert_env
.
add_closure_info
env
closure
in
...
...
@@ -1764,7 +1774,7 @@ and convert_lambda_single_instance env lam_name lam_decl closure_type inst closu
let
aux
=
add_local_aux_def_init
aux
lam_decl
lam_init
in
env
,
aux
and
convert_lambda_type
env
lam_type
result
params
closures
=
and
convert_lambda_type
env
lam_type
result
params
apply_name
closures
=
let
name
=
Mangling
.
mangle_cc_type
lam_type
in
let
loc
=
Convert_env
.
get_loc
env
in
let
field_of_capture
cap
=
...
...
@@ -1783,11 +1793,11 @@ and convert_lambda_type env lam_type result params closures =
in
let
rt
,
decl
=
convert_specifiers
env
fptr
false
in
let
fptr_field
=
FIELD
(
rt
,
[(
lambda_
apply_name
,
decl
JUSTBASE
,
[]
,
loc
)
,
None
])
in
FIELD
(
rt
,
[(
apply_name
,
decl
JUSTBASE
,
[]
,
loc
)
,
None
])
in
ONLYTYPEDEF
(
[
SpecType
(
Tstruct
(
name
,
Some
(
fptr_field
::
fields
)
,
[]
))]
,
loc
)
and
convert_lambda_constructor
env
lam_type
result
params
closures
=
and
convert_lambda_constructor
env
lam_type
result
params
apply_name
closures
=
let
loc
=
Convert_env
.
get_loc
env
in
let
cloc
=
Convert_env
.
get_clang_loc
env
in
let
lambda_name
=
Mangling
.
mangle_cc_type
lam_type
in
...
...
@@ -1824,7 +1834,7 @@ and convert_lambda_constructor env lam_type result params closures =
let
body
=
make_computation
env
(
mk_assign
env
(
mk_expr
env
(
make_closure_access
env
lambda_
apply_name
false
))
(
mk_expr
env
(
make_closure_access
env
apply_name
false
))
(
mk_var
env
"__fc_func"
))
::
body
in
...
...
@@ -1875,7 +1885,7 @@ and make_assign_cap env cap =
and
convert_lambda_body
env
lam_type
lam_inst
=
let
loc
=
Convert_env
.
get_loc
env
in
let
name
=
new
_lambda_def_name
()
in
let
name
=
unique
_lambda_def_name
()
in
let
lam_ptr_type
=
Cxx_utils
.(
force_ptr_to_const
(
obj_ptr
(
unqual_type
lam_type
)))
in
...
...
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