diff options
| author | Alasdair Armstrong | 2018-08-06 20:27:01 +0100 |
|---|---|---|
| committer | Alasdair Armstrong | 2018-08-06 20:34:11 +0100 |
| commit | 0cb1e506866873f8886baf7631878ed956f1e8f5 (patch) | |
| tree | 0e0d76c627c318ccbef100e65001bd60c38f62fe /src/bytecode_util.ml | |
| parent | d334535562953959c965ccace6392b0d87d1fb89 (diff) | |
Cast each argument to a polymorphic constructor into it's most general type
Diffstat (limited to 'src/bytecode_util.ml')
| -rw-r--r-- | src/bytecode_util.ml | 19 |
1 files changed, 19 insertions, 0 deletions
diff --git a/src/bytecode_util.ml b/src/bytecode_util.ml index 27086858..ed042c51 100644 --- a/src/bytecode_util.ml +++ b/src/bytecode_util.ml @@ -231,6 +231,25 @@ let rec ctyp_unify ctyp1 ctyp2 = | _, _ when ctyp_equal ctyp1 ctyp2 -> [] | _, _ -> raise (Invalid_argument "ctyp_unify") +let rec ctyp_suprema = function + | CT_int -> CT_int + | CT_bits d -> CT_bits d + | CT_bits64 (_, d) -> CT_bits d + | CT_int64 -> CT_int + | CT_unit -> CT_unit + | CT_bool -> CT_bool + | CT_real -> CT_real + | CT_bit -> CT_bit + | CT_tup ctyps -> CT_tup (List.map ctyp_suprema ctyps) + | CT_string -> CT_string + | CT_enum (id, ids) -> CT_enum (id, ids) + | CT_struct (id, ctors) -> CT_struct (id, List.map (fun (id, ctyp) -> (id, ctyp_suprema ctyp)) ctors) + | CT_variant (id, ctors) -> CT_variant (id, List.map (fun (id, ctyp) -> (id, ctyp_suprema ctyp)) ctors) + | CT_vector (d, ctyp) -> CT_vector (d, ctyp_suprema ctyp) + | CT_list ctyp -> CT_list (ctyp_suprema ctyp) + | CT_ref ctyp -> CT_ref (ctyp_suprema ctyp) + | CT_poly -> CT_poly + let rec unpoly = function | F_poly f -> unpoly f | F_call (call, fs) -> F_call (call, List.map unpoly fs) |