@@ -984,6 +984,42 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
984
984
in
985
985
check_stmt
986
986
987
+ let create_tag_graph_node (cx :Semant.ctxt ) (id :Common.opaque_id ) (n :int ) =
988
+ let tag_info = Hashtbl. find cx.Semant. ctxt_all_tag_info id in
989
+ let (_, _, ty_tup) = Hashtbl. find tag_info.Semant. tag_nums n in
990
+ let rec add_ty =
991
+ function
992
+ Ast. TY_tag { Ast. tag_id = id' ; Ast. tag_args = tys } ->
993
+ let make_graph_node () = {
994
+ Semant. tgn_index = None ;
995
+ Semant. tgn_children = Queue. create ()
996
+ } in
997
+ let tag_graph_node =
998
+ Common. htab_search_or_add cx.Semant. ctxt_tag_containment id
999
+ make_graph_node
1000
+ in
1001
+ Queue. add id' tag_graph_node.Semant. tgn_children;
1002
+ Array. iter add_ty tys
1003
+ | Ast. TY_tup tys -> Array. iter add_ty tys
1004
+ | Ast. TY_rec ty_rec ->
1005
+ Array. iter (fun (_ , ty ) -> add_ty ty) ty_rec
1006
+ | Ast. TY_fn ty_fn -> add_ty_fn ty_fn
1007
+ | Ast. TY_vec ty | Ast. TY_chan ty | Ast. TY_port ty | Ast. TY_mutable ty
1008
+ | Ast. TY_constrained (ty , _ ) -> add_ty ty
1009
+ | Ast. TY_obj (_ , ty_fns ) ->
1010
+ Hashtbl. iter (fun _ ty_fn -> add_ty_fn ty_fn) ty_fns
1011
+ | _ -> ()
1012
+ and add_ty_fn (ty_sig , _ ) =
1013
+ let add_slot slot =
1014
+ match slot.Ast. slot_ty with
1015
+ None -> ()
1016
+ | Some ty -> add_ty ty
1017
+ in
1018
+ Array. iter add_slot ty_sig.Ast. sig_input_slots;
1019
+ add_slot ty_sig.Ast. sig_output_slot
1020
+ in
1021
+ Array. iter add_ty ty_tup
1022
+
987
1023
let process_crate (cx :Semant.ctxt ) (crate :Ast.crate ) : unit =
988
1024
let path = Stack. create () in
989
1025
let fn_ctx_stack = Stack. create () in
@@ -1052,6 +1088,7 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
1052
1088
Ast. MOD_ITEM_fn _ when
1053
1089
not (Hashtbl. mem cx.Semant. ctxt_required_items item_id) ->
1054
1090
finish_function item_id
1091
+ | Ast. MOD_ITEM_tag (_ , id , n ) -> create_tag_graph_node cx id n
1055
1092
| _ -> ()
1056
1093
in
1057
1094
0 commit comments