5.47. Make stack calls

Name binding pass 2.
Start ocaml section to src/flx_stack_calls.mli[1 /1 ]
     1: # 6 "./lpsrc/flx_enstack.ipk"
     2: open Flx_ast
     3: open Flx_types
     4: open Flx_mtypes2
     5: open Flx_child
     6: 
     7: val make_stack_calls:
     8:   sym_state_t ->
     9:   child_map_t * fully_bound_symbol_table_t ->
    10:   unit
    11: 
End ocaml section to src/flx_stack_calls.mli[1]
Start ocaml section to src/flx_stack_calls.ml[1 /1 ]
     1: # 18 "./lpsrc/flx_enstack.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: 
    18: (* first approximation: we can stack functions that have no
    19:   function or procedure children AND no variables: later
    20:   we will check the return type, for now just check
    21:   the code generator works
    22: *)
    23: 
    24: (* return true if exes contain BEXPR_parse expression *)
    25: let check_parser_calls exes : bool =
    26:   let cp = function
    27:     | `BEXPR_parse _,_ -> raise Not_found
    28:     | _ -> ()
    29:   in
    30:   let cpe e = iter_tbexpr ignore cp ignore e in
    31:   try
    32:     iter (iter_bexe ignore cpe ignore ignore ignore) exes;
    33:     false
    34:   with Not_found -> true
    35: 
    36: (* The Pure property is a bit weird. We consider a function pure
    37:   if it doesn't need a stack frame, and can make do with
    38:   individual variables. This allows the function to be modelled
    39:   with an actual C function.
    40: 
    41:   A pure function must be top level and cannot have any
    42:   child functions. This means it depends only on its parameters
    43:   and globals -- globals are allowed because we pass the thread
    44:   frame pointer in, even to C functions.
    45: 
    46:   We assume a non-toplevel function is a child of some other
    47:   function for a reason -- to access that functions environment.
    48:   Still .. we could pass the display in, just as we pass the
    49:   thread frame pointer.
    50: 
    51:   What we really cannot allow is a child function, since we
    52:   cannot pass IT our frame pointer, since we don't have one.
    53: 
    54:   Because of this weird notion, we can also mark procedures
    55:   pure under the same conditions, and implement them as
    56:   C functions as well.
    57: 
    58:   Note neither a function nor procedure can be pure unless
    59:   it is also stackable, and the C function model can't be used
    60:   for either if a heap closure is formed.
    61: *)
    62: let rec is_pure syms (child_map, bbdfns) i =
    63:   let children = try Hashtbl.find child_map i with Not_found -> [] in
    64:   let id,parent,sr,entry = Hashtbl.find bbdfns i in
    65:   (*
    66:   print_endline ("Checking purity of " ^ id ^ "<" ^ si i ^ ">");
    67:   *)
    68:   match entry with
    69:   | `BBDCL_var _
    70:   | `BBDCL_val _
    71:   | `BBDCL_tmp _
    72:   | `BBDCL_const_ctor _
    73:   | `BBDCL_nonconst_ctor _
    74:   | `BBDCL_fun _
    75:   | `BBDCL_callback _
    76:   | `BBDCL_proc _
    77:   | `BBDCL_insert _
    78:   | `BBDCL_struct _
    79:   | `BBDCL_cstruct _
    80:   | `BBDCL_union _
    81:   | `BBDCL_abs _
    82:   | `BBDCL_const _
    83:     ->
    84:     (*
    85:     print_endline (id ^ " is intrinsically pure");
    86:     *)
    87:     true
    88: 
    89:   | `BBDCL_cclass _  (* not sure FIXME .. *)
    90:   | `BBDCL_class _  (* not sure FIXME .. *)
    91:   | `BBDCL_glr _
    92:   | `BBDCL_reglex _
    93:   | `BBDCL_regmatch _
    94:     ->
    95:     (*
    96:     print_endline (id ^ " is intrinsically Not pure");
    97:     *)
    98:     false
    99: 
   100:   | `BBDCL_procedure (_,_,_,exes)   (* ALLOWED NOW *)
   101:   | `BBDCL_function (_,_,_,_,exes) ->
   102:     match parent with
   103:     | Some _ ->
   104:       (*
   105:       print_endline (id ^ " is parented so Not pure");
   106:       *)
   107:       false
   108: 
   109:     | None ->
   110:     try
   111:       iter (fun kid ->
   112:         if not (is_pure syms (child_map, bbdfns) kid)
   113:         then begin
   114:           (*
   115:           print_endline ("Child " ^ si kid ^ " of " ^ id ^ " is not pure");
   116:           *)
   117:           raise Not_found
   118:         end
   119:         (*
   120:         else begin
   121:           print_endline ("Child " ^ si kid ^ " of " ^ id ^ " is pure");
   122:         end
   123:         *)
   124:       )
   125:       children
   126:       ;
   127:       (*
   128:       print_endline (id ^ " is checked pure, checking for parser calls ..");
   129:       *)
   130:       let pure = not (check_parser_calls exes) in
   131:       (*
   132:       if pure then
   133:         print_endline (id ^ " is Pure")
   134:       else
   135:         print_endline (id ^ " calls a parser, NOT Pure")
   136:       ;
   137:       *)
   138:       pure
   139: 
   140:     with
   141:     | Not_found ->
   142:       (*
   143:       print_endline (id ^ " is checked Not pure");
   144:       *)
   145:       false
   146: 
   147: 
   148: exception Found
   149: 
   150: (* A function is stackable provided it doesn't return
   151:   a pointer to itself. There are only two ways this
   152:   can happen: the function returns the address of
   153:   a variable, or, it returns the closure of a child.
   154: 
   155:   We will check the return type for pointer or
   156:   function types. If its a function, there
   157:   has to be at least one child to grab our this
   158:   pointer in its display. If its a pointer,
   159:   there has to be either a variable, or any
   160:   non-stackable child function, or any child
   161:   procedure -- note that the pointer might address
   162:   a variable in a child function or procedure,
   163:   however it can't 'get out' of a function except
   164:   by it being returned.
   165: 
   166:   Proposition: type variables cannot carry either
   167:   pointers to a variable or a child function closure.
   168: 
   169:   Reason: type variables are all universally quantified
   170:   and unconstrained. We would have v1 = &v2 for the pointer
   171:   case, contrary to the current lack of constraints.
   172:   Smly for functions. So we'll just ignore type variables.
   173: 
   174:   NOTE: a stacked frame is perfectly viable as a display
   175:   entry -- a heaped child can still refer to a stacked
   176:   parent frame: of course the child must not both persist
   177:   after the frame dies and also refer to that frame.
   178: 
   179:   This means the display, not just the caller, must be nulled
   180:   out of a routine when it loses control finally. Hmmm .. not
   181:   sure I'm doing that. That means only *explicit* Felix pointers
   182:   in the child refering to the parent frame can hold onto
   183:   the frame. In this case the parent must be heaped if the child
   184:   is, since the parent stacked frame is lost when control is lost.
   185: *)
   186: 
   187: let has_var bbdfns children =
   188:   try
   189:     iter
   190:     (fun i ->
   191:       let id,parent,sr,entry = Hashtbl.find bbdfns i in
   192:       match entry with
   193:       | `BBDCL_var _  -> raise Found
   194:       | _ -> ()
   195:     )
   196:     children
   197:     ;
   198:     true
   199:   with Found -> false
   200: 
   201: let has_fun bbdfns children =
   202:   try
   203:     iter
   204:     (fun i ->
   205:       let id,parent,sr,entry = Hashtbl.find bbdfns i in
   206:       match entry with
   207:       | `BBDCL_procedure _
   208:       | `BBDCL_function _ -> raise Found
   209:       | _ -> ()
   210:     )
   211:     children
   212:     ;
   213:     true
   214:   with Found -> false
   215: 
   216: 
   217: (* NOTE: this won't work for abstracted types like unions
   218:    or structs ..
   219: *)
   220: exception Unsafe
   221: 
   222: let has_ptr_fn cache syms bbdfns children e =
   223:   let rec aux e =
   224:     let check_components vs ts tlist =
   225:       let varmap = mk_varmap vs ts in
   226:       begin try
   227:         iter
   228:           (fun t ->
   229:             let t = varmap_subst varmap t in
   230:             aux t
   231:           )
   232:         tlist;
   233:         Hashtbl.replace cache e `Safe
   234:       with Unsafe ->
   235:         Hashtbl.replace cache e `Unsafe;
   236:         raise Unsafe
   237:       end
   238:     in
   239:     try match Hashtbl.find cache e with
   240:     | `Recurse -> ()
   241:     | `Unsafe -> raise Unsafe
   242:     | `Safe -> ()
   243:     with Not_found ->
   244:       Hashtbl.add cache e `Recurse;
   245:       match e with
   246:       | `BTYP_function _ ->
   247:         (* if has_fun bbdfns children then *)
   248:         Hashtbl.replace cache e `Unsafe;
   249:         raise Unsafe
   250: 
   251:       | `BTYP_pointer _ ->
   252:         (* encode the more lenient condition here!! *)
   253:         Hashtbl.replace cache e `Unsafe;
   254:         raise Unsafe
   255: 
   256:       | `BTYP_inst (i,ts) ->
   257:         let id,parent,sr,entry = Hashtbl.find bbdfns i in
   258:         begin match entry with
   259:         | `BBDCL_abs _ -> ()
   260:         | `BBDCL_union (vs,cs)->
   261:           check_components vs ts (map (fun (_,_,t)->t) cs)
   262: 
   263:         | `BBDCL_struct (vs,cs)
   264:         | `BBDCL_cstruct (vs,cs) ->
   265:           check_components vs ts (map snd cs)
   266: 
   267:         | `BBDCL_class _ ->
   268:           Hashtbl.replace cache e `Unsafe;
   269:           raise Unsafe
   270: 
   271:         | `BBDCL_cclass (vs,cs) ->
   272:           ()
   273:           (* nope, it isn't a use *)
   274:           (*
   275:           let tlist = map (function
   276:             | `BMemberVal (_,t)
   277:             | `BMemberVar (_,t)
   278:             | `BMemberFun (_,_,t)
   279:             | `BMemberProc (_,_,t)
   280:             | `BMemberCtor (_,t) -> t
   281:             ) cs
   282:           in
   283:           check_components vs ts tlist
   284:           *)
   285: 
   286:         | _ -> assert false
   287:         end
   288:       | x ->
   289:         try
   290:           iter_btype aux x;
   291:           Hashtbl.replace cache e `Safe
   292:         with Unsafe ->
   293:           Hashtbl.replace cache e `Unsafe;
   294:           raise Unsafe
   295: 
   296:   in try aux e; false with Unsafe -> true
   297: 
   298: let can_stack_func cache syms (child_map,bbdfns) i =
   299:   let children = try Hashtbl.find child_map i with Not_found -> [] in
   300:   let id,parent,sr,entry = Hashtbl.find bbdfns i in
   301:   match entry with
   302:   | `BBDCL_function (_,_,_,ret,_) ->
   303:     not (has_ptr_fn cache syms bbdfns children ret)
   304: 
   305:   | `BBDCL_nonconst_ctor _
   306:   | `BBDCL_fun _
   307:   | `BBDCL_callback _
   308:   | `BBDCL_struct _
   309:   | `BBDCL_cstruct _
   310:   | `BBDCL_regmatch _
   311:   | `BBDCL_reglex _
   312:     -> false (* hack *)
   313:   | _ -> failwith ("Unexpected non-function " ^ id)
   314: 
   315: let rec can_stack_proc cache syms (child_map,bbdfns) i recstop =
   316:   let children = try Hashtbl.find child_map i with Not_found -> [] in
   317:   let id,parent,sr,entry = Hashtbl.find bbdfns i in
   318:   (*
   319:   print_endline ("Stackability Checking procedure " ^ id);
   320:   *)
   321:   match entry with
   322:   | `BBDCL_procedure (_,_,_,exes) ->
   323:     begin try iter (fun exe ->
   324:     (*
   325:     print_endline (string_of_bexe syms.dfns 0 exe);
   326:     *)
   327:     match exe with
   328: 
   329:     | `BEXE_axiom_check _ -> assert false
   330:     | `BEXE_svc _ -> raise Not_found
   331:     | `BEXE_call (_,(`BEXPR_closure (j,_),_),_)
   332:     | `BEXE_call_direct (_,j,_,_)
   333:     | `BEXE_call_method_direct (_,_,j,_,_)
   334:     | `BEXE_apply_ctor (_,_,_,_,j,_)
   335:       ->
   336:       if not (check_stackable_proc cache syms (child_map,bbdfns) j (i::recstop))
   337:       then begin
   338:         (*
   339:         print_endline (id ^ " calls unstackable proc " ^ si j);
   340:         *)
   341:         raise Not_found
   342:       end
   343: 
   344:     (* assignments to a local variable are safe *)
   345:     | `BEXE_init (_,j,_)
   346:     | `BEXE_assign (_,(`BEXPR_name (j,_),_),_)
   347:       when mem j children -> ()
   348: 
   349:     | `BEXE_init (sr,_,(_,t))
   350:     | `BEXE_assign (sr,(_,t),_)
   351:       when not (has_ptr_fn cache syms bbdfns children t) -> ()
   352: 
   353:     (* THIS IS WRONG .. BUT LETS FIND SOME BAD CASES .. *)
   354:     | `BEXE_call_prim _ -> ()
   355: 
   356:     | `BEXE_init _
   357:     | `BEXE_assign _ ->
   358:       (*
   359:       print_endline (id ^ " does foreign init/assignment");
   360:       *)
   361:       raise Not_found
   362: 
   363:     | `BEXE_call _
   364:        ->
   365:        (*
   366:        print_endline (id ^ " does nasty call");
   367:        *)
   368:        raise Not_found
   369:     | `BEXE_jump _
   370:     | `BEXE_jump_direct _
   371:        ->
   372:        (*
   373:        print_endline (id ^ " does jump");
   374:        *)
   375:        raise Not_found
   376:     | `BEXE_loop _
   377:        ->
   378:        (*
   379:        print_endline (id ^ " has loop?");
   380:        *)
   381:        raise Not_found
   382: 
   383:     | `BEXE_fun_return _ -> assert false
   384: 
   385:     (* Assume these are safe .. ? *)
   386:     | `BEXE_code _
   387:     | `BEXE_nonreturn_code _
   388: 
   389:     | `BEXE_apply_ctor_stack _
   390:     | `BEXE_call_stack _ (* cool *)
   391:     | `BEXE_call_method_stack _
   392:     | `BEXE_halt _
   393:     | `BEXE_comment _
   394:     | `BEXE_label _
   395:     | `BEXE_goto _
   396:     | `BEXE_ifgoto _
   397:     | `BEXE_ifnotgoto _
   398:     | `BEXE_assert _
   399:     | `BEXE_assert2 _
   400:     | `BEXE_begin
   401:     | `BEXE_end
   402:     | `BEXE_nop _
   403:     | `BEXE_proc_return _
   404:       -> ()
   405:     )
   406:     exes;
   407:     (*
   408:     print_endline (id ^ " is stackable");
   409:     *)
   410:     true
   411:     with Not_found ->
   412:       (*
   413:       print_endline (id ^ " cannot be stacked ..");
   414:       *)
   415:       false
   416:     end
   417: 
   418:   | _ -> assert false
   419: 
   420: and check_stackable_proc cache syms (child_map,bbdfns) i recstop =
   421:   if mem i recstop then true else
   422:   let id,parent,sr,entry = Hashtbl.find bbdfns i in
   423:   match entry with
   424:   | `BBDCL_proc _ -> true
   425:   | `BBDCL_procedure (props,vs,p,exes) ->
   426:     if mem `Stackable props then true
   427:     else if mem `Unstackable props then false
   428:     else if can_stack_proc cache syms (child_map,bbdfns) i recstop
   429:     then begin
   430:       (*
   431:       print_endline ("MARKING PROCEDURE " ^ id ^ " stackable!");
   432:       *)
   433:       let props = `Stackable :: props in
   434:       let props =
   435:         if is_pure syms (child_map,bbdfns) i then `Pure :: props else props
   436:       in
   437:       let entry : bbdcl_t = `BBDCL_procedure (props,vs,p,exes) in
   438:       Hashtbl.replace bbdfns i (id,parent,sr,entry);
   439:       true
   440:     end
   441:     else begin
   442:       let entry : bbdcl_t = `BBDCL_procedure (`Unstackable :: props,vs,p,exes) in
   443:       Hashtbl.replace bbdfns i (id,parent,sr,entry);
   444:       false
   445:     end
   446:   | _ -> assert false
   447: 
   448: let ident x = x
   449: let tident t = t
   450: 
   451: (* this routine NORMALISES applications to one of the forms:
   452:   apply_stack  -- apply on the stack
   453:   apply_direct -- direct application
   454:   apply_prim   -- apply primitive
   455:   apply_struct -- apply struct, cstruct, or nonconst variant type constructor
   456:   apply        -- general apply
   457: *)
   458: let rec enstack_applies cache syms (child_map, bbdfns) x =
   459:   let ea e = enstack_applies cache syms (child_map, bbdfns) e in
   460:   match map_tbexpr ident ea tident x with
   461:   | (
   462:        `BEXPR_apply ((`BEXPR_closure(i,ts),_),b),t
   463:      | `BEXPR_apply_direct (i,ts,b),t
   464:     ) as x ->
   465:       begin
   466:         let _,_,_,entry = Hashtbl.find bbdfns i in
   467:         match entry with
   468:         | `BBDCL_function (props,_,_,_,_) ->
   469:           if mem `Stackable props
   470:           then `BEXPR_apply_stack (i,ts,b),t
   471:           else `BEXPR_apply_direct (i,ts,b),t
   472:         | `BBDCL_fun _
   473:         | `BBDCL_callback _ ->
   474:           `BEXPR_apply_prim(i,ts,b),t
   475: 
   476:         | `BBDCL_struct _
   477:         | `BBDCL_cstruct _
   478:         | `BBDCL_nonconst_ctor  _ ->
   479:           `BEXPR_apply_struct(i,ts,b),t
   480:         | _ -> x
   481:       end
   482:   | (
   483:       `BEXPR_apply ((`BEXPR_method_closure (obj,meth,ts),_),b),t
   484:       | `BEXPR_apply_method_direct (obj,meth,ts,b),t
   485:     ) as x ->
   486:       begin
   487:         let _,_,_,entry = Hashtbl.find bbdfns meth in
   488:         match entry with
   489:         | `BBDCL_function (props,_,_,_,_) ->
   490:           if mem `Stackable props
   491:           then `BEXPR_apply_method_stack (obj,meth,ts,b),t
   492:           else `BEXPR_apply_method_direct (obj,meth,ts,b),t
   493:         | _ -> x
   494:       end
   495:   | x -> x
   496: 
   497: let mark_stackable cache syms (child_map,bbdfns) =
   498:   Hashtbl.iter
   499:   (fun i (id,parent,sr,entry) ->
   500:     match entry with
   501:     | `BBDCL_function (props,vs,p,ret,exes) ->
   502:       let props: property_t list ref = ref props in
   503:       if can_stack_func cache syms (child_map,bbdfns) i then
   504:       begin
   505:         props := `Stackable :: !props;
   506:         if is_pure syms (child_map,bbdfns) i then
   507:         begin
   508:           (*
   509:           print_endline ("Function " ^ id ^ "<" ^ si i ^ "> is PURE");
   510:           *)
   511:           props := `Pure :: !props;
   512:         end
   513:         (*
   514:         else
   515:           print_endline ("Stackable Function " ^ id ^ "<" ^ si i ^ "> is NOT PURE")
   516:         *)
   517:       end
   518:       (*
   519:       else print_endline ("Function " ^ id ^ "<" ^ si i ^ "> is NOT STACKABLE")
   520:       *)
   521:       ;
   522:       let props : property_t list = !props in
   523:       let entry : bbdcl_t = `BBDCL_function (props,vs,p,ret,exes) in
   524:       Hashtbl.replace bbdfns i (id,parent,sr,entry)
   525: 
   526:     | `BBDCL_procedure (props,vs,p,exes) ->
   527:       if mem `Stackable props or mem `Unstackable props then ()
   528:       else ignore(check_stackable_proc cache syms (child_map,bbdfns) i [])
   529:     | _ -> ()
   530:   )
   531:   bbdfns
   532: 
   533: let enstack_calls cache syms (child_map,bbdfns) self exes =
   534:   let self_stacked = ref false in
   535:   let ea e = enstack_applies cache syms (child_map, bbdfns) e in
   536:   let id x = x in
   537:   let exes =
   538:     map (
   539:       fun exe -> let exe = match exe with
   540:       | `BEXE_call (sr,(`BEXPR_closure (i,ts),_),a)
   541:       | `BEXE_call_direct (sr,i,ts,a) ->
   542:         let id,parent,sr,entry = Hashtbl.find bbdfns i in
   543:         begin match entry with
   544:         | `BBDCL_procedure (props,vs,p,exes) ->
   545:           if mem `Stackable props then
   546:           begin
   547:             if i = self then self_stacked := true else
   548:             if not (mem `Stack_closure props) then
   549:               Hashtbl.replace bbdfns i (id,parent,sr,`BBDCL_procedure (`Stack_closure::props,vs,p,exes))
   550:             ;
   551:             (*
   552:             print_endline "CALL STACK";
   553:             *)
   554:             `BEXE_call_stack (sr,i,ts,a)
   555:           end
   556:           else
   557:           `BEXE_call_direct (sr,i,ts,a)
   558: 
   559:         | `BBDCL_proc _ -> `BEXE_call_prim (sr,i,ts,a)
   560:         | _ -> assert false
   561:         end
   562: 
   563:       | `BEXE_call_method_direct (sr,obj,i,ts,a) ->
   564:         let id,parent,sr,entry = Hashtbl.find bbdfns i in
   565:         begin match entry with
   566:         | `BBDCL_procedure (props,vs,p,exes) ->
   567:           if mem `Stackable props then
   568:           begin
   569:             if i = self then self_stacked := true else
   570:             if not (mem `Stack_closure props) then
   571:               Hashtbl.replace bbdfns i (id,parent,sr,`BBDCL_procedure (`Stack_closure::props,vs,p,exes))
   572:             ;
   573:             (*
   574:             print_endline "CALL_METHOD_STACK";
   575:             *)
   576:             `BEXE_call_method_stack (sr,obj,i,ts,a)
   577:           end
   578:           else
   579:           `BEXE_call_method_direct (sr,obj,i,ts,a)
   580: 
   581:         | _ -> assert false
   582:         end
   583: 
   584:       | `BEXE_apply_ctor (sr,v,obj,ts,meth,a) ->
   585:         let id,parent,sr,entry = Hashtbl.find bbdfns meth in
   586:         begin match entry with
   587:         | `BBDCL_procedure (props,vs,p,exes) ->
   588:           if mem `Stackable props then
   589:           begin
   590:             if meth = self then self_stacked := true else
   591:             if not (mem `Stack_closure props) then
   592:               Hashtbl.replace bbdfns meth (id,parent,sr,`BBDCL_procedure (`Stack_closure::props,vs,p,exes))
   593:             ;
   594:             (*
   595:             print_endline "APPLY_CTOR_STACK";
   596:             *)
   597:             `BEXE_apply_ctor_stack (sr,v,obj,ts,meth,a)
   598:           end
   599:           else
   600:           `BEXE_apply_ctor (sr,v,obj,ts,meth,a)
   601: 
   602:         | _ -> assert false
   603:         end
   604: 
   605:       | x -> x
   606:       in
   607:         map_bexe id ea id id id exe
   608:     )
   609:     exes
   610:   in
   611:   !self_stacked, exes
   612: 
   613: let make_stack_calls syms (child_map, (bbdfns: fully_bound_symbol_table_t)) =
   614:   let cache = Hashtbl.create 97 in
   615:   let ea e = enstack_applies cache syms (child_map, bbdfns) e in
   616:   mark_stackable cache syms (child_map,bbdfns);
   617:   Hashtbl.iter
   618:   (fun i (id,parent,sr,entry) -> match entry with
   619:     | `BBDCL_procedure (props,vs,p,exes) ->
   620:       let self_stacked,exes = enstack_calls cache syms (child_map,bbdfns) i exes in
   621:       let exes = Flx_cflow.final_tailcall_opt exes in
   622:       let props =
   623:         if self_stacked then
   624:           if not (mem `Stack_closure props)
   625:           then `Stack_closure :: props
   626:           else props
   627:         else props
   628:       in
   629:       Hashtbl.replace bbdfns i (id,parent,sr,`BBDCL_procedure (props,vs,p,exes))
   630: 
   631:     | `BBDCL_function (props,vs,p,ret,exes) ->
   632:       let _,exes = enstack_calls cache syms (child_map,bbdfns) i exes in
   633:       Hashtbl.replace bbdfns i (id,parent,sr,`BBDCL_function (props,vs,p,ret,exes))
   634: 
   635:     | `BBDCL_glr (props,vs,t,(p,exes)) ->
   636:       let _,exes = enstack_calls cache syms (child_map,bbdfns) i exes in
   637:       Hashtbl.replace bbdfns i (id,parent,sr,`BBDCL_glr (props,vs,t,(p,exes)))
   638: 
   639:     | `BBDCL_regmatch (_,vs,p,t,(a,i,h,m)) ->
   640:       Hashtbl.iter
   641:       (fun k e -> Hashtbl.replace h k (ea e))
   642:       h
   643: 
   644:     | `BBDCL_reglex (_,vs,p,j,t,(a,i,h,m)) ->
   645:       Hashtbl.iter
   646:       (fun k e -> Hashtbl.replace h k (ea e))
   647:       h
   648: 
   649:     | _ -> ()
   650:   )
   651:   bbdfns
   652: 
End ocaml section to src/flx_stack_calls.ml[1]