5.49. Inline exes

Start ocaml section to src/flx_spexes.mli[1 /1 ]
     1: # 5 "./lpsrc/flx_spexes.ipk"
     2: open Flx_ast
     3: open Flx_types
     4: open Flx_mtypes1
     5: open Flx_mtypes2
     6: open Flx_call
     7: open Flx_child
     8: 
     9: type submode_t = [`Eager | `Lazy]
    10: 
    11: val gen_body :
    12:   sym_state_t ->
    13:   usage_table_t * child_map_t * fully_bound_symbol_table_t ->
    14:   string ->                        (* name *)
    15:   (int, btypecode_t) Hashtbl.t ->  (* varmap *)
    16:   bparameter_t list ->             (* parameters *)
    17:   (string, string) Hashtbl.t ->    (* relabel *)
    18:   (bid_t, bid_t) Hashtbl.t ->      (* revariable *)
    19:   bexe_t list ->                   (* the exes *)
    20:   tbexpr_t ->                      (* argument *)
    21:   range_srcref ->                  (* srcref *)
    22:   int ->                           (* caller *)
    23:   bid_t ->                         (* callee *)
    24:   bvs_t ->                         (* caller vs *)
    25:   int ->                           (* callee vs len *)
    26:   submode_t ->                     (* default arg passing mode *)
    27:   property_t list ->               (* properties *)
    28:   bexe_t list
    29: 
    30: val recal_exes_usage:
    31:   sym_state_t ->
    32:   usage_table_t ->
    33:   range_srcref ->
    34:   int ->
    35:   bparameter_t list ->
    36:   bexe_t list ->
    37:   unit
    38: 
