mikros/rust
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Distill semantics of use-def maps to fewer and more-obvious words.

Browse Source 
- Remove redundant uses of 'resolve' and 'referent' in semant.
- Use defn, defn_id, lval, lval_base more consistently.
- Make associated query functions more consistent.
- Closes #127.
This commit is contained in:
Graydon Hoare 2010-07-27 11:19:43 -07:00
parent b7d7f70d09
commit 4d31cf1dc5
10 changed files with 218 additions and 182 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/boot/me/alias.ml
View File

@ -20,10 +20,9 @@ let alias_analysis_visitor
in
let alias lval =
let lv_id = lval_base_id lval in
let referent = Hashtbl.find cx.ctxt_lval_to_referent lv_id in
if (referent_is_slot cx referent)
then alias_slot referent
let defn_id = lval_base_defn_id cx lval in
if (defn_id_is_slot cx defn_id)
then alias_slot defn_id
in
let alias_atom at =
@ -85,8 +84,8 @@ let alias_analysis_visitor
in
let visit_lval_pre lv =
let slot_id = lval_to_referent cx (lval_base_id lv) in
if (not (Stack.is_empty curr_stmt)) && (referent_is_slot cx slot_id)
let slot_id = lval_base_defn_id cx lv in
if (not (Stack.is_empty curr_stmt)) && (defn_id_is_slot cx slot_id)
then
begin
let slot_depth = get_slot_depth cx slot_id in

4
src/boot/me/effect.ml
View File

@ -172,7 +172,7 @@ let function_effect_propagation_visitor
lower_to s taux.Ast.fn_effect;
| _ -> bug () "non-fn callee"
in
if lval_is_slot cx fn
if lval_base_is_slot cx fn
then
lower_to_callee_ty (lval_ty cx fn)
else
@ -335,7 +335,7 @@ let process_crate
match lookup_by_name cx [] root_scope name with
None -> ()
| Some (_, id) ->
if referent_is_item cx id
if defn_id_is_item cx id
then htab_put item_auth id eff
else err (Some id) "auth clause in crate refers to non-item"
in

6
src/boot/me/layout.ml
View File

@ -412,9 +412,9 @@ let layout_visitor
let static = lval_is_static cx callee in
let closure = if static then None else Some Il.OpaqueTy in
let n_ty_params =
match resolve_lval cx callee with
DEFN_item i -> Array.length i.Ast.decl_params
| _ -> 0
if lval_base_is_item cx callee
then Array.length (lval_item cx callee).node.Ast.decl_params
else 0
in
let rty =
call_args_referent_type cx n_ty_params lv_ty closure

24
src/boot/me/resolve.ml
View File

