5.14. Elide unused entries

Name binding pass 2.
Start ocaml section to src/flx_prop.mli[1 /1 ]
     1: # 6 "./lpsrc/flx_prop.ipk"
     2: open Flx_ast
     3: open Flx_types
     4: open Flx_typing
     5: open Flx_mtypes1
     6: open Flx_mtypes2
     7: 
     8: val add_prop:
     9:   fully_bound_symbol_table_t  ->
    10:   property_t ->
    11:   int ->
    12:   unit
    13: 
    14: val rem_prop:
    15:   fully_bound_symbol_table_t  ->
    16:   property_t ->
    17:   int ->
    18:   unit
    19: 
    20: val get_vs:
    21:   fully_bound_symbol_table_t  ->
    22:   int ->
    23:   bvs_t
    24: 
End ocaml section to src/flx_prop.mli[1]
Start ocaml section to src/flx_prop.ml[1 /1 ]
     1: # 31 "./lpsrc/flx_prop.ipk"
     2: open Flx_util
     3: open Flx_ast
     4: open Flx_types
     5: open Flx_mtypes1
     6: open Flx_mtypes2
     7: open Flx_print
     8: open Flx_typing
     9: open Flx_mbind
    10: open Flx_srcref
    11: open List
    12: open Flx_unify
    13: open Flx_treg
    14: open Flx_exceptions
    15: open Flx_use
    16: 
    17: let add_prop bbdfns p i =
    18:   let id,parent,sr,entry = Hashtbl.find bbdfns i in
    19:   match entry with
    20:   | `BBDCL_function (props,vs,ps,ret,exes) ->
    21:     let entry = `BBDCL_function (p :: props,vs,ps,ret,exes) in
    22:     Hashtbl.replace bbdfns i (id,parent,sr,entry);
    23: 
    24:   (* because of type classes .. *)
    25:   | `BBDCL_fun (props,vs,ps,ret,ct,reqs,prec) ->
    26:     let entry = `BBDCL_fun (p :: props,vs,ps,ret,ct,reqs,prec) in
    27:     Hashtbl.replace bbdfns i (id,parent,sr,entry);
    28: 
    29:   | `BBDCL_procedure (props,vs,ps,exes) ->
    30:     let entry = `BBDCL_procedure (p :: props,vs,ps,exes) in
    31:     Hashtbl.replace bbdfns i (id,parent,sr,entry)
    32: 
    33:   (* because of type classes .. *)
    34:   | `BBDCL_proc (props,vs,ps,ct,reqs) ->
    35:     let entry = `BBDCL_proc (p :: props,vs,ps,ct,reqs) in
    36:     Hashtbl.replace bbdfns i (id,parent,sr,entry);
    37: 
    38:   | `BBDCL_regmatch (props,vs,ps,t,x) ->
    39:     let entry = `BBDCL_regmatch (p :: props, vs, ps, t, x) in
    40:     Hashtbl.replace bbdfns i (id,parent,sr,entry)
    41: 
    42:   | `BBDCL_reglex (props,vs,ps,le,t,x) ->
    43:     let entry = `BBDCL_reglex (p :: props, vs, ps, le, t, x) in
    44:     Hashtbl.replace bbdfns i (id,parent,sr,entry)
    45: 
    46:   | `BBDCL_glr (props, vs, t, x) ->
    47:     let entry = `BBDCL_glr (p :: props, vs, t, x) in
    48:     Hashtbl.replace bbdfns i (id,parent,sr,entry)
    49: 
    50:   | _ -> ()
    51: 
    52: let rem_prop bbdfns p i =
    53:   let id,parent,sr,entry = Hashtbl.find bbdfns i in
    54:   match entry with
    55:   | `BBDCL_function (props,vs,ps,ret,exes) ->
    56:     let props = List.filter (fun k -> p <> k) props in
    57:     let entry = `BBDCL_function (props,vs,ps,ret,exes) in
    58:     Hashtbl.replace bbdfns i (id,parent,sr,entry);
    59: 
    60:   (* because of type classes .. *)
    61:   | `BBDCL_fun (props,vs,ps,ret,ct,reqs,prec) ->
    62:     let props = List.filter (fun k -> p <> k) props in
    63:     let entry = `BBDCL_fun (props,vs,ps,ret,ct,reqs,prec) in
    64:     Hashtbl.replace bbdfns i (id,parent,sr,entry);
    65: 
    66:   | `BBDCL_procedure (props,vs,ps,exes) ->
    67:     let props = List.filter (fun k -> p <> k) props in
    68:     let entry = `BBDCL_procedure (props,vs,ps,exes) in
    69:     Hashtbl.replace bbdfns i (id,parent,sr,entry)
    70: 
    71:   (* because of type classes .. *)
    72:   | `BBDCL_proc (props,vs,ps,ct,reqs) ->
    73:     let props = List.filter (fun k -> p <> k) props in
    74:     let entry = `BBDCL_proc (props,vs,ps,ct,reqs) in
    75:     Hashtbl.replace bbdfns i (id,parent,sr,entry);
    76: 
    77:   | `BBDCL_regmatch (props,vs,ps,t,x) ->
    78:     let props = List.filter (fun k -> p <> k) props in
    79:     let entry = `BBDCL_regmatch (props, vs, ps, t, x) in
    80:     Hashtbl.replace bbdfns i (id,parent,sr,entry)
    81: 
    82:   | `BBDCL_reglex (props,vs,ps,le,t,x) ->
    83:     let props = List.filter (fun k -> p <> k) props in
    84:     let entry = `BBDCL_reglex (props, vs, ps, le, t, x) in
    85:     Hashtbl.replace bbdfns i (id,parent,sr,entry)
    86: 
    87:   | `BBDCL_glr (props, vs, t, x) ->
    88:     let props = List.filter (fun k -> p <> k) props in
    89:     let entry = `BBDCL_glr (props, vs, t, x) in
    90:     Hashtbl.replace bbdfns i (id,parent,sr,entry)
    91: 
    92:   | _ -> ()
    93: 
    94: let get_vs bbdfns i =
    95:   let _,_,_,entry = Hashtbl.find bbdfns i in
    96:   match entry with
    97:   | `BBDCL_function (props,vs,(ps,traint),ret,exes) -> vs
    98:   | `BBDCL_procedure (props,vs,(ps,traint), exes) -> vs
    99:   | `BBDCL_val (vs,t) -> vs
   100:   | `BBDCL_var (vs,t) -> vs
   101:   | `BBDCL_ref (vs,t) -> vs
   102:   | `BBDCL_tmp (vs,t) -> vs
   103:   | `BBDCL_glr (props,vs,ret, (p,exes)) -> vs
   104:   | `BBDCL_regmatch (props,vs,(ps,traint),ret,(alpha,states,h,mx))  -> vs
   105:   | `BBDCL_reglex (props,vs,(ps,traint),le,ret,(alpha,states,h,mx)) -> vs
   106:   | `BBDCL_class (props,vs) -> vs
   107:   | `BBDCL_union (vs,ps) -> vs
   108:   | `BBDCL_struct (vs,ps) -> vs
   109:   | `BBDCL_cstruct (vs,ps) -> vs
   110:   | `BBDCL_newtype (vs,t) -> vs
   111:   | `BBDCL_cclass (vs,ps) -> vs
   112:   | `BBDCL_const (vs,t,ct,reqs) -> vs
   113:   | `BBDCL_insert (vs,s,ikind,reqs) -> vs
   114:   | `BBDCL_fun (props,vs,argtypes,ret,ct,reqs,prec) -> vs
   115:   | `BBDCL_callback (props,vs,argtypes_cf,argtypes_c,k,ret,reqs,prec) -> vs
   116:   | `BBDCL_proc (props,vs,argtypes,ct,reqs) -> vs
   117:   | `BBDCL_abs (vs,tqual,ct,reqs) ->  vs
   118:   | `BBDCL_nonconst_ctor (vs,uidx,udt, ctor_idx, ctor_argt, evs, etraint) -> vs
   119:   | `BBDCL_typeclass (props,vs) ->  vs
   120:   | `BBDCL_instance (props,vs,con,tc,ts) -> vs
   121: 
   122: 
   123: 
End ocaml section to src/flx_prop.ml[1]