Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file tailcall.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108(* Js_of_ocaml compiler
* http://www.ocsigen.org/js_of_ocaml/
* Copyright (C) 2010 Jérôme Vouillon
* Laboratoire PPS - CNRS Université Paris Diderot
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)open!Stdliblettimes=Debug.find"times"openCode(* FIX: it should be possible to deal with tail-recursion in exception
handlers, but we have to adapt the code generator for that *)letrecremove_lastl=matchlwith|[]->assertfalse|[_]->[]|x::r->x::remove_lastrletrectail_callxfl=matchlwith|[]->None|[Let(y,Apply(g,args,_))]whenVar.comparexy=0&&Var.comparefg=0->Someargs|_::rem->tail_callxfremletrewrite_block(f,f_params,f_pc,args)pcblocks=letblock=Addr.Map.findpcblocksinmatchblock.branchwith|Returnx->(matchtail_callxfblock.bodywith|Somef_argswhenList.lengthf_params=List.lengthf_args->letm=Subst.build_mappingf_paramsf_argsinList.iter2f_paramsf_args~f:(funpa->Code.Var.propagate_namepa);Addr.Map.addpc{params=block.params;handler=block.handler;body=remove_lastblock.body;branch=Branch(f_pc,List.mapargs~f:(funx->Var.Map.findxm))}blocks|_->blocks)|_->blocks(* Skip try body *)letfold_childrenblockspcfaccu=letblock=Addr.Map.findpcblocksinmatchblock.branchwith|Return_|Raise_|Stop->accu|Branch(pc',_)|Poptrap((pc',_),_)->fpc'accu|Pushtrap(_,_,(pc1,_),pcs)->fpc1(Addr.Set.foldfpcsaccu)|Cond(_,(pc1,_),(pc2,_))->letaccu=fpc1accuinletaccu=fpc2accuinaccu|Switch(_,a1,a2)->letaccu=Array.fold_righta1~init:accu~f:(fun(pc,_)accu->fpcaccu)inletaccu=Array.fold_righta2~init:accu~f:(fun(pc,_)accu->fpcaccu)inacculetrectraversefpcvisitedblocks=ifnot(Addr.Set.mempcvisited)thenletvisited=Addr.Set.addpcvisitedinletblocks=rewrite_blockfpcblocksinletvisited,blocks=fold_childrenblockspc(funpc(visited,blocks)->letvisited,blocks=traversefpcvisitedblocksinvisited,blocks)(visited,blocks)invisited,blockselsevisited,blocksletfp=lett=Timer.make()inletblocks=fold_closuresp(funfparams(pc,args)blocks->matchfwith|SomefwhenList.lengthparams=List.lengthargs->let_,blocks=traverse(f,params,pc,args)pcAddr.Set.emptyblocksinblocks|_->blocks)p.blocksiniftimes()thenFormat.eprintf" tail calls: %a@."Timer.printt;{pwithblocks}