Skip to content
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

Unboxed records #98

Merged
merged 4 commits into from
Jan 30, 2025
Merged

Unboxed records #98

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
02ad3cf
Add syntax, make compile
ccasin Jan 24, 2025
dbc901c
parser changes
ccasin Jan 24, 2025
cbcbe8f
Now my fingers hurt
ccasin Jan 24, 2025
4c55c63
Fix precedence of .#
ccasin Jan 27, 2025
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
129 changes: 88 additions & 41 deletions lib/Ast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -149,7 +149,9 @@ module Exp = struct
let rec is_trivial exp =
match exp.pexp_desc with
| Pexp_constant {pconst_desc= Pconst_string (_, _, None); _} -> true
| Pexp_constant _ | Pexp_field _ | Pexp_ident _ | Pexp_send _ -> true
| Pexp_constant _ | Pexp_field _ | Pexp_unboxed_field _ | Pexp_ident _
|Pexp_send _ ->
true
| Pexp_construct (_, exp) -> Option.for_all exp ~f:is_trivial
| Pexp_prefix (_, e) -> is_trivial e
| Pexp_apply
Expand All @@ -164,7 +166,7 @@ module Exp = struct
match e.pexp_desc with
| Pexp_prefix _ -> true
| Pexp_apply (op, _) -> exposed_left op
| Pexp_field (e, _) -> exposed_left e
| Pexp_field (e, _) | Pexp_unboxed_field (e, _) -> exposed_left e
| _ -> false

(** [mem_cls cls exp] holds if [exp] is in the named class of expressions
Expand Down Expand Up @@ -202,16 +204,31 @@ module Exp = struct
|Pexp_construct (_, None)
|Pexp_variant (_, None)
|Pexp_override _ | Pexp_open _ | Pexp_extension _ | Pexp_hole
|Pexp_record _ | Pexp_array _ | Pexp_list _
|Pexp_list_comprehension _ | Pexp_array_comprehension _ ->
|Pexp_record _ | Pexp_record_unboxed_product _ | Pexp_array _
|Pexp_list _ | Pexp_list_comprehension _ | Pexp_array_comprehension _
|Pexp_unboxed_tuple _ ->
true
| Pexp_prefix (_, e) | Pexp_field (e, _) | Pexp_send (e, _) ->
| Pexp_prefix (_, e)
|Pexp_field (e, _)
|Pexp_unboxed_field (e, _)
|Pexp_send (e, _) ->
is_simple_in_parser e
| Pexp_infix ({txt; _}, e1, e2) ->
String.length txt > 0
&& Char.(String.get txt 0 = '#')
&& is_simple_in_parser e1 && is_simple_in_parser e2
| _ -> false
| Pexp_indexop_access {pia_rhs= Some _; _}
|Pexp_construct (_, Some _)
|Pexp_variant (_, Some _)
|Pexp_unreachable | Pexp_let _ | Pexp_function _ | Pexp_fun _
|Pexp_apply _ | Pexp_match _ | Pexp_try _ | Pexp_tuple _
|Pexp_setfield _ | Pexp_ifthenelse _ | Pexp_sequence _ | Pexp_while _
|Pexp_for _ | Pexp_constraint _ | Pexp_coerce _ | Pexp_setinstvar _
|Pexp_letmodule _ | Pexp_letexception _ | Pexp_assert _ | Pexp_lazy _
|Pexp_poly _ | Pexp_newtype _ | Pexp_pack _ | Pexp_letopen _
|Pexp_letop _ | Pexp_stack _ | Pexp_beginend _ | Pexp_parens _
|Pexp_cons _ ->
false
end

module Pat = struct
Expand Down Expand Up @@ -240,22 +257,30 @@ module Pat = struct
non-simple pattern. *)
let rec is_simple_in_parser {ppat_desc; _} =
match ppat_desc with
| Ppat_var _ | Ppat_record _ | Ppat_list _ | Ppat_array _ | Ppat_any
|Ppat_constant _
| Ppat_var _ | Ppat_record _ | Ppat_record_unboxed_product _
|Ppat_list _ | Ppat_array _ | Ppat_any | Ppat_constant _
|Ppat_construct (_, None)
|Ppat_variant (_, None)
|Ppat_type _ | Ppat_extension _ ->
|Ppat_type _ | Ppat_extension _ | Ppat_unboxed_tuple _ ->
true
| Ppat_open (_, p) -> is_simple_in_parser p
| _ -> false
| Ppat_construct (_, Some _)
|Ppat_variant (_, Some _)
|Ppat_alias _ | Ppat_interval _ | Ppat_tuple _ | Ppat_or _
|Ppat_constraint (_, _, _)
|Ppat_lazy _
|Ppat_unpack (_, _)
|Ppat_exception _ | Ppat_cons _ ->
false

