Skip to content

Initial support for value slots not of value kind #946

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Dec 6, 2022
Merged

Initial support for value slots not of value kind #946

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
25 changes: 13 additions & 12 deletions backend/cmmgen.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -156,8 +156,9 @@ type rhs_kind =
let rec expr_size env = function
| Uvar id ->
begin try V.find_same id env with Not_found -> RHS_nonrec end
| Uclosure(fundecls, clos_vars) ->
RHS_block (fundecls_size fundecls + List.length clos_vars)
| Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
RHS_block (fundecls_size functions + List.length not_scanned_slots
+ List.length scanned_slots)
| Ulet(_str, _kind, id, exp, body) ->
expr_size (V.add (VP.var id) (expr_size env exp) env) body
| Uletrec(bindings, body) ->
Expand Down Expand Up @@ -426,18 +427,18 @@ let rec transl env e =
end
| Uconst sc ->
transl_constant Debuginfo.none sc
| Uclosure(fundecls, []) ->
| Uclosure { functions ; not_scanned_slots = [] ; scanned_slots = [] } ->
let sym = Compilenv.new_const_symbol() in
Cmmgen_state.add_constant sym (Const_closure (Local, fundecls, []));
List.iter (fun f -> Cmmgen_state.add_function f) fundecls;
Cmmgen_state.add_constant sym (Const_closure (Local, functions, []));
List.iter (fun f -> Cmmgen_state.add_function f) functions;
let dbg =
match fundecls with
match functions with
| [] -> Debuginfo.none
| fundecl::_ -> fundecl.dbg
in
Cconst_symbol (sym, dbg)
| Uclosure(fundecls, clos_vars) ->
let startenv = fundecls_size fundecls in
| Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
let startenv = fundecls_size functions + List.length not_scanned_slots in
let mode =
Option.get @@
List.fold_left (fun s { mode; dbg; _ } ->
Expand All @@ -447,10 +448,10 @@ let rec transl env e =
if not (Lambda.eq_mode mode m') then
Misc.fatal_errorf "Inconsistent modes in let rec at %s"
(Debuginfo.to_string dbg);
s) None fundecls in
s) None functions in
let rec transl_fundecls pos = function
[] ->
List.map (transl env) clos_vars
List.map (transl env) (not_scanned_slots @ scanned_slots)
| f :: rem ->
let is_last = match rem with [] -> true | _::_ -> false in
Cmmgen_state.add_function f;
Expand All @@ -474,11 +475,11 @@ let rec transl env e =
else alloc_infix_header pos f.dbg :: without_header
in
let dbg =
match fundecls with
match functions with
| [] -> Debuginfo.none
| fundecl::_ -> fundecl.dbg
in
make_alloc ~mode dbg Obj.closure_tag (transl_fundecls 0 fundecls)
make_alloc ~mode dbg Obj.closure_tag (transl_fundecls 0 functions)
| Uoffset(arg, offset) ->
(* produces a valid Caml value, pointing just after an infix header *)
let ptr = transl env arg in
Expand Down
6 changes: 5 additions & 1 deletion middle_end/clambda.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,11 @@ and ulambda =
function_label * ulambda list * Lambda.probe * apply_kind * Debuginfo.t
| Ugeneric_apply of
ulambda * ulambda list * apply_kind * Debuginfo.t
| Uclosure of ufunction list * ulambda list
| Uclosure of {
functions : ufunction list ;
not_scanned_slots : ulambda list ;
scanned_slots : ulambda list ;
}
| Uoffset of ulambda * int
| Ulet of mutable_flag * value_kind * Backend_var.With_provenance.t
* ulambda * ulambda
Expand Down
6 changes: 5 additions & 1 deletion middle_end/clambda.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,11 @@ and ulambda =
function_label * ulambda list * Lambda.probe * apply_kind * Debuginfo.t
| Ugeneric_apply of
ulambda * ulambda list * apply_kind * Debuginfo.t
| Uclosure of ufunction list * ulambda list
| Uclosure of {
functions : ufunction list ;
not_scanned_slots : ulambda list ;
scanned_slots : ulambda list
}
| Uoffset of ulambda * int
| Ulet of mutable_flag * value_kind * Backend_var.With_provenance.t
* ulambda * ulambda
Expand Down
Loading