diff --git a/src/boot/me/alias.ml b/src/boot/me/alias.ml index a038030ee8412..94d34fb2df04c 100644 --- a/src/boot/me/alias.ml +++ b/src/boot/me/alias.ml @@ -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 diff --git a/src/boot/me/effect.ml b/src/boot/me/effect.ml index c55e1d12b30d7..79868defa418e 100644 --- a/src/boot/me/effect.ml +++ b/src/boot/me/effect.ml @@ -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 diff --git a/src/boot/me/layout.ml b/src/boot/me/layout.ml index 49aa1340eee1d..a9358795ed38d 100644 --- a/src/boot/me/layout.ml +++ b/src/boot/me/layout.ml @@ -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 diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml index 2c2b1b4b60948..bf11ad23245dc 100644 --- a/src/boot/me/resolve.ml +++ b/src/boot/me/resolve.ml @@ -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 diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index ff10a300431ad..7a9aa922e6e91 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -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,58 +254,122 @@ 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 +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 = + match lv with + Ast.LVAL_base nbi -> nbi.id + | Ast.LVAL_ext (lv, _) -> lval_base_id lv +;; + +let lval_is_base (lv:Ast.lval) : bool = + match lv with + Ast.LVAL_base _ -> true + | _ -> false +;; + +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 referent_is_item (cx:ctxt) (id:node_id) : bool = - match Hashtbl.find cx.ctxt_all_defns id with +let defn_is_item (defn:defn) : bool = + match defn with DEFN_item _ -> true | _ -> false ;; -let rec lval_base_id (lv:Ast.lval) : node_id = - match lv with - Ast.LVAL_base nbi -> nbi.id - | Ast.LVAL_ext (lv, _) -> lval_base_id lv +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 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_base_is_item (cx:ctxt) (lval:Ast.lval) : bool = + defn_id_is_item cx (lval_base_defn_id cx lval) ;; -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_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 diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index 4bf974b2c843a..5584b48587bcf 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -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) diff --git a/src/boot/me/transutil.ml b/src/boot/me/transutil.ml index 69cba51c6ca30..c63be4640be0d 100644 --- a/src/boot/me/transutil.ml +++ b/src/boot/me/transutil.ml @@ -243,8 +243,6 @@ let iter_rec_parts ;; - - (* * Local Variables: * fill-column: 78; diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml index d7d3bd63fe694..ce5cf9f478b8c 100644 --- a/src/boot/me/type.ml +++ b/src/boot/me/type.ml @@ -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 diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml index 86d6b9a745e29..baf4a54398ccd 100644 --- a/src/boot/me/typestate.ml +++ b/src/boot/me/typestate.ml @@ -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 diff --git a/src/test/run-pass/spawn-module-qualified.rs b/src/test/run-pass/spawn-module-qualified.rs new file mode 100644 index 0000000000000..68f665df7d8d0 --- /dev/null +++ b/src/test/run-pass/spawn-module-qualified.rs @@ -0,0 +1,9 @@ +fn main() { + auto x = spawn m.child(10); + join x; +} +mod m { + fn child(int i) { + log i; + } +}