From 6e1e970f2bd084711cbd60ddae84ca1b6c8aff2b Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Wed, 23 Aug 2023 16:38:43 +0100 Subject: [PATCH] improve option shape detection in Datarepr --- typing/datarepr.ml | 32 +++++++++++++++++++++----------- 1 file changed, 21 insertions(+), 11 deletions(-) diff --git a/typing/datarepr.ml b/typing/datarepr.ml index 2593edac69..132fe51712 100644 --- a/typing/datarepr.ml +++ b/typing/datarepr.ml @@ -158,23 +158,33 @@ let constructor_descrs ~current_unit ty_path decl cstrs rep = (cd_id, cstr) :: descr_rem in let result = describe_constructors 0 0 cstrs in match result with + | [ (none_id, ({cstr_args = []} as none_descr) ) ; + (some_id, ({ cstr_args = [_]} as some_descr)) + ] + when Ident.name none_id = "None" && Ident.name some_id = "Some" -> + [ + (none_id, {none_descr with + cstr_attributes = + optional_shape :: none_descr.cstr_attributes}); + (some_id, {some_descr with + cstr_attributes = + optional_shape :: some_descr.cstr_attributes + }) + ] + | ( - [ (a_id, ({cstr_args = []} as a_descr) ) ; - (b_id, ({ cstr_args = [_]} as b_descr)) - ] | - [ (a_id, ({cstr_args = [_]} as a_descr) ) ; - (b_id, ({ cstr_args = []} as b_descr)) + [ (some_id, ({cstr_args = [_]} as some_descr) ) ; + (none_id, ({ cstr_args = []} as none_descr)) ] - ) when (Ident.name a_id = "Some" && Ident.name b_id = "None") || - (Ident.name a_id = "None" && Ident.name b_id = "Some") + ) when (Ident.name some_id = "Some" && Ident.name none_id = "None") -> [ - (a_id, {a_descr with + (some_id, {some_descr with cstr_attributes = - optional_shape :: a_descr.cstr_attributes}); - (b_id, {b_descr with + optional_shape :: some_descr.cstr_attributes}); + (none_id, {none_descr with cstr_attributes = - optional_shape :: b_descr.cstr_attributes + optional_shape :: none_descr.cstr_attributes }) ] | _ -> result