aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/boot/be/ra.ml4
-rw-r--r--src/boot/llvm/lltrans.ml18
-rw-r--r--src/boot/me/dead.ml18
-rw-r--r--src/boot/me/resolve.ml16
-rw-r--r--src/boot/me/semant.ml12
-rw-r--r--src/boot/me/trans.ml6
-rw-r--r--src/boot/me/type.ml6
-rw-r--r--src/boot/me/typestate.ml10
-rw-r--r--src/boot/me/walk.ml2
9 files changed, 46 insertions, 46 deletions
diff --git a/src/boot/be/ra.ml b/src/boot/be/ra.ml
index 12ec11ea..3b3e8b92 100644
--- a/src/boot/be/ra.ml
+++ b/src/boot/be/ra.ml
@@ -132,7 +132,7 @@ let kill_redundant_moves (cx:ctxt) : unit =
let quad_jump_target_labels (q:quad) : Il.label list =
match q.Il.quad_body with
- Il.Jmp { Il.jmp_targ = Il.CodeLabel lab } -> [ lab ]
+ Il.Jmp { Il.jmp_targ = Il.CodeLabel lab; _ } -> [ lab ]
| _ -> []
;;
@@ -172,7 +172,7 @@ let quad_defined_vregs (q:quad) : Il.vreg list =
let quad_is_unconditional_jump (q:quad) : bool =
match q.Il.quad_body with
- Il.Jmp { jmp_op = Il.JMP } -> true
+ Il.Jmp { jmp_op = Il.JMP; _ } -> true
| Il.Ret -> true
| _ -> false
;;
diff --git a/src/boot/llvm/lltrans.ml b/src/boot/llvm/lltrans.ml
index c116cf05..983e8bc3 100644
--- a/src/boot/llvm/lltrans.ml
+++ b/src/boot/llvm/lltrans.ml
@@ -110,7 +110,7 @@ let trans_crate
: Llvm.llvalue option =
match Session.get_span sess id with
None -> None
- | Some {lo=(_, line, col)} ->
+ | Some {lo=(_, line, col); _} ->
Some (di_location line col scope)
in
@@ -368,9 +368,9 @@ let trans_crate
in
let base_llty = trans_ty ty in
match slot.Ast.slot_mode with
- | Ast.MODE_alias _ ->
+ | Ast.MODE_alias ->
Llvm.pointer_type base_llty
- | Ast.MODE_local _ -> base_llty
+ | Ast.MODE_local -> base_llty
in
let get_element_ptr
@@ -585,7 +585,7 @@ let trans_crate
(name:Ast.ident)
mod_item
: unit =
- let { node = { Ast.decl_item = (item:Ast.mod_item') }; id = id } =
+ let { node = { Ast.decl_item = (item:Ast.mod_item'); _ }; id = id } =
mod_item in
let full_name = Semant.item_str sem_cx id in
let (filename, line_num) =
@@ -621,7 +621,7 @@ let trans_crate
let trans_fn
({
Ast.fn_input_slots = (header_slots:Ast.header_slots);
- Ast.fn_body = (body:Ast.block)
+ Ast.fn_body = (body:Ast.block); _
}:Ast.fn)
(fn_id:node_id)
: unit =
@@ -654,7 +654,7 @@ let trans_crate
let build_arg idx llargval =
if idx >= n_implicit_args
then
- let ({ id = id }, ident) = header_slots.(idx - 2) in
+ let ({ id = id; _ }, ident) = header_slots.(idx - 2) in
Llvm.set_value_name ident llargval;
let llarg =
let llty = Llvm.type_of llargval in
@@ -754,7 +754,7 @@ let trans_crate
let rec trans_lval (lval:Ast.lval) : (Llvm.llvalue * Ast.ty) =
iflog (fun _ -> log sem_cx "trans_lval: %a" Ast.sprintf_lval lval);
match lval with
- Ast.LVAL_base { id = base_id } ->
+ Ast.LVAL_base { id = base_id; _ } ->
set_debug_loc base_id;
let defn_id = lval_base_defn_id sem_cx lval in
begin
@@ -813,7 +813,7 @@ let trans_crate
let trans_atom (atom:Ast.atom) : Llvm.llvalue =
iflog (fun _ -> log sem_cx "trans_atom: %a" Ast.sprintf_atom atom);
match atom with
- Ast.ATOM_literal { node = lit } -> trans_literal lit
+ Ast.ATOM_literal { node = lit; _ } -> trans_literal lit
| Ast.ATOM_lval lval ->
Llvm.build_load (fst (trans_lval lval)) (anon_llid "tmp")
llbuilder
@@ -1081,7 +1081,7 @@ let trans_crate
(name:Ast.ident)
mod_item
: unit =
- let { node = { Ast.decl_item = (item:Ast.mod_item') }; id = id } =
+ let { node = { Ast.decl_item = (item:Ast.mod_item'); _ }; id = id } =
mod_item in
match item with
Ast.MOD_ITEM_type _ ->
diff --git a/src/boot/me/dead.ml b/src/boot/me/dead.ml
index 29a8d86b..dbd510bb 100644
--- a/src/boot/me/dead.ml
+++ b/src/boot/me/dead.ml
@@ -44,14 +44,14 @@ let dead_code_visitor
if Hashtbl.mem must_exit block.id then
Hashtbl.add must_exit s.id ()
- | Ast.STMT_while { Ast.while_body = body }
- | Ast.STMT_do_while { Ast.while_body = body }
- | Ast.STMT_for_each { Ast.for_each_body = body }
- | Ast.STMT_for { Ast.for_body = body } ->
+ | Ast.STMT_while { Ast.while_body = body; _ }
+ | Ast.STMT_do_while { Ast.while_body = body; _ }
+ | Ast.STMT_for_each { Ast.for_each_body = body; _ }
+ | Ast.STMT_for { Ast.for_body = body; _ } ->
if (Hashtbl.mem must_exit body.id) then
Hashtbl.add must_exit s.id ()
- | Ast.STMT_if { Ast.if_then = b1; Ast.if_else = Some b2 } ->
+ | Ast.STMT_if { Ast.if_then = b1; Ast.if_else = Some b2; _ } ->
if (Hashtbl.mem must_exit b1.id) && (Hashtbl.mem must_exit b2.id)
then Hashtbl.add must_exit s.id ()
@@ -61,16 +61,16 @@ let dead_code_visitor
| Ast.STMT_be _ ->
Hashtbl.add must_exit s.id ()
- | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms } ->
+ | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms; _ } ->
let arm_ids =
- Array.map (fun { node = (_, block) } -> block.id) arms
+ Array.map (fun { node = (_, block); _ } -> block.id) arms
in
if all_must_exit arm_ids
then Hashtbl.add must_exit s.id ()
| Ast.STMT_alt_type { Ast.alt_type_arms = arms;
- Ast.alt_type_else = alt_type_else } ->
- let arm_ids = Array.map (fun { node = ((_, _), block) } ->
+ Ast.alt_type_else = alt_type_else; _ } ->
+ let arm_ids = Array.map (fun { node = ((_, _), block); _ } ->
block.id) arms in
let else_ids =
begin
diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml
index 1411831b..879601fb 100644
--- a/src/boot/me/resolve.ml
+++ b/src/boot/me/resolve.ml
@@ -113,10 +113,10 @@ let stmt_collecting_visitor
visit_for_block f.Ast.for_slot f.Ast.for_body.id
| Ast.STMT_for_each f ->
visit_for_block f.Ast.for_each_slot f.Ast.for_each_head.id
- | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms } ->
+ | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms; _ } ->
let rec resolve_pat block pat =
match pat with
- Ast.PAT_slot ({ id = slot_id }, ident) ->
+ Ast.PAT_slot ({ id = slot_id; _ }, ident) ->
let slots = Hashtbl.find cx.ctxt_block_slots block.id in
let key = Ast.KEY_ident ident in
htab_put slots key slot_id;
@@ -125,7 +125,7 @@ let stmt_collecting_visitor
| Ast.PAT_lit _
| Ast.PAT_wild -> ()
in
- Array.iter (fun { node = (p, b) } -> resolve_pat b p) arms
+ Array.iter (fun { node = (p, b); _ } -> resolve_pat b p) arms
| _ -> ()
end;
inner.Walk.visit_stmt_pre stmt
@@ -236,8 +236,8 @@ let lookup_type_node_by_name
None -> err None "unknown name: %a" Ast.sprintf_name name
| Some (_, id) ->
match htab_search cx.ctxt_all_defns id with
- Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type _ })
- | Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_obj _ })
+ Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type _; _ })
+ | Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_obj _; _ })
| Some (DEFN_ty_param _) -> id
| _ ->
err None "Found non-type binding for %a"
@@ -645,8 +645,8 @@ let lval_base_resolving_visitor
let reference_any_name lv =
let rec lval_is_name lv =
match lv with
- Ast.LVAL_base {node = Ast.BASE_ident _}
- | Ast.LVAL_base {node = Ast.BASE_app _} -> true
+ Ast.LVAL_base {node = Ast.BASE_ident _; _}
+ | Ast.LVAL_base {node = Ast.BASE_app _; _} -> true
| Ast.LVAL_ext (lv', Ast.COMP_named (Ast.COMP_ident _))
| Ast.LVAL_ext (lv', Ast.COMP_named (Ast.COMP_app _))
-> lval_is_name lv'
@@ -749,7 +749,7 @@ let pattern_resolving_visitor
end
in
- let resolve_arm { node = arm } =
+ let resolve_arm { node = arm; _ } =
match fst arm with
Ast.PAT_tag (lval, pats) ->
let lval_nm = lval_to_name lval in
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 15105ab3..a4bad711 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -546,7 +546,7 @@ let slot_ty (s:Ast.slot) : Ast.ty =
let fn_output_ty (fn_ty:Ast.ty) : Ast.ty =
match fn_ty with
- Ast.TY_fn ({ Ast.sig_output_slot = slot }, _) ->
+ Ast.TY_fn ({ Ast.sig_output_slot = slot; _ }, _) ->
begin
match slot.Ast.slot_ty with
Some ty -> ty
@@ -579,8 +579,8 @@ let defn_is_static (d:defn) : bool =
let defn_is_callable (d:defn) : bool =
match d with
- DEFN_slot { Ast.slot_ty = Some Ast.TY_fn _ }
- | DEFN_item { Ast.decl_item = (Ast.MOD_ITEM_fn _ ) } -> true
+ DEFN_slot { Ast.slot_ty = Some Ast.TY_fn _; _ }
+ | DEFN_item { Ast.decl_item = (Ast.MOD_ITEM_fn _ ); _ } -> true
| _ -> false
;;
@@ -637,7 +637,7 @@ let atoms_to_names (atoms:Ast.atom array)
let rec lval_to_name (lv:Ast.lval) : Ast.name =
match lv with
- Ast.LVAL_base { node = nb } ->
+ Ast.LVAL_base { node = nb; _ } ->
Ast.NAME_base nb
| Ast.LVAL_ext (lv, lv_comp) ->
let comp =
@@ -655,7 +655,7 @@ let rec plval_to_name (pl:Ast.plval) : Ast.name =
match pl with
Ast.PLVAL_base nb ->
Ast.NAME_base nb
- | Ast.PLVAL_ext_name ({node = Ast.PEXP_lval pl}, nc) ->
+ | Ast.PLVAL_ext_name ({node = Ast.PEXP_lval pl; _}, nc) ->
Ast.NAME_ext (plval_to_name pl, nc)
| _ -> bug () "plval_to_name with plval that contains non-name components"
;;
@@ -1878,7 +1878,7 @@ let get_mod_item
(node:node_id)
: (Ast.mod_view * Ast.mod_items) =
match get_item cx node with
- { Ast.decl_item = Ast.MOD_ITEM_mod md } -> md
+ { Ast.decl_item = Ast.MOD_ITEM_mod md; _ } -> md
| _ -> bugi cx node "defn is not a mod"
;;
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 79ed4150..2697c8b5 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -1368,7 +1368,7 @@ let trans_visitor
and get_obj_vtbl (id:node_id) : Il.operand =
let obj =
match Hashtbl.find cx.ctxt_all_defns id with
- DEFN_item { Ast.decl_item=Ast.MOD_ITEM_obj obj} -> obj
+ DEFN_item { Ast.decl_item=Ast.MOD_ITEM_obj obj; _} -> obj
| _ -> bug () "Trans.get_obj_vtbl on non-obj referent"
in
trans_crate_rel_data_operand (DATA_obj_vtbl id)
@@ -4755,8 +4755,8 @@ let trans_visitor
match lval with
Ast.LVAL_ext (_, (Ast.COMP_named (Ast.COMP_ident id)))
| Ast.LVAL_ext (_, (Ast.COMP_named (Ast.COMP_app (id, _))))
- | Ast.LVAL_base { node = Ast.BASE_ident id }
- | Ast.LVAL_base { node = Ast.BASE_app (id, _) } -> id
+ | Ast.LVAL_base { node = Ast.BASE_ident id; _ }
+ | Ast.LVAL_base { node = Ast.BASE_app (id, _); _ } -> id
| _ -> bug cx "expected lval ending in ident"
in
let ttag =
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index a47850fe..4b329502 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -1261,11 +1261,11 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
if cx.Semant.ctxt_main_name = Some path_name then
try
match Hashtbl.find cx.Semant.ctxt_all_item_types item_id with
- Ast.TY_fn ({ Ast.sig_input_slots = [| |] }, _)
+ Ast.TY_fn ({ Ast.sig_input_slots = [| |]; _ }, _)
| Ast.TY_fn ({ Ast.sig_input_slots = [| {
Ast.slot_mode = Ast.MODE_local;
Ast.slot_ty = Some (Ast.TY_vec Ast.TY_str)
- } |] }, _) ->
+ } |]; _}, _) ->
()
| _ -> Common.err (Some item_id) "main fn has bad type signature"
with Not_found ->
@@ -1327,7 +1327,7 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
let obj_ty = Hashtbl.find cx.Semant.ctxt_all_item_types obj.Common.id in
match obj_ty with
Ast.TY_fn ({ Ast.sig_output_slot =
- { Ast.slot_ty = Some (Ast.TY_obj (_, methods)) } }, _) ->
+ { Ast.slot_ty = Some (Ast.TY_obj (_, methods)); _ }; _ }, _) ->
push_fn_ctx_of_ty_fn (Hashtbl.find methods ident)
| _ ->
Common.bug ()
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index e3c9974a..95aa1107 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -714,7 +714,7 @@ let condition_assigning_visitor
| Ast.STMT_alt_tag at ->
let precond = slot_inits (lval_slots cx at.Ast.alt_tag_lval) in
- let visit_arm { node = (pat, block) } =
+ let visit_arm { node = (pat, block); _ } =
(* FIXME (issue #34): propagate tag-carried constrs here. *)
let rec get_slots pat =
match pat with
@@ -1048,7 +1048,7 @@ let graph_special_block_structure_building_visitor
let graph = ts.ts_graph in
let dsts = Hashtbl.find graph s.id in
let arm_blocks =
- let arm_block_id { node = (_, block) } = block.id in
+ let arm_block_id { node = (_, block); _ } = block.id in
Array.to_list (Array.map arm_block_id at.Ast.alt_tag_arms)
in
let succ_stmts =
@@ -1470,7 +1470,7 @@ let lifecycle_visitor
iflog cx (fun _ -> log cx "entering a loop");
Stack.push (Some (Stack.create ())) loop_blocks;
- | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms } ->
+ | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms; _ } ->
let note_slot block slot_id =
log cx
"noting implicit init for slot %d in pattern-alt block %d"
@@ -1479,7 +1479,7 @@ let lifecycle_visitor
in
let rec all_pat_slot_ids block pat =
match pat with
- Ast.PAT_slot ({ id = slot_id }, _) ->
+ Ast.PAT_slot ({ id = slot_id; _ }, _) ->
[ slot_id ]
| Ast.PAT_tag (_, pats) ->
List.concat
@@ -1490,7 +1490,7 @@ let lifecycle_visitor
in
Array.iter
begin
- fun { node = (pat, block) } ->
+ fun { node = (pat, block); _ } ->
let slot_ids = all_pat_slot_ids block pat in
List.iter (note_slot block) slot_ids;
htab_put implicit_init_block_slots
diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml
index d776d82d..03577c80 100644
--- a/src/boot/me/walk.ml
+++ b/src/boot/me/walk.ml
@@ -517,7 +517,7 @@ and walk_stmt
| Ast.STMT_alt_tag
{ Ast.alt_tag_lval = lval; Ast.alt_tag_arms = arms } ->
walk_lval v lval;
- let walk_arm { node = (pat, block) } =
+ let walk_arm { node = (pat, block); _ } =
walk_pat v pat;
walk_block v block
in
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-11 08:58:19 +0000