@ -562,7 +562,7 @@ let type_resolving_visitor
| Ast.MOD_ITEM_tag (header_slots, _, nid)
when Hashtbl.mem recursive_tag_groups nid ->
begin
match ty_of_mod_item true item with
match ty_of_mod_item item with
Ast.TY_fn (tsig, taux) ->
let input_slots =
Array.map
@ -586,7 +586,7 @@ let type_resolving_visitor
end
| _ ->
let t = ty_of_mod_item true item in
let t = ty_of_mod_item item in
let ty =
resolve_type cx (!scopes) recursive_tag_groups
all_tags empty_recur_info t
@ -686,7 +686,7 @@ let lval_base_resolving_visitor
(scopes:(scope list) ref)
(inner:Walk.visitor)
: Walk.visitor =
let lookup_referent_by_ident id ident =
let lookup_defn_by_ident id ident =
log cx "looking up slot or item with ident '%s'" ident;
match lookup cx (!scopes) (Ast.KEY_ident ident) with
None -> err (Some id) "unresolved identifier '%s'" ident
@ -702,10 +702,10 @@ let lval_base_resolving_visitor
| Some (_, id) ->
(log cx "resolved to node id #%d" (int_of_node id); id)
in
let lookup_referent_by_name_base id nb =
let lookup_defn_by_name_base id nb =
match nb with
Ast.BASE_ident ident
| Ast.BASE_app (ident, _) -> lookup_referent_by_ident id ident
| Ast.BASE_app (ident, _) -> lookup_defn_by_ident id ident
| Ast.BASE_temp temp -> lookup_slot_by_temp id temp
in
@ -723,10 +723,10 @@ let lval_base_resolving_visitor
| _ -> ()
end
| Ast.LVAL_base nb ->
let referent_id = lookup_referent_by_name_base nb.id nb.node in
iflog cx (fun _ -> log cx "resolved lval #%d to referent #%d"
(int_of_node nb.id) (int_of_node referent_id));
htab_put cx.ctxt_lval_to_referent nb.id referent_id
let defn_id = lookup_defn_by_name_base nb.id nb.node in
iflog cx (fun _ -> log cx "resolved lval #%d to defn #%d"
(int_of_node nb.id) (int_of_node defn_id));
htab_put cx.ctxt_lval_base_id_to_defn_base_id nb.id defn_id
in
(*
@ -745,7 +745,7 @@ let lval_base_resolving_visitor
-> lval_is_name lv'
| _ -> false
in
if lval_is_name lv && lval_is_item cx lv
if lval_is_name lv && lval_base_is_item cx lv
then ignore (lookup_by_name cx [] (!scopes) (lval_to_name lv))
in
@ -932,7 +932,7 @@ let pattern_resolving_visitor
let lval_nm = lval_to_name lval in
let lval_id = lval_base_id lval in
let tag_ctor_id = (lval_item cx lval).id in
if referent_is_item cx tag_ctor_id
if defn_id_is_item cx tag_ctor_id
(* FIXME (issue #76): we should actually check here that the
* function is a tag value-ctor. For now this actually allows
@ -1050,7 +1050,7 @@ let process_crate
Hashtbl.iter
begin
fun n _ ->
if referent_is_item cx n
if defn_id_is_item cx n
then
log cx "referenced: %a"
Ast.sprintf_name

260
src/boot/me/semant.ml
View File

@ -105,8 +105,8 @@ type ctxt =
(* definition id --> definition *)
ctxt_all_defns: (node_id,defn) Hashtbl.t;
(* reference id --> definition id *)
ctxt_lval_to_referent: (node_id,node_id) Hashtbl.t;
(* reference id --> definitition id *)
ctxt_lval_base_id_to_defn_base_id: (node_id,node_id) Hashtbl.t;
ctxt_required_items: (node_id, (required_lib * nabi_conv)) Hashtbl.t;
ctxt_required_syms: (node_id, string) Hashtbl.t;
@ -187,7 +187,7 @@ let new_ctxt sess abi crate =
ctxt_all_lvals = Hashtbl.create 0;
ctxt_all_defns = Hashtbl.create 0;
ctxt_call_lval_params = Hashtbl.create 0;
ctxt_lval_to_referent = Hashtbl.create 0;
ctxt_lval_base_id_to_defn_base_id = Hashtbl.create 0;
ctxt_required_items = crate.Ast.crate_required;
ctxt_required_syms = crate.Ast.crate_required_syms;
@ -254,30 +254,24 @@ let bugi (cx:ctxt) (i:node_id) =
in Printf.ksprintf k
;;
(* Convenience accessors. *)
(* Building blocks for semantic lookups. *)
(* resolve an lval reference id to the id of its definition *)
let lval_to_referent (cx:ctxt) (id:node_id) : node_id =
if Hashtbl.mem cx.ctxt_lval_to_referent id
then Hashtbl.find cx.ctxt_lval_to_referent id
else bug () "unresolved lval"
let get_defn (cx:ctxt) (defn_id:node_id) : defn =
match htab_search cx.ctxt_all_defns defn_id with
Some defn -> defn
| None -> bugi cx defn_id "use of defn without entry in ctxt"
;;
(* resolve an lval reference id to its definition *)
let resolve_lval_id (cx:ctxt) (id:node_id) : defn =
Hashtbl.find cx.ctxt_all_defns (lval_to_referent cx id)
let get_item (cx:ctxt) (defn_id:node_id) : Ast.mod_item_decl =
match get_defn cx defn_id with
DEFN_item item -> item
| _ -> bugi cx defn_id "defn is not an item"
;;
let referent_is_slot (cx:ctxt) (id:node_id) : bool =
match Hashtbl.find cx.ctxt_all_defns id with
DEFN_slot _ -> true
| _ -> false
;;
let referent_is_item (cx:ctxt) (id:node_id) : bool =
match Hashtbl.find cx.ctxt_all_defns id with
DEFN_item _ -> true
| _ -> false
let get_slot (cx:ctxt) (defn_id:node_id) : Ast.slot =
match get_defn cx defn_id with
DEFN_slot slot -> slot
| _ -> bugi cx defn_id "defn is not an slot"
;;
let rec lval_base_id (lv:Ast.lval) : node_id =
@ -286,26 +280,96 @@ let rec lval_base_id (lv:Ast.lval) : node_id =
| Ast.LVAL_ext (lv, _) -> lval_base_id lv
;;
let get_item (cx:ctxt) (node:node_id) : Ast.mod_item_decl =
match htab_search cx.ctxt_all_defns node with
Some (DEFN_item item) -> item
| Some _ -> bugi cx node "defn is not an item"
| None -> bugi cx node "missing defn"
let lval_is_base (lv:Ast.lval) : bool =
match lv with
Ast.LVAL_base _ -> true
| _ -> false
;;
let get_slot (cx:ctxt) (node:node_id) : Ast.slot =
match htab_search cx.ctxt_all_defns node with
Some (DEFN_slot slot) -> slot
| Some _ -> bugi cx node "defn is not a slot"
| None -> bugi cx node "missing defn"
let lval_base_id_to_defn_base_id (cx:ctxt) (lid:node_id) : node_id =
match htab_search cx.ctxt_lval_base_id_to_defn_base_id lid with
Some defn_id -> defn_id
| None -> bugi cx lid "use of unresolved lval"
;;
let lval_base_defn_id (cx:ctxt) (lval:Ast.lval) : node_id =
lval_base_id_to_defn_base_id cx (lval_base_id lval)
;;
let lval_base_defn (cx:ctxt) (lval:Ast.lval) : defn =
get_defn cx (lval_base_defn_id cx lval)
;;
let lval_base_slot (cx:ctxt) (lval:Ast.lval) : Ast.slot =
get_slot cx (lval_base_defn_id cx lval)
;;
let lval_base_item (cx:ctxt) (lval:Ast.lval) : Ast.mod_item_decl =
get_item cx (lval_base_defn_id cx lval)
;;
(* Judgements on defns and lvals. *)
let defn_is_slot (defn:defn) : bool =
match defn with
DEFN_slot _ -> true
| _ -> false
;;
let defn_is_item (defn:defn) : bool =
match defn with
DEFN_item _ -> true
| _ -> false
;;
let defn_is_obj_fn (defn:defn) : bool =
match defn with
DEFN_obj_fn _ -> true
| _ -> false
;;
let defn_is_obj_drop (defn:defn) : bool =
match defn with
DEFN_obj_drop _ -> true
| _ -> false
;;
let defn_id_is_slot (cx:ctxt) (defn_id:node_id) : bool =
defn_is_slot (get_defn cx defn_id)
;;
let defn_id_is_item (cx:ctxt) (defn_id:node_id) : bool =
defn_is_item (get_defn cx defn_id)
;;
let defn_id_is_obj_fn (cx:ctxt) (defn_id:node_id) : bool =
defn_is_obj_fn (get_defn cx defn_id)
;;
let defn_id_is_obj_drop (cx:ctxt) (defn_id:node_id) : bool =
defn_is_obj_drop (get_defn cx defn_id)
;;
let lval_base_is_slot (cx:ctxt) (lval:Ast.lval) : bool =
defn_id_is_slot cx (lval_base_defn_id cx lval)
;;
let lval_base_is_item (cx:ctxt) (lval:Ast.lval) : bool =
defn_id_is_item cx (lval_base_defn_id cx lval)
;;
let lval_is_static (cx:ctxt) (lval:Ast.lval) : bool =
not (lval_base_is_slot cx lval)
;;
(* coerce an lval reference id to its definition slot *)
let lval_base_to_slot (cx:ctxt) (lval:Ast.lval) : Ast.slot identified =
let lid = lval_base_id lval in
let rid = lval_to_referent cx lid in
let slot = get_slot cx rid in
{ node = slot; id = rid }
assert (lval_is_base lval);
let sid = lval_base_defn_id cx lval in
let slot = get_slot cx sid in
{ node = slot; id = sid }
;;
let get_stmt_depth (cx:ctxt) (id:node_id) : int =
@ -343,13 +407,6 @@ let rec n_item_ty_params (cx:ctxt) (id:node_id) : int =
| _ -> bugi cx id "n_item_ty_params on non-item"
;;
let item_is_obj_fn (cx:ctxt) (id:node_id) : bool =
match Hashtbl.find cx.ctxt_all_defns id with
DEFN_obj_fn _
| DEFN_obj_drop _ -> true
| _ -> false
;;
let get_spill (cx:ctxt) (id:node_id) : fixup =
if Hashtbl.mem cx.ctxt_spill_fixups id
then Hashtbl.find cx.ctxt_spill_fixups id
@ -522,57 +579,6 @@ let rec lval_to_name (lv:Ast.lval) : Ast.name =
Ast.NAME_ext (lval_to_name lv, comp)
;;
let rec lval_slots (cx:ctxt) (lv:Ast.lval) : node_id array =
match lv with
Ast.LVAL_base nbi ->
let referent = lval_to_referent cx nbi.id in
if referent_is_slot cx referent
then [| referent |]
else [| |]
| Ast.LVAL_ext (lv, Ast.COMP_named _)
| Ast.LVAL_ext (lv, Ast.COMP_deref) -> lval_slots cx lv
| Ast.LVAL_ext (lv, Ast.COMP_atom a) ->
Array.append (lval_slots cx lv) (atom_slots cx a)
and atom_slots (cx:ctxt) (a:Ast.atom) : node_id array =
match a with
Ast.ATOM_literal _ -> [| |]
| Ast.ATOM_lval lv -> lval_slots cx lv
;;
let lval_option_slots (cx:ctxt) (lv:Ast.lval option) : node_id array =
match lv with
None -> [| |]
| Some lv -> lval_slots cx lv
;;
let resolve_lval (cx:ctxt) (lv:Ast.lval) : defn =
resolve_lval_id cx (lval_base_id lv)
;;
let atoms_slots (cx:ctxt) (az:Ast.atom array) : node_id array =
Array.concat (List.map (atom_slots cx) (Array.to_list az))
;;
let tup_inputs_slots (cx:ctxt) (az:Ast.tup_input array) : node_id array =
Array.concat (List.map (atom_slots cx) (Array.to_list (Array.map snd az)))
;;
let rec_inputs_slots (cx:ctxt)
(inputs:Ast.rec_input array) : node_id array =
Array.concat (List.map
(fun (_, _, atom) -> atom_slots cx atom)
(Array.to_list inputs))
;;
let expr_slots (cx:ctxt) (e:Ast.expr) : node_id array =
match e with
Ast.EXPR_binary (_, a, b) ->
Array.append (atom_slots cx a) (atom_slots cx b)
| Ast.EXPR_unary (_, u) -> atom_slots cx u
| Ast.EXPR_atom a -> atom_slots cx a
;;
(* Type extraction. *)
@ -1111,14 +1117,11 @@ let exports_permit (view:Ast.mod_view) (ident:Ast.ident) : bool =
(* NB: this will fail if lval is not an item. *)
let rec lval_item (cx:ctxt) (lval:Ast.lval) : Ast.mod_item =
match lval with
Ast.LVAL_base nb ->
begin
let referent = lval_to_referent cx nb.id in
match htab_search cx.ctxt_all_defns referent with
Some (DEFN_item item) -> {node=item; id=referent}
| _ -> err (Some (lval_base_id lval))
"lval does not name an item"
end
Ast.LVAL_base _ ->
let defn_id = lval_base_defn_id cx lval in
let item = get_item cx defn_id in
{ node = item; id = defn_id }
| Ast.LVAL_ext (base, comp) ->
let base_item = lval_item cx base in
match base_item.node.Ast.decl_item with
@ -1146,33 +1149,6 @@ let rec lval_item (cx:ctxt) (lval:Ast.lval) : Ast.mod_item =
"lval base %a does not name a module" Ast.sprintf_lval base
;;
let lval_is_slot (cx:ctxt) (lval:Ast.lval) : bool =
match resolve_lval cx lval with
DEFN_slot _ -> true
| _ -> false
;;
let lval_is_item (cx:ctxt) (lval:Ast.lval) : bool =
match resolve_lval cx lval with
DEFN_item _ -> true
| _ -> false
;;
let lval_is_direct_fn (cx:ctxt) (lval:Ast.lval) : bool =
let defn = resolve_lval cx lval in
(defn_is_static defn) && (defn_is_callable defn)
;;
let lval_is_direct_mod (cx:ctxt) (lval:Ast.lval) : bool =
let defn = resolve_lval cx lval in
if not (defn_is_static defn)
then false
else
match defn with
DEFN_item { Ast.decl_item = Ast.MOD_ITEM_mod _ } -> true
| _ -> false
;;
(*
* FIXME: this function is a bad idea and exists only as a workaround
* for other logic that is even worse. Untangle.
@ -1180,9 +1156,9 @@ let lval_is_direct_mod (cx:ctxt) (lval:Ast.lval) : bool =
let rec project_lval_ty_from_slot (cx:ctxt) (lval:Ast.lval) : Ast.ty =
match lval with
Ast.LVAL_base nbi ->
let referent = lval_to_referent cx nbi.id in
if lval_is_slot cx lval
then slot_ty (get_slot cx referent)
let defn_id = lval_base_id_to_defn_base_id cx nbi.id in
if lval_base_is_slot cx lval
then slot_ty (get_slot cx defn_id)
else Hashtbl.find cx.ctxt_all_item_types nbi.id
| Ast.LVAL_ext (base, comp) ->
let base_ty = project_lval_ty_from_slot cx base in
@ -1197,16 +1173,18 @@ let lval_ty (cx:ctxt) (lval:Ast.lval) : Ast.ty =
Ast.sprintf_lval lval
;;
let lval_is_static (cx:ctxt) (lval:Ast.lval) : bool =
defn_is_static (resolve_lval cx lval)
let ty_is_fn (t:Ast.ty) : bool =
match t with
Ast.TY_fn _ -> true
| _ -> false
;;
let lval_is_callable (cx:ctxt) (lval:Ast.lval) : bool =
defn_is_callable (resolve_lval cx lval)
let lval_is_direct_fn (cx:ctxt) (lval:Ast.lval) : bool =
(lval_base_is_item cx lval) && (ty_is_fn (lval_ty cx lval))
;;
let lval_is_obj_vtbl (cx:ctxt) (lval:Ast.lval) : bool =
if lval_is_slot cx lval
if lval_base_is_slot cx lval
then
match lval with
Ast.LVAL_ext (base, _) ->
@ -1266,7 +1244,7 @@ let ty_obj_of_obj (obj:Ast.obj) : Ast.ty_obj =
htab_map obj.Ast.obj_fns (fun i f -> (i, ty_fn_of_fn f.node)))
;;
let ty_of_mod_item ((*inside*)_:bool) (item:Ast.mod_item) : Ast.ty =
let ty_of_mod_item (item:Ast.mod_item) : Ast.ty =
match item.node.Ast.decl_item with
Ast.MOD_ITEM_type _ -> Ast.TY_type
| Ast.MOD_ITEM_fn f -> (Ast.TY_fn (ty_fn_of_fn f))
@ -2044,13 +2022,17 @@ let indirect_call_args_referent_type
call_args_referent_type cx n_ty_params callee_ty (Some closure)
;;
let defn_id_is_obj_fn_or_drop (cx:ctxt) (defn_id:node_id) : bool =
(defn_id_is_obj_fn cx defn_id) || (defn_id_is_obj_drop cx defn_id)
;;
let direct_call_args_referent_type
(cx:ctxt)
(callee_node:node_id)
: Il.referent_ty =
let ity = Hashtbl.find cx.ctxt_all_item_types callee_node in
let n_ty_params =
if item_is_obj_fn cx callee_node
if defn_id_is_obj_fn_or_drop cx callee_node
then 0
else n_item_ty_params cx callee_node
in

10
src/boot/me/trans.ml
View File

@ -150,7 +150,7 @@ let trans_visitor
(closure:Il.referent_ty option)
: Il.referent_ty =
let n_params =
if item_is_obj_fn cx id
if defn_id_is_obj_fn_or_drop cx id
then 0
else n_item_ty_params cx id
in
@ -522,7 +522,7 @@ let trans_visitor
let get_ty_params_of_current_frame _ : Il.cell =
let id = current_fn() in
let n_ty_params = n_item_ty_params cx id in
if item_is_obj_fn cx id
if defn_id_is_obj_fn_or_drop cx id
then
begin
let obj_box = get_obj_for_current_frame() in
@ -1019,14 +1019,14 @@ let trans_visitor
(cell, ty)
in
if lval_is_slot cx lv
if lval_base_is_slot cx lv
then trans_slot_lval_full initializing true lv
else
if initializing
then err None "init item"
else
begin
assert (lval_is_item cx lv);
assert (lval_base_is_item cx lv);
bug ()
"trans_lval_full called on item lval '%a'" Ast.sprintf_lval lv
end
@ -1048,7 +1048,7 @@ let trans_visitor
: (Il.operand * Ast.ty) =
(* direct call to item *)
let fty = Hashtbl.find cx.ctxt_all_lval_types (lval_base_id flv) in
if lval_is_item cx flv then
if lval_base_is_item cx flv then
let fn_item = lval_item cx flv in
let fn_ptr = code_fixup_to_ptr_operand (get_fn_fixup cx fn_item.id) in
(fn_ptr, fty)

2
src/boot/me/transutil.ml
View File

@ -243,8 +243,6 @@ let iter_rec_parts
;;
(*
* Local Variables:
* fill-column: 78;

8
src/boot/me/type.ml
View File

@ -285,12 +285,12 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
(nbi:Ast.name_base Common.identified)
: ltype =
let lval_id = nbi.Common.id in
let referent = Semant.lval_to_referent cx lval_id in
let defn_id = Semant.lval_base_id_to_defn_base_id cx lval_id in
let lty =
match Hashtbl.find cx.Semant.ctxt_all_defns referent with
match Hashtbl.find cx.Semant.ctxt_all_defns defn_id with
Semant.DEFN_slot _ ->
LTYPE_mono (internal_check_slot infer referent)
| Semant.DEFN_item mid -> internal_check_mod_item_decl mid referent
LTYPE_mono (internal_check_slot infer defn_id)
| Semant.DEFN_item mid -> internal_check_mod_item_decl mid defn_id
| _ -> Common.bug () "internal_check_base_lval: unexpected defn type"
in
match nbi.Common.node with

66
src/boot/me/typestate.ml
View File

@ -120,7 +120,7 @@ let determine_constr_key
let cid =
match lookup_by_name cx [] scopes c.Ast.constr_name with
Some (_, cid) ->
if referent_is_item cx cid
if defn_id_is_item cx cid
then
begin
match Hashtbl.find cx.ctxt_all_item_types cid with
@ -155,7 +155,7 @@ let determine_constr_key
match lookup_by_name cx [] scopes (Ast.NAME_base nb) with
None -> bug () "constraint-arg not found"
| Some (_, aid) ->
if referent_is_slot cx aid
if defn_id_is_slot cx aid
then
if type_has_state
(strip_mutable_or_constrained_ty
@ -187,7 +187,7 @@ let fmt_constr_key cx ckey =
let rec fmt_pth pth =
match pth with
Ast.CARG_base _ ->
if referent_is_slot cx id
if defn_id_is_slot cx id
then
let key = Hashtbl.find cx.ctxt_slot_keys id in
Fmt.fmt_to_str Ast.fmt_slot_key key
@ -241,6 +241,54 @@ let fn_keys fn resolver =
entry_keys fn.Ast.fn_input_slots fn.Ast.fn_input_constrs resolver
;;
let rec lval_slots (cx:ctxt) (lv:Ast.lval) : node_id array =
match lv with
Ast.LVAL_base nbi ->
let defn_id = lval_base_id_to_defn_base_id cx nbi.id in
if defn_id_is_slot cx defn_id
then [| defn_id |]
else [| |]
| Ast.LVAL_ext (lv, Ast.COMP_named _)
| Ast.LVAL_ext (lv, Ast.COMP_deref) -> lval_slots cx lv
| Ast.LVAL_ext (lv, Ast.COMP_atom a) ->
Array.append (lval_slots cx lv) (atom_slots cx a)
and atom_slots (cx:ctxt) (a:Ast.atom) : node_id array =
match a with
Ast.ATOM_literal _ -> [| |]
| Ast.ATOM_lval lv -> lval_slots cx lv
;;
let lval_option_slots (cx:ctxt) (lv:Ast.lval option) : node_id array =
match lv with
None -> [| |]
| Some lv -> lval_slots cx lv
;;
let atoms_slots (cx:ctxt) (az:Ast.atom array) : node_id array =
Array.concat (List.map (atom_slots cx) (Array.to_list az))
;;
let tup_inputs_slots (cx:ctxt) (az:Ast.tup_input array) : node_id array =
Array.concat (List.map (atom_slots cx) (Array.to_list (Array.map snd az)))
;;
let rec_inputs_slots (cx:ctxt)
(inputs:Ast.rec_input array) : node_id array =
Array.concat (List.map
(fun (_, _, atom) -> atom_slots cx atom)
(Array.to_list inputs))
;;
let expr_slots (cx:ctxt) (e:Ast.expr) : node_id array =
match e with
Ast.EXPR_binary (_, a, b) ->
Array.append (atom_slots cx a) (atom_slots cx b)
| Ast.EXPR_unary (_, u) -> atom_slots cx u
| Ast.EXPR_atom a -> atom_slots cx a
;;
let constr_id_assigning_visitor
(cx:ctxt)
(tables_stack:typestate_tables Stack.t)
@ -328,17 +376,17 @@ let constr_id_assigning_visitor
begin
match s.node with
Ast.STMT_call (_, lv, args) ->
let referent = lval_to_referent cx (lval_base_id lv) in
let referent_ty = lval_ty cx lv in
let defn_id = lval_base_defn_id cx lv in
let defn_ty = lval_ty cx lv in
begin
match referent_ty with
match defn_ty with
Ast.TY_fn (tsig,_) ->
let constrs = tsig.Ast.sig_input_constrs in
let names = atoms_to_names args in
let constrs' =
Array.map (apply_names_to_constr names) constrs
in
Array.iter (visit_constr_pre (Some referent)) constrs'
Array.iter (visit_constr_pre (Some defn_id)) constrs'
| _ -> ()
end
@ -488,9 +536,9 @@ let condition_assigning_visitor
in
let visit_callable_pre id dst_slot_ids lv args =
let referent_ty = lval_ty cx lv in
let defn_ty = lval_ty cx lv in
begin
match referent_ty with
match defn_ty with
Ast.TY_fn (tsig,_) ->
let formal_constrs = tsig.Ast.sig_input_constrs in
let names = atoms_to_names args in

9
src/test/run-pass/spawn-module-qualified.rs Normal file
View File

@ -0,0 +1,9 @@
fn main() {
auto x = spawn m.child(10);
join x;
}
mod m {
fn child(int i) {
log i;
}
}