Skip to content

Commit

Permalink
flambda-backend: Factor out duplicated code in cmm_helpers (#1822)
Browse files Browse the repository at this point in the history
  • Loading branch information
ccasin authored Sep 13, 2023
1 parent caf938f commit 3552db6
Showing 1 changed file with 12 additions and 21 deletions.
33 changes: 12 additions & 21 deletions asmcomp/cmm_helpers.ml
Original file line number Diff line number Diff line change
Expand Up @@ -947,10 +947,11 @@ let unique_arity_identifier (arity : Cmm.machtype list) =
then Int.to_string (List.length arity)
else String.concat "_" (List.map machtype_identifier arity)

let result_layout_suffix result =
match result with [| Val |] -> "" | _ -> "_R" ^ machtype_identifier result

let send_function_name arity result (mode : Lambda.alloc_mode) =
let res =
match result with [| Val |] -> "" | _ -> "_R" ^ machtype_identifier result
in
let res = result_layout_suffix result in
let suff = match mode with Alloc_heap -> "" | Alloc_local -> "L" in
"caml_send" ^ unique_arity_identifier arity ^ res ^ suff

Expand Down Expand Up @@ -1018,9 +1019,7 @@ let make_checkbound dbg = function
(* Record application and currying functions *)

let apply_function_name arity result (mode : Lambda.alloc_mode) =
let res =
match result with [| Val |] -> "" | _ -> "_R" ^ machtype_identifier result
in
let res = result_layout_suffix result in
let suff = match mode with Alloc_heap -> "" | Alloc_local -> "L" in
"caml_apply" ^ unique_arity_identifier arity ^ res ^ suff

Expand All @@ -1031,25 +1030,23 @@ let apply_function_sym arity result mode =
Compilenv.need_apply_fun arity result mode;
apply_function_name arity result mode

let tuplify_function_name arity result =
"caml_tuplify" ^ Int.to_string arity ^ result_layout_suffix result

let curry_function_sym function_kind arity result =
Compilenv.need_curry_fun function_kind arity result;
match function_kind with
| Lambda.Curried { nlocal } ->
"caml_curry"
^ unique_arity_identifier arity
^ (match result with
| [| Val |] -> ""
| _ -> "_R" ^ machtype_identifier result)
^ result_layout_suffix result
^ if nlocal > 0 then "L" ^ Int.to_string nlocal else ""
| Lambda.Tupled -> (
| Lambda.Tupled ->
if List.exists (function [| Val |] -> false | _ -> true) arity
then
Misc.fatal_error
"tuplify_function is currently unsupported if arity contains non-values";
"caml_tuplify"
^ Int.to_string (List.length arity)
^
match result with [| Val |] -> "" | _ -> "_R" ^ machtype_identifier result)
tuplify_function_name (List.length arity) result

(* Big arrays *)

Expand Down Expand Up @@ -2254,13 +2251,7 @@ let tuplify_function arity return =
else get_field_gen Asttypes.Mutable (Cvar arg) i (dbg ())
:: access_components(i+1)
in
let fun_name =
"caml_tuplify" ^ Int.to_string arity
^
match return with
| [| Val |] -> ""
| _ -> "_R" ^ machtype_identifier return
in
let fun_name = tuplify_function_name arity return in
let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
Cfunction
{fun_name;
Expand Down

0 comments on commit 3552db6

Please sign in to comment.