let has_trailing_attributes {ppat_desc; ppat_attributes; _} =
match ppat_desc with
| Ppat_construct (_, None)
|Ppat_constant _ | Ppat_any | Ppat_var _
|Ppat_variant (_, None)
|Ppat_record _ | Ppat_array _ | Ppat_list _ | Ppat_type _
|Ppat_unpack _ | Ppat_extension _ | Ppat_open _ | Ppat_interval _ ->
|Ppat_record _ | Ppat_record_unboxed_product _ | Ppat_array _
|Ppat_list _ | Ppat_type _ | Ppat_unpack _ | Ppat_extension _
|Ppat_open _ | Ppat_interval _ ->
false
| _ -> List.exists ppat_attributes ~f:(Fn.non Attr.is_doc)
end
Expand Down Expand Up @@ -360,7 +385,8 @@ module Tyd = struct
let is_simple x =
match x.ptype_kind with
| Ptype_abstract | Ptype_open -> true
| Ptype_variant _ | Ptype_record _ -> false
| Ptype_variant _ | Ptype_record _ | Ptype_record_unboxed_product _ ->
false
end

module Structure_item = struct
Expand Down Expand Up @@ -1017,7 +1043,7 @@ end = struct
| Ptype_variant cd1N ->
List.exists cd1N ~f:(fun {pcd_args; pcd_res; _} ->
check_cstr pcd_args || Option.exists pcd_res ~f )
| Ptype_record ld1N ->
| Ptype_record ld1N | Ptype_record_unboxed_product ld1N ->
List.exists ld1N ~f:(fun {pld_type; _} -> typ == pld_type)
| _ -> false )
|| Option.exists ptype_manifest ~f )
Expand All @@ -1038,7 +1064,7 @@ end = struct
| Ppat_extension (_, PTyp t) -> assert (typ == t)
| Ppat_unpack (_, Some (_, l, _)) ->
assert (List.exists l ~f:(fun (_, t) -> typ == t))
| Ppat_record (l, _) ->
| Ppat_record (l, _) | Ppat_record_unboxed_product (l, _) ->
assert (List.exists l ~f:(fun (_, t, _) -> Option.exists t ~f))
| _ -> assert false )
| Exp ctx -> (
Expand All @@ -1052,7 +1078,7 @@ end = struct
| Pexp_coerce (_, Some t1, t2) -> assert (typ == t1 || typ == t2)
| Pexp_letexception (ext, _) -> assert (check_ext ext)
| Pexp_object _ -> assert false
| Pexp_record (en1, _) ->
| Pexp_record (en1, _) | Pexp_record_unboxed_product (en1, _) ->
assert (
List.exists en1 ~f:(fun (_, c, _) ->
Option.exists c ~f:(function
Expand Down Expand Up @@ -1367,7 +1393,7 @@ end = struct
assert (List.exists p1N ~f)
| Ppat_tuple (p1N, _) | Ppat_unboxed_tuple (p1N, _) ->
assert (List.exists p1N ~f:(fun (_, p) -> f p))
| Ppat_record (p1N, _) ->
| Ppat_record (p1N, _) | Ppat_record_unboxed_product (p1N, _) ->
assert (List.exists p1N ~f:(fun (_, _, x) -> Option.exists x ~f))
| Ppat_or l -> assert (List.exists ~f:(fun p -> p == pat) l)
| Ppat_alias (p1, _)
Expand All @@ -1390,15 +1416,17 @@ end = struct
assert (check_comprehension comp (Pattern pat))
| Pexp_apply _ | Pexp_array _ | Pexp_list _ | Pexp_assert _
|Pexp_coerce _ | Pexp_constant _ | Pexp_constraint _
|Pexp_construct _ | Pexp_field _ | Pexp_ident _ | Pexp_ifthenelse _
|Pexp_lazy _ | Pexp_letexception _ | Pexp_letmodule _ | Pexp_new _
|Pexp_construct _ | Pexp_field _ | Pexp_unboxed_field _
|Pexp_ident _ | Pexp_ifthenelse _ | Pexp_lazy _
|Pexp_letexception _ | Pexp_letmodule _ | Pexp_new _
|Pexp_newtype _ | Pexp_open _ | Pexp_override _ | Pexp_pack _
|Pexp_poly _ | Pexp_record _ | Pexp_send _ | Pexp_sequence _
|Pexp_setfield _ | Pexp_setinstvar _ | Pexp_tuple _
|Pexp_unboxed_tuple _ | Pexp_unreachable | Pexp_variant _
|Pexp_while _ | Pexp_hole | Pexp_beginend _ | Pexp_parens _
|Pexp_cons _ | Pexp_letopen _ | Pexp_indexop_access _
|Pexp_prefix _ | Pexp_infix _ | Pexp_stack _ ->
|Pexp_poly _ | Pexp_record _ | Pexp_record_unboxed_product _
|Pexp_send _ | Pexp_sequence _ | Pexp_setfield _ | Pexp_setinstvar _
|Pexp_tuple _ | Pexp_unboxed_tuple _ | Pexp_unreachable
|Pexp_variant _ | Pexp_while _ | Pexp_hole | Pexp_beginend _
|Pexp_parens _ | Pexp_cons _ | Pexp_letopen _
|Pexp_indexop_access _ | Pexp_prefix _ | Pexp_infix _ | Pexp_stack _
->
assert false
| Pexp_extension (_, ext) -> assert (check_extensions ext)
| Pexp_object {pcstr_self; _} ->
Expand Down Expand Up @@ -1521,7 +1549,7 @@ end = struct
assert (List.exists e1N ~f)
| Pexp_construct (_, e) | Pexp_variant (_, e) ->
assert (Option.exists e ~f)
| Pexp_record (e1N, e0) ->
| Pexp_record (e1N, e0) | Pexp_record_unboxed_product (e1N, e0) ->
assert (
Option.exists e0 ~f
|| List.exists e1N ~f:(fun (_, _, e) -> Option.exists e ~f) )
Expand All @@ -1532,6 +1560,7 @@ end = struct
|Pexp_stack e
|Pexp_coerce (e, _, _)
|Pexp_field (e, _)
|Pexp_unboxed_field (e, _)
|Pexp_lazy e
|Pexp_letexception (_, e)
|Pexp_letmodule (_, _, _, e)
Expand Down Expand Up @@ -1633,7 +1662,7 @@ end = struct
let ctx = Exp exp in
match exp.pexp_desc with
| Pexp_constant _ -> Exp.is_trivial exp
| Pexp_field _ | Pexp_ident _ | Pexp_send _
| Pexp_field _ | Pexp_unboxed_field _ | Pexp_ident _ | Pexp_send _
|Pexp_construct (_, None)
|Pexp_variant (_, None) ->
true
Expand All @@ -1647,7 +1676,7 @@ end = struct
| Pexp_tuple e1N | Pexp_unboxed_tuple e1N ->
List.for_all e1N ~f:(fun (_, e) -> Exp.is_trivial e)
&& fit_margin c (width xexp)
| Pexp_record (e1N, e0) ->
| Pexp_record (e1N, e0) | Pexp_record_unboxed_product (e1N, e0) ->
Option.for_all e0 ~f:Exp.is_trivial
&& List.for_all e1N ~f:(fun (_, c, eo) ->
Option.is_none c && Option.for_all eo ~f:Exp.is_trivial )
Expand Down Expand Up @@ -1814,7 +1843,7 @@ end = struct
| Pexp_setfield (e0, _, _) when e0 == exp -> Some (Dot, Left)
| Pexp_setfield (_, _, e0) when e0 == exp -> Some (LessMinus, Non)
| Pexp_setinstvar _ -> Some (LessMinus, Non)
| Pexp_field _ -> Some (Dot, Left)
| Pexp_field _ | Pexp_unboxed_field _ -> Some (Dot, Left)
(* We use [Dot] so [x#y] has the same precedence as [x.y], it is
different to what is done in the parser, but it is intended. *)
| Pexp_send _ -> Some (Dot, Left)
Expand Down Expand Up @@ -1921,7 +1950,7 @@ end = struct
prec_ast (Exp e)
| Pexp_setfield _ -> Some LessMinus
| Pexp_setinstvar _ -> Some LessMinus
| Pexp_field _ -> Some Dot
| Pexp_field _ | Pexp_unboxed_field _ -> Some Dot
| Pexp_send _ -> Some Dot
| _ -> None )
| Fp _ -> None
Expand Down Expand Up @@ -2065,7 +2094,9 @@ end = struct
| Pat {ppat_desc= Ppat_cons _; _}, inner -> (
match inner with
| Ppat_cons _ -> true
| Ppat_construct _ | Ppat_record _ | Ppat_variant _ -> false
| Ppat_construct _ | Ppat_record _ | Ppat_record_unboxed_product _
|Ppat_unboxed_tuple _ | Ppat_variant _ ->
false
| _ -> true )
| Fp {pparam_desc= Pparam_val (_, _, _, _); _}, Ppat_cons _ -> true
| Pat {ppat_desc= Ppat_construct _; _}, Ppat_cons _ -> true
Expand Down Expand Up @@ -2249,9 +2280,10 @@ end = struct
| Pexp_array _ | Pexp_list _ | Pexp_coerce _ | Pexp_constant _
|Pexp_constraint _
|Pexp_construct (_, None)
|Pexp_extension _ | Pexp_field _ | Pexp_for _ | Pexp_ident _
|Pexp_new _ | Pexp_object _ | Pexp_override _ | Pexp_pack _
|Pexp_poly _ | Pexp_record _ | Pexp_send _ | Pexp_unreachable
|Pexp_extension _ | Pexp_field _ | Pexp_unboxed_field _
|Pexp_for _ | Pexp_ident _ | Pexp_new _ | Pexp_object _
|Pexp_override _ | Pexp_pack _ | Pexp_poly _ | Pexp_record _
|Pexp_record_unboxed_product _ | Pexp_send _ | Pexp_unreachable
|Pexp_variant (_, None)
|Pexp_hole | Pexp_while _ | Pexp_beginend _ | Pexp_parens _
|Pexp_indexop_access _ | Pexp_list_comprehension _
Expand Down Expand Up @@ -2331,9 +2363,10 @@ end = struct
| Pexp_array _ | Pexp_list _ | Pexp_coerce _ | Pexp_constant _
|Pexp_constraint _
|Pexp_construct (_, None)
|Pexp_extension _ | Pexp_field _ | Pexp_for _ | Pexp_ident _
|Pexp_new _ | Pexp_object _ | Pexp_override _ | Pexp_pack _
|Pexp_poly _ | Pexp_record _ | Pexp_send _ | Pexp_unreachable
|Pexp_extension _ | Pexp_field _ | Pexp_unboxed_field _ | Pexp_for _
|Pexp_ident _ | Pexp_new _ | Pexp_object _ | Pexp_override _
|Pexp_pack _ | Pexp_poly _ | Pexp_record _
|Pexp_record_unboxed_product _ | Pexp_send _ | Pexp_unreachable
|Pexp_variant (_, None)
|Pexp_hole | Pexp_while _ | Pexp_beginend _ | Pexp_parens _
|Pexp_list_comprehension _ | Pexp_array_comprehension _ ->
Expand Down Expand Up @@ -2562,7 +2595,7 @@ end = struct
; _ } )
when exp == lhs ->
true
| ( Exp {pexp_desc= Pexp_field (e, _); _}
| ( Exp {pexp_desc= Pexp_field (e, _) | Pexp_unboxed_field (e, _); _}
, {pexp_desc= Pexp_construct _ | Pexp_cons _; _} )
when e == exp ->
true
Expand Down Expand Up @@ -2629,12 +2662,14 @@ end = struct
, _ )
when exp2 == exp ->
false
| Pexp_record (flds, _)
| (Pexp_record (flds, _) | Pexp_record_unboxed_product (flds, _))
when List.exists flds ~f:(fun (_, _, e0) ->
Option.exists e0 ~f:(fun x -> x == exp) ) ->
exposed_right_exp Non_apply exp
(* Non_apply is perhaps pessimistic *)
| Pexp_record (_, Some ({pexp_desc= Pexp_prefix _; _} as e0))
|Pexp_record_unboxed_product
(_, Some ({pexp_desc= Pexp_prefix _; _} as e0))
when e0 == exp ->
(* don't put parens around [!e] in [{ !e with a; b }] *)
false
Expand All @@ -2643,11 +2678,23 @@ end = struct
, Some
( { pexp_desc=
( Pexp_ident _ | Pexp_constant _ | Pexp_record _
| Pexp_constraint _ | Pexp_field _ )
| Pexp_constraint _ | Pexp_unboxed_field _
| Pexp_field _ )
; _ } as e0 ) )
|Pexp_record_unboxed_product
( _
, Some
( { pexp_desc=
( Pexp_ident _ | Pexp_constant _ | Pexp_record _
| Pexp_constraint _ | Pexp_unboxed_field _
| Pexp_field _ )
; _ } as e0 ) )
when e0 == exp ->
false
| Pexp_record (_, Some e0) when e0 == exp -> true
| Pexp_record (_, Some e0)
|Pexp_record_unboxed_product (_, Some e0)
when e0 == exp ->
true
| Pexp_override fields
when List.exists fields ~f:(fun (_, e0) -> e0 == exp) ->
exposed_right_exp Sequence exp
Expand Down
5 changes: 4 additions & 1 deletion lib/Exposed.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,10 @@ module Right = struct
| {ptype_cstrs= _ :: _ as cstrs; _} ->
(* type a = ... constraint left = < ... > *)
list ~elt:(fun (_left, right, _loc) -> core_type right) cstrs
| {ptype_kind= Ptype_open | Ptype_record _; _} -> false
| { ptype_kind=
Ptype_open | Ptype_record _ | Ptype_record_unboxed_product _
; _ } ->
false
| {ptype_kind= Ptype_abstract; ptype_manifest= None; _} -> false
| {ptype_kind= Ptype_abstract; ptype_manifest= Some manifest; _} ->
(* type a = < ... > *)
Expand Down
9 changes: 9 additions & 0 deletions lib/Extended_ast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -181,6 +181,9 @@ module Parse = struct
| {ppat_desc= Ppat_record (fields, flag); _} as e ->
let fields = List.map ~f:(pat_record_field m) fields in
{e with ppat_desc= Ppat_record (fields, flag)}
| {ppat_desc= Ppat_record_unboxed_product (fields, flag); _} as e ->
let fields = List.map ~f:(pat_record_field m) fields in
{e with ppat_desc= Ppat_record_unboxed_product (fields, flag)}
(* [(module M) : (module T)] -> [(module M : T)] *)
| { ppat_desc=
Ppat_constraint
Expand Down Expand Up @@ -212,6 +215,12 @@ module Parse = struct
{ e with
pexp_desc= Pexp_record (fields, Option.map ~f:(m.expr m) with_)
}
| {pexp_desc= Pexp_record_unboxed_product (fields, with_); _} as e ->
let fields = List.map ~f:(record_field m) fields in
{ e with
pexp_desc=
Pexp_record_unboxed_product
(fields, Option.map ~f:(m.expr m) with_) }
(* [( + ) 1 2] -> [1 + 2] *)
| { pexp_desc=
Pexp_apply
Expand Down
Loading
Loading