5.57. Display calcs

Start ocaml section to src/flx_display.mli[1 /1 ]
     1: # 4 "./lpsrc/flx_display.ipk"
     2: open Flx_types
     3: open Flx_ast
     4: val get_display_list:
     5:   fully_bound_symbol_table_t ->
     6:   bid_t ->
     7:   (bid_t * int) list
     8: 
     9: val cal_display:
    10:   fully_bound_symbol_table_t ->
    11:   bid_t option ->
    12:   (bid_t * int) list
    13: 
    14: val strd:
    15:   string list -> property_t list -> string
    16: 
End ocaml section to src/flx_display.mli[1]
Start ocaml section to src/flx_display.ml[1 /1 ]
     1: # 21 "./lpsrc/flx_display.ipk"
     2: open Flx_ast
     3: open Flx_types
     4: open Flx_util
     5: open List
     6: 
     7: (* This routine calculates the display a routine with
     8:   a given PARENT requires, which includes that parent
     9:   if it exists.
    10: 
    11:   The result is list of pairs, each pair consisting
    12:   of the ancestor and its vs subdisplay length,
    13:   with the inner most ancestor towards at head of list,
    14:   in particular the parent is always at the head of
    15:   the list if it is empty, and the most global scope
    16:   is at the end of the list.
    17: 
    18:   Note this is the reverse? of the order used to actually pass
    19:   the display entries to constructors, which start with
    20:   the thread frame (definitely) and work inwards (I think, maybe?? ..)
    21:   Hmmm .. should check ..
    22: *)
    23: 
    24: let cal_display bbdfns parent : (bid_t *int) list =
    25:   let rec aux parent display =
    26:     match parent with
    27:     | None -> rev display
    28:     | Some parent ->
    29:     match
    30:       try Hashtbl.find bbdfns parent
    31:       with Not_found ->
    32:         failwith ("[cal_display] Can't find index " ^ si parent)
    33:     with
    34:     | _,parent',sr,`BBDCL_class (_,vs)
    35:     | _,parent',sr,`BBDCL_procedure (_,vs,_,_)
    36:     | _,parent',sr,`BBDCL_function (_,vs,_,_,_)
    37:     | _,parent',sr,`BBDCL_regmatch (_,vs,_,_,_)
    38:     | _,parent',sr,`BBDCL_reglex (_,vs,_,_,_,_)
    39:     | _,parent',sr,`BBDCL_glr (_,vs,_,_)
    40:       -> aux parent' ((parent,length vs)::display)
    41:     | _ -> assert false
    42:   in aux parent []
    43: 
    44: (* inner most at head of list *)
    45: let get_display_list bbdfns index : (bid_t * int) list =
    46:   tl (cal_display bbdfns (Some index))
    47: 
    48: let strd the_display props =
    49:   if length the_display = 0 then
    50:   (if mem `Requires_ptf props then "(FLX_FPAR_PASS_ONLY)" else "()")
    51:   else
    52:   (if mem `Requires_ptf props then "(FLX_FPAR_PASS " else "(") ^ cat ", " the_display ^ ")"
    53: 
End ocaml section to src/flx_display.ml[1]