End ocaml section to src/flx_spexes.mli[1]
Start ocaml section to src/flx_spexes.ml[1 /1 ]
     1: # 44 "./lpsrc/flx_spexes.ipk"
     2: open Flx_util
     3: open Flx_ast
     4: open Flx_types
     5: open Flx_print
     6: open Flx_mtypes1
     7: open Flx_mtypes2
     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_generic
    15: open Flx_maps
    16: open Flx_exceptions
    17: open Flx_use
    18: open Flx_child
    19: open Flx_reparent
    20: open Flx_call
    21: 
    22: 
    23: type submode_t = [`Eager | `Lazy]
    24: 
    25: module BidSet = IntSet
    26: 
    27: (* this only updates the uses table not the usedby table,
    28:   because inlining changes usage (obviously).
    29:   we need it in particular for the is_recursive test,
    30:   so that tail recursions which have been eliminated
    31:   won't cause the test to return a false positive
    32: *)
    33: 
    34: let recal_exes_usage syms uses sr i ps exes =
    35:   (*
    36:   print_endline ("Recal usage of "^ si i^", this code:\n" ^ catmap "\n" (sbx syms.dfns) exes);
    37:   *)
    38:   (* delete old entry *)
    39:   (try Hashtbl.remove uses i with Not_found -> ());
    40:   iter (Flx_call.cal_param_usage syms uses sr i) ps;
    41:   iter (Flx_call.cal_exe_usage syms uses i) exes
    42: 
    43: let is_tailed ps exes =
    44:   try iter
    45:   (function
    46:     | `BEXE_init(_,i,_) when mem i ps -> raise Not_found
    47:     | _ -> ()
    48:   )
    49:   exes;
    50:   false
    51:   with Not_found -> true
    52: 
    53: let ident x = x
    54: 
    55: (* Heavy inlining routine. This routine can inline
    56: any procedure. The basic operation is emit the body
    57: of the target procedure. We have to do the following to
    58: make it all work.
    59: 
    60: (1) Each declared label is replaced by a fresh one,
    61: and all jumps to these labels modified accordingly.
    62: 
    63: (2) Variables are replaced by fresh ones. This requires
    64: making additions to the output bound tables. References
    65: to the variables are modified. Note the parent is the
    66: caller now.
    67: 
    68: (3) Paremeters are replaced like variables, initialised
    69: by the arguments.
    70: 
    71: (4) Any type variables instantiated by the call must
    72: also be instantiated in body expressions, as well as
    73: the typing of any generated variables.
    74: 
    75: (5) If the procedure has any nested procedures, they
    76: also must be replaced in toto by fresh ones, reparented
    77: to the caller so that any calls to them will access
    78: the fresh variables in the caller.
    79: 
    80: Note that the cache of children of the caller will
    81: be wrong after the inlining (it may have acquired new
    82: variables or procedure children).
    83: 
    84: Note that this inlining procedure is NOT recursive!
    85: Its a flat one level inlining. This ensures recursive
    86: calls don't cause an infinite unrolling, and hopefully
    87: prevent gross bloat.
    88: *)
    89: 
    90: let idt t = t
    91: 
    92: let rec rpl syms argmap x = match map_tbexpr ident (rpl syms argmap) idt x with
    93:   (* No need to check ts or type here *)
    94:   | (`BEXPR_name (i,_),_) as x ->
    95:     (try
    96:       let x' = Hashtbl.find argmap i in
    97:       (*
    98:       print_endline ("Replacing variable " ^ si i ^ " with " ^ sbe syms.dfns x');
    99:       *)
   100:       x'
   101:       with Not_found -> x)
   102:   | x -> x
   103: 
   104: let subarg syms bbdfns argmap exe =
   105:   map_bexe idt (rpl syms argmap) idt idt idt exe
   106: 
   107: (* NOTE: result is in reversed order *)
   108: let gen_body syms (uses,child_map,bbdfns) id
   109:   varmap ps relabel revariable exes argument
   110:   sr caller callee vs callee_vs_len inline_method props
   111: =
   112:   if syms.compiler_options.print_flag then
   113:   print_endline ("Gen body caller = " ^ si caller ^
   114:     ", callee=" ^ id ^ "<" ^ si callee ^ ">"
   115:   );
   116:   (*
   117:   let argument = reduce_tbexpr bbdfns argument in
   118:   *)
   119:   let psis: int list = map (fun {pindex=i} -> i) ps in
   120: 
   121:   (* NOTE: this is the inline method for val's ONLY.
   122:     If a parameter is a var, it is inlined eagerly no
   123:     matter what .. however we can't handle that yet,
   124:     so we have to switch to eager evaluation if ANY
   125:     of the parameters is a var.
   126:   *)
   127:   let inline_method = match inline_method with
   128:   | `Lazy ->
   129:     if
   130:       Flx_call.is_recursive uses callee or
   131:       is_tailed psis exes
   132:     then `Eager
   133:     else `Lazy
   134:       (*
   135:       fold_left (fun imeth {pkind=k} ->
   136:         match imeth, k with
   137:         | _, `PVar -> `Eager
   138:         | x,_ -> x
   139:         )
   140:       `Lazy ps
   141:       *)
   142:   | `Eager -> `Eager
   143:   in
   144: 
   145:   (* HACKERY *)
   146: 
   147:   (*
   148:   let inline_method = `Eager in
   149:   *)
   150: 
   151:   (*
   152:   print_endline ("Inlining " ^ si callee ^ " into " ^ si caller);
   153:   *)
   154:   (*
   155:   begin match inline_method with
   156:   | `Eager ->
   157:     print_endline ("Eager INLINING " ^ id ^ "<"^si callee^">("^sbe syms.dfns argument^") into " ^ si caller ^ " .. INPUT:");
   158:   | `Lazy ->
   159:     print_endline ("Lazy INLINING " ^ id ^ "<"^si callee^">("^sbe syms.dfns argument^") into " ^ si caller ^ " .. INPUT:");
   160:   end
   161:   ;
   162:   iter (fun x -> print_endline (string_of_bexe syms.dfns 0 x)) exes;
   163:   *)
   164:   let paramtype  =
   165:     let pt =
   166:       let pts = map (fun {ptyp=t} -> t) ps in
   167:       match pts with
   168:       | [x] -> x
   169:       | x -> `BTYP_tuple x
   170:     in
   171:       varmap_subst varmap pt
   172:   in
   173: 
   174:   let caller_vars = map (fun (s,i) -> `BTYP_var (i,`BTYP_type 0)) vs in
   175:   let ge e = remap_expr syms bbdfns varmap revariable caller_vars callee_vs_len e in
   176:   let relab s = try Hashtbl.find relabel s with Not_found -> s in
   177:   let revar i = try Hashtbl.find revariable i with Not_found -> i in
   178:   let end_label_uses = ref 0 in
   179:   let end_label =
   180:     let end_index = !(syms.counter) in
   181:     incr syms.counter;
   182:     "_end_" ^ (si end_index)
   183:   in
   184: 
   185: 
   186:   let remap: bexe_t -> bexe_t list =  fun exe ->
   187:   match exe with
   188:   | `BEXE_axiom_check _ -> assert false
   189:   | `BEXE_call_prim (sr,i,ts,e2)  ->  assert false
   190:     (*
   191:     let fixup i ts =
   192:       let auxt t = varmap_subst varmap t in
   193:       let ts = map auxt ts in
   194:       try
   195:         let j= Hashtbl.find revariable i in
   196:         j, vsplice caller_vars callee_vs_len ts
   197:       with Not_found -> i,ts
   198:     in
   199:     let i,ts = fixup i ts in
   200:     [`BEXE_call_prim (sr,i,ts, ge e2)]
   201:     *)
   202: 
   203:   | `BEXE_call_direct (sr,i,ts,e2)  ->  assert false
   204:     (*
   205:     let fixup i ts =
   206:       let auxt t = varmap_subst varmap t in
   207:       let ts = map auxt ts in
   208:       try
   209:         let j= Hashtbl.find revariable i in
   210:         j, vsplice caller_vars callee_vs_len ts
   211:       with Not_found -> i,ts
   212:     in
   213:     let i,ts = fixup i ts in
   214:     [`BEXE_call_direct (sr,i,ts, ge e2)]
   215:     *)
   216: 
   217:   | `BEXE_call_method_direct (sr,e1,i,ts,e2)  ->
   218:     let fixup i ts =
   219:       let auxt t = varmap_subst varmap t in
   220:       let ts = map auxt ts in
   221:       try
   222:         let j= Hashtbl.find revariable i in
   223:         j, vsplice caller_vars callee_vs_len ts
   224:       with Not_found -> i,ts
   225:     in
   226:     let i,ts = fixup i ts in
   227:     [`BEXE_call_method_direct (sr,ge e1,i,ts, ge e2)]
   228: 
   229:   | `BEXE_call_method_stack (sr,e1,i,ts,e2)  ->
   230:     let fixup i ts =
   231:       let auxt t = varmap_subst varmap t in
   232:       let ts = map auxt ts in
   233:       try
   234:         let j= Hashtbl.find revariable i in
   235:         j, vsplice caller_vars callee_vs_len ts
   236:       with Not_found -> i,ts
   237:     in
   238:     let i,ts = fixup i ts in
   239:     [`BEXE_call_method_stack (sr,ge e1,i,ts, ge e2)]
   240: 
   241:   | `BEXE_jump_direct (sr,i,ts,e2)  ->
   242:     let fixup i ts =
   243:       let auxt t = varmap_subst varmap t in
   244:       let ts = map auxt ts in
   245:       try
   246:         let j= Hashtbl.find revariable i in
   247:         j, vsplice caller_vars callee_vs_len ts
   248:       with Not_found -> i,ts
   249:     in
   250:     let i,ts = fixup i ts in
   251:     [`BEXE_jump_direct (sr,i,ts, ge e2)]
   252: 
   253:   | `BEXE_call_stack (sr,i,ts,e2)  -> assert false
   254: 
   255:   | `BEXE_apply_ctor (sr,i1,i2,ts,i3,e2) ->
   256:     let fixup i ts =
   257:       let auxt t = varmap_subst varmap t in
   258:       let ts = map auxt ts in
   259:       try
   260:         let j= Hashtbl.find revariable i in
   261:         j, vsplice caller_vars callee_vs_len ts
   262:       with Not_found -> i,ts
   263:     in
   264:     let i2,ts = fixup i2 ts in
   265:     let rv i = try Hashtbl.find revariable i with Not_found -> i in
   266:     [`BEXE_apply_ctor (sr,rv i1, i2,ts,rv i3,ge e2)]
   267: 
   268:   | `BEXE_apply_ctor_stack (sr,i1,i2,ts,i3,e2) ->
   269:     let fixup i ts =
   270:       let auxt t = varmap_subst varmap t in
   271:       let ts = map auxt ts in
   272:       try
   273:         let j= Hashtbl.find revariable i in
   274:         j, vsplice caller_vars callee_vs_len ts
   275:       with Not_found -> i,ts
   276:     in
   277:     let i2,ts = fixup i2 ts in
   278:     let rv i = try Hashtbl.find revariable i with Not_found -> i in
   279:     [`BEXE_apply_ctor_stack (sr,rv i1, i2,ts,rv i3,ge e2)]
   280: 
   281:   | `BEXE_call (sr,e1,e2)  -> [`BEXE_call (sr,ge e1, ge e2)]
   282:   | `BEXE_jump (sr,e1,e2)  -> assert false
   283: 
   284:   | `BEXE_loop (sr,i,e) -> assert false
   285: 
   286:   | `BEXE_assert (sr,e) -> [`BEXE_assert (sr, ge e)]
   287:   | `BEXE_assert2 (sr,sr2,e1,e2) ->
   288:     let e1 = match e1 with Some e1 -> Some (ge e1) | None -> None in
   289:     [`BEXE_assert2 (sr, sr2, e1,ge e2)]
   290: 
   291:   | `BEXE_ifgoto (sr,e,lab) -> [`BEXE_ifgoto (sr,ge e, relab lab)]
   292:   | `BEXE_ifnotgoto (sr,e,lab) -> [`BEXE_ifnotgoto (sr,ge e, relab lab)]
   293:   | `BEXE_fun_return (sr,e) -> [`BEXE_fun_return (sr, ge e)]
   294:   | `BEXE_yield (sr,e) -> [`BEXE_yield (sr, ge e)]
   295:   | `BEXE_assign (sr,e1,e2) -> [`BEXE_assign (sr, ge e1, ge e2)]
   296:   | `BEXE_init (sr,i,e) -> [`BEXE_init (sr,revar i, ge e)]
   297:   | `BEXE_svc (sr,i)  -> [`BEXE_svc (sr, revar i)]
   298: 
   299:   | `BEXE_code (sr,s)  as x -> [x]
   300:   | `BEXE_nonreturn_code (sr,s)  as x -> [x]
   301:   | `BEXE_goto (sr,lab) -> [`BEXE_goto (sr, relab lab)]
   302: 
   303: 
   304:   (* INLINING THING *)
   305:   | `BEXE_proc_return sr as x ->
   306:     incr end_label_uses;
   307:     [`BEXE_goto (sr,end_label)]
   308: 
   309:   | `BEXE_comment (sr,s) as x -> [x]
   310:   | `BEXE_nop (sr,s) as x -> [x]
   311:   | `BEXE_halt (sr,s) as x -> [x]
   312:   | `BEXE_label (sr,lab) -> [`BEXE_label (sr, relab lab)]
   313:   | `BEXE_begin as x -> [x]
   314:   | `BEXE_end as x -> [x]
   315:   in
   316:     let kind = match inline_method with
   317:       | `Lazy -> "Lazy "
   318:       | `Eager -> "Eager "
   319:     in
   320:     let rec fgc props s =
   321:       match props with
   322:       | [] -> String.concat ", " s
   323:       | `Generated x :: t -> fgc t (x :: s)
   324:       | _ :: t -> fgc t s
   325:     in
   326:     let source =
   327:       let x = fgc props [] in
   328:       if x <> "" then " (Generated "^x^")" else ""
   329:     in
   330:     (* add a comment for non-generated functions .. *)
   331:     let b =
   332:       ref
   333:       (
   334:         if source = "" && id <> "_init_" then
   335:           [`BEXE_comment (sr,(kind ^ "inline call to " ^ id ^source))]
   336:         else []
   337:       )
   338:     in
   339:     (*
   340:     if inline_method = `Eager then begin
   341:       (* create a variable for the parameter *)
   342:       let parameter = !(syms.counter) in
   343:       incr syms.counter;
   344:       let param_id = "_p" ^ si parameter in
   345:       (*
   346:       print_endline ("Parameter assigned index " ^ si parameter);
   347:       *)
   348: 
   349:       (* create variables for parameter components *)
   350:       (* Whaaa??
   351:       if length ps > 1 then
   352:       for i = 1 to length ps do incr syms.counter done;
   353:        (* Initialise parameter to argument, but only if
   354:          the argument is not unit
   355:       *)
   356:       *)
   357:       if length ps > 0 then
   358:       begin
   359:         let x =
   360:           if length ps > 1
   361:           then begin
   362:             let entry = `BBDCL_var (vs,paramtype) in
   363:             let kids =
   364:               try Hashtbl.find child_map caller
   365:               with Not_found -> []
   366:             in
   367:             Hashtbl.replace child_map caller (parameter::kids);
   368:             Hashtbl.add bbdfns parameter (param_id,Some caller,sr,entry);
   369:             `BEXE_init (sr,parameter,argument)
   370:           end
   371:           else
   372:             let {pid=vid; pindex=k} = hd ps in
   373:             let index = revar k in
   374:             `BEXE_init (sr,index,argument)
   375:         in
   376:         b := x :: !b;
   377: 
   378:         (* unpack argument *)
   379:         if length ps > 1 then
   380:         let ts = map (fun (_,i) -> `BTYP_var (i,`BTYP_type 0)) vs in
   381:         let p = `BEXPR_name (parameter,ts),paramtype in
   382:         let n = ref 0 in
   383:         iter
   384:         (fun {pid=vid;pindex=ix; ptyp=prjt} ->
   385:           let prjt = varmap_subst varmap prjt in
   386:           let pj =
   387:             match argument with
   388:             (* THIS CASE MAY NOT WORK WITH TAIL REC OPT! *)
   389:             | `BEXPR_tuple ls,_ ->
   390:               begin try nth ls (!n)
   391:               with _ -> failwith "Woops, tuple wrong length?"
   392:               end
   393:             | _ -> `BEXPR_get_n (!n,p),prjt
   394:           in
   395:           (*
   396:           let prj = reduce_tbexpr bbdfns pj in
   397:           *)
   398:           let prj = pj in
   399:           let index = revar ix in
   400:           let x = `BEXE_init (sr,index,prj) in
   401:           b := x :: !b;
   402:           incr n
   403:         )
   404:         ps
   405:       end
   406:       ;
   407:       iter
   408:       (fun exe ->
   409:         iter
   410:         (fun x -> b := x :: !b)
   411:         (remap exe)
   412:       )
   413:       exes
   414:     end else if inline_method = `Lazy then begin
   415:     *)
   416:     let argmap = Hashtbl.create 97 in
   417:     begin match length ps with
   418:     | 0 -> ()
   419:     | 1 ->
   420:       let {pkind=kind; pid=vid; pindex=k; ptyp=ptyp} = hd ps in
   421:       let index = revar k in
   422:       begin match kind with
   423:       | `PFun ->
   424:         let argt = match argument with
   425:         | _,`BTYP_function (`BTYP_void,t)
   426:         | _,`BTYP_function (`BTYP_tuple [],t) -> t
   427:         | _,t -> failwith ("Expected argument to be function void->t, got " ^ sbt syms.dfns t)
   428:         in
   429:         let un = `BEXPR_tuple [], `BTYP_tuple [] in
   430:         let apl = `BEXPR_apply (argument, un), argt in
   431:         Hashtbl.add argmap index apl
   432: 
   433:       | `PVal when inline_method = `Lazy ->
   434:         Hashtbl.add argmap index argument
   435: 
   436:       | `PRef ->
   437:         begin match argument with
   438:         | `BEXPR_ref (i,ts),`BTYP_pointer t ->
   439:           Hashtbl.add argmap index (`BEXPR_name (i,ts),t)
   440:         | _ ->
   441:           let x = `BEXE_init (sr,index,argument) in
   442:           b := x :: !b
   443:         end
   444: 
   445:       | `PVal when inline_method = `Eager ->
   446:          let x = `BEXE_init (sr,index,argument) in
   447:          b := x :: !b
   448: 
   449:       | `PVar ->
   450:          let x = `BEXE_init (sr,index,argument) in
   451:          b := x :: !b
   452: 
   453:       | _ -> failwith "Can't handle ref/fun params yet"
   454:       end
   455: 
   456:     | _ ->
   457:       (* create a variable for the parameter *)
   458:       let parameter = !(syms.counter) in
   459:       incr syms.counter;
   460:       let param_id = "_p" ^ si parameter in
   461:       (*
   462:       print_endline ("Parameter assigned index " ^ si parameter);
   463:       *)
   464: 
   465:       let ts = map (fun (_,i) -> `BTYP_var (i,`BTYP_type 0)) vs in
   466:       let n = ref 0 in
   467:       iter
   468:       (fun {pkind=kind; pid=vid; pindex=ix; ptyp=prjt} ->
   469:         let prjt = varmap_subst varmap prjt in
   470:         let pj =
   471:           match argument with
   472:           (* THIS CASE MAY NOT WORK WITH TAIL REC OPT! *)
   473:           | `BEXPR_tuple ls,_ ->
   474:             begin try nth ls (!n)
   475:             with _ -> failwith "Woops, tuple wrong length?"
   476:             end
   477:           | p -> `BEXPR_get_n (!n,p),prjt
   478:         in
   479:         (*
   480:         let prj = reduce_tbexpr bbdfns pj in
   481:         *)
   482:         let prj = pj in
   483:         let index = revar ix in
   484:         begin match kind with
   485:         | `PFun ->
   486:           let t = match prj with
   487:           | _,`BTYP_function (`BTYP_void,t)
   488:           | _,`BTYP_function (`BTYP_tuple [],t) -> t
   489:           | _ -> failwith "Expected argument to be function void->t!"
   490:           in
   491:           let un = `BEXPR_tuple [], `BTYP_tuple [] in
   492:           let apl = `BEXPR_apply (prj,un),t in
   493:           Hashtbl.add argmap index apl
   494: 
   495:         | `PVal when inline_method = `Lazy ->
   496:           Hashtbl.add argmap index prj
   497: 
   498:         | `PRef ->
   499:           begin match prj with
   500:           | `BEXPR_ref (i,ts),`BTYP_pointer t ->
   501:             Hashtbl.add argmap index (`BEXPR_name (i,ts),t)
   502:           | _ ->
   503:             let x = `BEXE_init (sr,index,prj) in
   504:             b := x :: !b
   505:           end
   506: 
   507:         | `PVal when inline_method = `Eager ->
   508:           let x = `BEXE_init (sr,index,prj) in
   509:           b := x :: !b
   510: 
   511:         | `PVar ->
   512:           let x = `BEXE_init (sr,index,prj) in
   513:           b := x :: !b
   514: 
   515:         | _ -> failwith "Can't handle ref/fun params yet"
   516:         end
   517:         ;
   518:         incr n
   519:       )
   520:       ps
   521:     end
   522:     ;
   523:     (*
   524:     print_endline "argmap = ";
   525:     Hashtbl.iter
   526:     (fun i e ->
   527:       try
   528:       let id,_,_,_ = Hashtbl.find bbdfns i in
   529:       print_endline (id ^ "<"^ si i ^ "> --> " ^ sbe syms.dfns e)
   530:       with Not_found -> print_endline ("Can't find index .." ^ si i)
   531:     )
   532:     argmap
   533:     ;
   534:     print_endline "----::----";
   535:     *)
   536:     let sba = if Hashtbl.length argmap = 0 then
   537:       fun x -> b := x :: !b
   538:     else
   539:       fun x -> b := subarg syms bbdfns argmap x :: !b
   540:     in
   541:     iter
   542:     (fun exe -> iter sba (remap exe))
   543:     exes
   544:     ;
   545:     (*
   546:     print_endline "Lazy evaluation, output=";
   547:     iter (fun x -> print_endline (string_of_bexe syms.dfns 0 x)) (rev !b);
   548:     *)
   549:     (* substitute in kids too *)
   550:     if Hashtbl.length argmap > 0 then begin
   551:       let closure = descendants child_map callee in
   552:       (*
   553:          let cl = ref [] in IntSet.iter (fun i -> cl := i :: !cl) closure;
   554:          print_endline ("Closure is " ^ catmap " " si !cl);
   555:       *)
   556:       let kids =
   557:         IntSet.fold
   558:         (fun i s -> IntSet.add (revar i) s)
   559:         closure
   560:         IntSet.empty
   561:       in
   562:       IntSet.iter (fun i ->
   563:         let id,parent,sr,entry = Hashtbl.find bbdfns i in
   564:         match entry with
   565:         | `BBDCL_function (props,vs,(ps,traint),ret,exes) ->
   566:           let exes = map (subarg syms bbdfns argmap) exes in
   567:           recal_exes_usage syms uses sr i ps exes;
   568:           Hashtbl.replace bbdfns i
   569:           (id,parent,sr,`BBDCL_function (props,vs,(ps,traint),ret,exes))
   570: 
   571:         | `BBDCL_procedure (props,vs,(ps,traint),exes) ->
   572:           (*
   573:           print_endline ("MODIFY " ^ si i);
   574:           *)
   575:           let exes = map (subarg syms bbdfns argmap) exes in
   576:           recal_exes_usage syms uses sr i ps exes;
   577:           Hashtbl.replace bbdfns i
   578:           (id,parent,sr,`BBDCL_procedure (props,vs,(ps,traint),exes))
   579: 
   580:         | `BBDCL_regmatch (props,vs,(ps,traint),ret,(alpha,states,h,mx)) ->
   581:           (try Hashtbl.remove uses i with Not_found -> ());
   582:           iter (cal_param_usage syms uses sr i) ps;
   583:           let h2 = Hashtbl.create 97 in
   584:           Hashtbl.iter (fun k x ->
   585:             let x = rpl syms argmap x in
   586:             Hashtbl.add h2 k x;
   587:             cal_expr_usage syms uses i sr x
   588:           )
   589:           h
   590:           ;
   591:           Hashtbl.replace bbdfns i
   592:           (id,parent,sr,`BBDCL_regmatch (props,vs,(ps,traint),ret,(alpha,states,h2,mx)))
   593: 
   594:         | `BBDCL_reglex (props,vs,(ps,traint),j,ret,(alpha,states,h,mx)) ->
   595:           (try Hashtbl.remove uses i with Not_found -> ());
   596:           iter (cal_param_usage syms uses sr i) ps;
   597:           let h2 = Hashtbl.create 97 in
   598:           Hashtbl.iter (fun k x ->
   599:             let x = rpl syms argmap x in
   600:             Hashtbl.add h2 k x;
   601:             cal_expr_usage syms uses i sr x
   602:           )
   603:           h
   604:           ;
   605:           Hashtbl.replace bbdfns i
   606:           (id,parent,sr,`BBDCL_reglex (props,vs,(ps,traint),j,ret,(alpha,states,h2,mx)))
   607: 
   608:         | _ -> ()
   609:       )
   610:       kids
   611:     end
   612:     ;
   613:     let trail_jump = match !b with
   614:       | `BEXE_goto (_,lab)::_ when lab = end_label -> true
   615:       | _ -> false
   616:     in
   617:     if trail_jump then
   618:       (b := tl !b; decr end_label_uses)
   619:     ;
   620:     if !end_label_uses > 0 then
   621:       b := (`BEXE_label (sr,end_label)) :: !b
   622:     ;
   623:     (*
   624:     print_endline ("INLINING " ^ id ^ " into " ^ si caller ^ " .. OUTPUT:");
   625:     iter (fun x -> print_endline (string_of_bexe syms.dfns 0 x)) (rev !b);
   626:     print_endline ("END OUTPUT for " ^ id);
   627:     *)
   628:     !b
   629: 
   630: 
End ocaml section to src/flx_spexes.ml[1]