1%% ``Licensed under the Apache License, Version 2.0 (the "License"); 2%% you may not use this file except in compliance with the License. 3%% You may obtain a copy of the License at 4%% 5%% http://www.apache.org/licenses/LICENSE-2.0 6%% 7%% Unless required by applicable law or agreed to in writing, software 8%% distributed under the License is distributed on an "AS IS" BASIS, 9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 10%% See the License for the specific language governing permissions and 11%% limitations under the License. 12%% 13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. 14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 15%% AB. All Rights Reserved.'' 16%% 17%% $Id: beam_type.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ 18%% Purpose : Type-based optimisations. 19 20-module(beam_type). 21 22-export([module/2]). 23 24-import(lists, [map/2,foldl/3,reverse/1,reverse/2,filter/2,member/2]). 25 26module({Mod,Exp,Attr,Fs0,Lc}, Opt) -> 27 AllowFloatOpts = not member(no_float_opt, Opt), 28 Fs = map(fun(F) -> function(F, AllowFloatOpts) end, Fs0), 29 {ok,{Mod,Exp,Attr,Fs,Lc}}. 30 31function({function,Name,Arity,CLabel,Asm0}, AllowFloatOpts) -> 32 Asm = opt(Asm0, AllowFloatOpts, [], tdb_new()), 33 {function,Name,Arity,CLabel,Asm}. 34 35%% opt([Instruction], AllowFloatOpts, Accumulator, TypeDb) -> {[Instruction'],TypeDb'} 36%% Keep track of type information; try to simplify. 37 38opt([{block,Body1}|Is], AllowFloatOpts, [{block,Body0}|Acc], Ts0) -> 39 {Body2,Ts} = simplify(Body1, Ts0, AllowFloatOpts), 40 Body = beam_block:merge_blocks(Body0, Body2), 41 opt(Is, AllowFloatOpts, [{block,Body}|Acc], Ts); 42opt([{block,Body0}|Is], AllowFloatOpts, Acc, Ts0) -> 43 {Body,Ts} = simplify(Body0, Ts0, AllowFloatOpts), 44 opt(Is, AllowFloatOpts, [{block,Body}|Acc], Ts); 45opt([I0|Is], AllowFloatOpts, Acc, Ts0) -> 46 case simplify([I0], Ts0, AllowFloatOpts) of 47 {[],Ts} -> opt(Is, AllowFloatOpts, Acc, Ts); 48 {[I],Ts} -> opt(Is, AllowFloatOpts, [I|Acc], Ts) 49 end; 50opt([], _, Acc, _) -> reverse(Acc). 51 52%% simplify(Instruction, TypeDb, AllowFloatOpts) -> NewInstruction 53%% Simplify an instruction using type information (this is 54%% technically a "strength reduction"). 55 56simplify(Is, TypeDb, false) -> 57 simplify(Is, TypeDb, no_float_opt, []); 58simplify(Is, TypeDb, true) -> 59 case are_live_regs_determinable(Is) of 60 false -> simplify(Is, TypeDb, no_float_opt, []); 61 true -> simplify(Is, TypeDb, [], []) 62 end. 63 64simplify([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is]=Is0, Ts0, Rs0, Acc0) -> 65 I = case max_tuple_size(Reg, Ts0) of 66 Sz when 0 < Index, Index =< Sz -> 67 {set,[D],[Reg],{get_tuple_element,Index-1}}; 68 _Other -> I0 69 end, 70 Ts = update(I, Ts0), 71 {Rs,Acc} = flush(Rs0, Is0, Acc0), 72 simplify(Is, Ts, Rs, [I|checkerror(Acc)]); 73simplify([{set,[D0],[A],{bif,'-',{f,0}}}=I|Is]=Is0, Ts0, Rs0, Acc0) 74 when Rs0 =/= no_float_opt -> 75 case tdb_find(A, Ts0) of 76 float -> 77 {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), 78 {D,Rs} = find_dest(D0, Rs1), 79 Areg = fetch_reg(A, Rs), 80 Acc = [{set,[D],[Areg],{bif,fnegate,{f,0}}}|clearerror(Acc1)], 81 Ts = tdb_update([{D0,float}], Ts0), 82 simplify(Is, Ts, Rs, Acc); 83 _Other -> 84 Ts = update(I, Ts0), 85 {Rs,Acc} = flush(Rs0, Is0, Acc0), 86 simplify(Is, Ts, Rs, [I|checkerror(Acc)]) 87 end; 88simplify([{set,[_],[_],{bif,_,{f,0}}}=I|Is]=Is0, Ts0, Rs0, Acc0) -> 89 Ts = update(I, Ts0), 90 {Rs,Acc} = flush(Rs0, Is0, Acc0), 91 simplify(Is, Ts, Rs, [I|checkerror(Acc)]); 92simplify([{set,[D0],[A,B],{bif,Op0,{f,0}}}=I|Is]=Is0, Ts0, Rs0, Acc0) 93 when Rs0 =/= no_float_opt -> 94 case float_op(Op0, A, B, Ts0) of 95 no -> 96 Ts = update(I, Ts0), 97 {Rs,Acc} = flush(Rs0, Is0, Acc0), 98 simplify(Is, Ts, Rs, [I|checkerror(Acc)]); 99 {yes,Op} -> 100 {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), 101 {Rs2,Acc2} = load_reg(B, Ts0, Rs1, Acc1), 102 {D,Rs} = find_dest(D0, Rs2), 103 Areg = fetch_reg(A, Rs), 104 Breg = fetch_reg(B, Rs), 105 Acc = [{set,[D],[Areg,Breg],{bif,Op,{f,0}}}|clearerror(Acc2)], 106 Ts = tdb_update([{D0,float}], Ts0), 107 simplify(Is, Ts, Rs, Acc) 108 end; 109simplify([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Rs0, Acc0) -> 110 case tdb_find(TupleReg, Ts0) of 111 {tuple,_,[Contents]} -> 112 Ts = tdb_update([{D,Contents}], Ts0), 113 {Rs,Acc} = flush(Rs0, Is0, Acc0), 114 simplify(Is0, Ts, Rs, [{set,[D],[Contents],move}|Acc]); 115 _ -> 116 Ts = update(I, Ts0), 117 {Rs,Acc} = flush(Rs0, Is0, Acc0), 118 simplify(Is0, Ts, Rs, [I|checkerror(Acc)]) 119 end; 120simplify([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> 121 Acc = flush_all(Rs0, Is0, Acc0), 122 simplify(Is, tdb_new(), Rs0, [I|Acc]); 123simplify([{test,is_tuple,_,[R]}=I|Is], Ts, Rs, Acc) -> 124 case tdb_find(R, Ts) of 125 {tuple,_,_} -> simplify(Is, Ts, Rs, Acc); 126 _ -> 127 simplify(Is, Ts, Rs, [I|Acc]) 128 end; 129simplify([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Rs, Acc) -> 130 case tdb_find(R, Ts0) of 131 {tuple,Arity,_} -> 132 simplify(Is, Ts0, Rs, Acc); 133 _Other -> 134 Ts = update(I, Ts0), 135 simplify(Is, Ts, Rs, [I|Acc]) 136 end; 137simplify([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Rs0, Acc0) -> 138 Acc1 = case tdb_find(R, Ts0) of 139 {atom,_}=Atom -> Acc0; 140 {atom,_} -> [{jump,Fail}|Acc0]; 141 _ -> [I|Acc0] 142 end, 143 Ts = update(I, Ts0), 144 {Rs,Acc} = flush(Rs0, Is0, Acc1), 145 simplify(Is0, Ts, Rs, Acc); 146simplify([I|Is]=Is0, Ts0, Rs0, Acc0) -> 147 Ts = update(I, Ts0), 148 {Rs,Acc} = flush(Rs0, Is0, Acc0), 149 simplify(Is, Ts, Rs, [I|Acc]); 150simplify([], Ts, Rs, Acc) -> 151 Is0 = reverse(flush_all(Rs, [], Acc)), 152 Is1 = opt_fmoves(Is0, []), 153 Is = add_ftest_heap(Is1), 154 {Is,Ts}. 155 156opt_fmoves([{set,[{x,_}=R],[{fr,_}]=Src,fmove}=I1, 157 {set,[{y,_}]=Dst,[{x,_}=R],move}=I2|Is], Acc) -> 158 case beam_block:is_killed(R, Is) of 159 false -> opt_fmoves(Is, [I2,I1|Acc]); 160 true -> opt_fmoves(Is, [{set,Dst,Src,fmove}|Acc]) 161 end; 162opt_fmoves([I|Is], Acc) -> 163 opt_fmoves(Is, [I|Acc]); 164opt_fmoves([], Acc) -> reverse(Acc). 165 166clearerror(Is) -> 167 clearerror(Is, Is). 168 169clearerror([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs; 170clearerror([{set,[],[],fcheckerror}|_], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]; 171clearerror([_|Is], OrigIs) -> clearerror(Is, OrigIs); 172clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]. 173 174%% update(Instruction, TypeDb) -> NewTypeDb 175%% Update the type database to account for executing an instruction. 176%% 177%% First the cases for instructions inside basic blocks. 178update({set,[D],[S],move}, Ts0) -> 179 Ops = case tdb_find(S, Ts0) of 180 error -> [{D,kill}]; 181 Info -> [{D,Info}] 182 end, 183 tdb_update(Ops, Ts0); 184update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) -> 185 tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0); 186update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) -> 187 tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0); 188update({set,[D],[S],{get_tuple_element,0}}, Ts) -> 189 tdb_update([{D,{tuple_element,S,0}}], Ts); 190update({set,[D],[S],{bif,float,{f,0}}}, Ts0) -> 191 %% Make sure we reject non-numeric literal argument. 192 case possibly_numeric(S) of 193 true -> tdb_update([{D,float}], Ts0); 194 false -> Ts0 195 end; 196update({set,[D],[S1,S2],{bif,'/',{f,0}}}, Ts0) -> 197 %% Make sure we reject non-numeric literals. 198 case possibly_numeric(S1) andalso possibly_numeric(S2) of 199 true -> tdb_update([{D,float}], Ts0); 200 false -> Ts0 201 end; 202update({set,[D],[S1,S2],{bif,Op,{f,0}}}, Ts0) -> 203 case arith_op(Op) of 204 no -> 205 tdb_update([{D,kill}], Ts0); 206 {yes,_} -> 207 case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of 208 {float,_} -> tdb_update([{D,float}], Ts0); 209 {_,float} -> tdb_update([{D,float}], Ts0); 210 {_,_} -> tdb_update([{D,kill}], Ts0) 211 end 212 end; 213update({set,[],_Src,_Op}, Ts0) -> Ts0; 214update({set,[D],_Src,_Op}, Ts0) -> 215 tdb_update([{D,kill}], Ts0); 216update({set,[D1,D2],_Src,_Op}, Ts0) -> 217 tdb_update([{D1,kill},{D2,kill}], Ts0); 218update({allocate,_,_}, Ts) -> Ts; 219update({init,D}, Ts) -> 220 tdb_update([{D,kill}], Ts); 221update({kill,D}, Ts) -> 222 tdb_update([{D,kill}], Ts); 223update({'%live',_}, Ts) -> Ts; 224 225%% Instructions outside of blocks. 226update({test,is_float,_Fail,[Src]}, Ts0) -> 227 tdb_update([{Src,float}], Ts0); 228update({test,test_arity,_Fail,[Src,Arity]}, Ts0) -> 229 tdb_update([{Src,{tuple,Arity,[]}}], Ts0); 230update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> 231 case tdb_find(Reg, Ts) of 232 error -> 233 Ts; 234 {tuple_element,TupleReg,0} -> 235 tdb_update([{TupleReg,{tuple,1,[Atom]}}], Ts); 236 _ -> 237 Ts 238 end; 239update({test,_Test,_Fail,_Other}, Ts) -> Ts; 240update({call_ext,1,{extfunc,math,Math,1}}, Ts) -> 241 case is_math_bif(Math, 1) of 242 true -> tdb_update([{{x,0},float}], Ts); 243 false -> tdb_kill_xregs(Ts) 244 end; 245update({call_ext,2,{extfunc,math,Math,2}}, Ts) -> 246 case is_math_bif(Math, 2) of 247 true -> tdb_update([{{x,0},float}], Ts); 248 false -> tdb_kill_xregs(Ts) 249 end; 250update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> 251 Op = case tdb_find({x,1}, Ts0) of 252 error -> kill; 253 Info -> Info 254 end, 255 Ts1 = tdb_kill_xregs(Ts0), 256 tdb_update([{{x,0},Op}], Ts1); 257update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); 258update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); 259update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts); 260 261%% The instruction is unknown. Kill all information. 262update(_I, _Ts) -> tdb_new(). 263 264is_math_bif(cos, 1) -> true; 265is_math_bif(cosh, 1) -> true; 266is_math_bif(sin, 1) -> true; 267is_math_bif(sinh, 1) -> true; 268is_math_bif(tan, 1) -> true; 269is_math_bif(tanh, 1) -> true; 270is_math_bif(acos, 1) -> true; 271is_math_bif(acosh, 1) -> true; 272is_math_bif(asin, 1) -> true; 273is_math_bif(asinh, 1) -> true; 274is_math_bif(atan, 1) -> true; 275is_math_bif(atanh, 1) -> true; 276is_math_bif(erf, 1) -> true; 277is_math_bif(erfc, 1) -> true; 278is_math_bif(exp, 1) -> true; 279is_math_bif(log, 1) -> true; 280is_math_bif(log10, 1) -> true; 281is_math_bif(sqrt, 1) -> true; 282is_math_bif(atan2, 2) -> true; 283is_math_bif(pow, 2) -> true; 284is_math_bif(pi, 0) -> true; 285is_math_bif(_, _) -> false. 286 287%% Reject non-numeric literals. 288possibly_numeric({x,_}) -> true; 289possibly_numeric({y,_}) -> true; 290possibly_numeric({integer,_}) -> true; 291possibly_numeric({float,_}) -> true; 292possibly_numeric(_) -> false. 293 294max_tuple_size(Reg, Ts) -> 295 case tdb_find(Reg, Ts) of 296 {tuple,Sz,_} -> Sz; 297 _Other -> 0 298 end. 299 300float_op('/', A, B, _) -> 301 case possibly_numeric(A) andalso possibly_numeric(B) of 302 true -> {yes,fdiv}; 303 false -> no 304 end; 305float_op(Op, {float,_}, B, _) -> 306 case possibly_numeric(B) of 307 true -> arith_op(Op); 308 false -> no 309 end; 310float_op(Op, A, {float,_}, _) -> 311 case possibly_numeric(A) of 312 true -> arith_op(Op); 313 false -> no 314 end; 315float_op(Op, A, B, Ts) -> 316 case {tdb_find(A, Ts),tdb_find(B, Ts)} of 317 {float,_} -> arith_op(Op); 318 {_,float} -> arith_op(Op); 319 {_,_} -> no 320 end. 321 322find_dest(V, Rs0) -> 323 case find_reg(V, Rs0) of 324 {ok,FR} -> 325 {FR,mark(V, Rs0, dirty)}; 326 error -> 327 Rs = put_reg(V, Rs0, dirty), 328 {ok,FR} = find_reg(V, Rs), 329 {FR,Rs} 330 end. 331 332load_reg({float,_}=F, _, Rs0, Is0) -> 333 Rs = put_reg(F, Rs0, clean), 334 {ok,FR} = find_reg(F, Rs), 335 Is = [{set,[FR],[F],fmove}|Is0], 336 {Rs,Is}; 337load_reg(V, Ts, Rs0, Is0) -> 338 case find_reg(V, Rs0) of 339 {ok,_FR} -> {Rs0,Is0}; 340 error -> 341 Rs = put_reg(V, Rs0, clean), 342 {ok,FR} = find_reg(V, Rs), 343 Op = case tdb_find(V, Ts) of 344 float -> fmove; 345 _ -> fconv 346 end, 347 Is = [{set,[FR],[V],Op}|Is0], 348 {Rs,Is} 349 end. 350 351arith_op('+') -> {yes,fadd}; 352arith_op('-') -> {yes,fsub}; 353arith_op('*') -> {yes,fmul}; 354arith_op('/') -> {yes,fdiv}; 355arith_op(_) -> no. 356 357flush(no_float_opt, _, Acc) -> {no_float_opt,Acc}; 358flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) -> 359 Acc = flush_all(Rs, Is0, Acc0), 360 {[],Acc}; 361flush(Rs0, [{set,Ds,Ss,_Op}|_], Acc0) -> 362 Save = gb_sets:from_list(Ss), 363 Acc = save_regs(Rs0, Save, Acc0), 364 Rs1 = foldl(fun(S, A) -> mark(S, A, clean) end, Rs0, Ss), 365 Kill = gb_sets:from_list(Ds), 366 Rs = kill_regs(Rs1, Kill), 367 {Rs,Acc}; 368flush(Rs0, Is, Acc0) -> 369 Acc = flush_all(Rs0, Is, Acc0), 370 {[],Acc}. 371 372flush_all(no_float_opt, _, Acc) -> Acc; 373flush_all([{_,{float,_},_}|Rs], Is, Acc) -> 374 flush_all(Rs, Is, Acc); 375flush_all([{I,V,dirty}|Rs], Is, Acc0) -> 376 Acc = checkerror(Acc0), 377 case beam_block:is_killed(V, Is) of 378 true -> flush_all(Rs, Is, Acc); 379 false -> flush_all(Rs, Is, [{set,[V],[{fr,I}],fmove}|Acc]) 380 end; 381flush_all([{_,_,clean}|Rs], Is, Acc) -> flush_all(Rs, Is, Acc); 382flush_all([free|Rs], Is, Acc) -> flush_all(Rs, Is, Acc); 383flush_all([], _, Acc) -> Acc. 384 385save_regs(Rs, Save, Acc) -> 386 foldl(fun(R, A) -> save_reg(R, Save, A) end, Acc, Rs). 387 388save_reg({I,V,dirty}, Save, Acc) -> 389 case gb_sets:is_member(V, Save) of 390 true -> [{set,[V],[{fr,I}],fmove}|checkerror(Acc)]; 391 false -> Acc 392 end; 393save_reg(_, _, Acc) -> Acc. 394 395kill_regs(Rs, Kill) -> 396 map(fun(R) -> kill_reg(R, Kill) end, Rs). 397 398kill_reg({_,V,_}=R, Kill) -> 399 case gb_sets:is_member(V, Kill) of 400 true -> free; 401 false -> R 402 end; 403kill_reg(R, _) -> R. 404 405mark(V, [{I,V,_}|Rs], Mark) -> [{I,V,Mark}|Rs]; 406mark(V, [R|Rs], Mark) -> [R|mark(V, Rs, Mark)]; 407mark(_, [], _) -> []. 408 409fetch_reg(V, [{I,V,_}|_]) -> {fr,I}; 410fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). 411 412find_reg(V, [{I,V,_}|_]) -> {ok,{fr,I}}; 413find_reg(V, [_|SRs]) -> find_reg(V, SRs); 414find_reg(_, []) -> error. 415 416put_reg(V, Rs, Dirty) -> put_reg_1(V, Rs, Dirty, 0). 417 418put_reg_1(V, [free|Rs], Dirty, I) -> [{I,V,Dirty}|Rs]; 419put_reg_1(V, [R|Rs], Dirty, I) -> [R|put_reg_1(V, Rs, Dirty, I+1)]; 420put_reg_1(V, [], Dirty, I) -> [{I,V,Dirty}]. 421 422checkerror(Is) -> 423 checkerror_1(Is, Is). 424 425checkerror_1([{set,[],[],fcheckerror}|_], OrigIs) -> OrigIs; 426checkerror_1([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs; 427checkerror_1([{set,_,_,{bif,fadd,_}}|_], OrigIs) -> checkerror_2(OrigIs); 428checkerror_1([{set,_,_,{bif,fsub,_}}|_], OrigIs) -> checkerror_2(OrigIs); 429checkerror_1([{set,_,_,{bif,fmul,_}}|_], OrigIs) -> checkerror_2(OrigIs); 430checkerror_1([{set,_,_,{bif,fdiv,_}}|_], OrigIs) -> checkerror_2(OrigIs); 431checkerror_1([{set,_,_,{bif,fnegate,_}}|_], OrigIs) -> checkerror_2(OrigIs); 432checkerror_1([_|Is], OrigIs) -> checkerror_1(Is, OrigIs); 433checkerror_1([], OrigIs) -> OrigIs. 434 435checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. 436 437add_ftest_heap(Is) -> 438 add_ftest_heap_1(reverse(Is), 0, []). 439 440add_ftest_heap_1([{set,_,[{fr,_}],fmove}=I|Is], Floats, Acc) -> 441 add_ftest_heap_1(Is, Floats+1, [I|Acc]); 442add_ftest_heap_1([{allocate,_,_}=I|Is], 0, Acc) -> 443 reverse(Is, [I|Acc]); 444add_ftest_heap_1([{allocate,Regs,{Z,Stk,Heap,Inits}}|Is], Floats, Acc) -> 445 reverse(Is, [{allocate,Regs,{Z,Stk,Heap,Floats,Inits}}|Acc]); 446add_ftest_heap_1([I|Is], Floats, Acc) -> 447 add_ftest_heap_1(Is, Floats, [I|Acc]); 448add_ftest_heap_1([], 0, Acc) -> 449 Acc; 450add_ftest_heap_1([], Floats, Is) -> 451 Regs = beam_block:live_at_entry(Is), 452 [{allocate,Regs,{nozero,nostack,0,Floats,[]}}|Is]. 453 454are_live_regs_determinable([{allocate,_,_}|_]) -> true; 455are_live_regs_determinable([{'%live',_}|_]) -> true; 456are_live_regs_determinable([_|Is]) -> are_live_regs_determinable(Is); 457are_live_regs_determinable([]) -> false. 458 459 460%%% Routines for maintaining a type database. The type database 461%%% associates type information with registers. 462%%% 463%%% {tuple,Size,First} means that the corresponding register contains a 464%%% tuple with *at least* Size elements. An tuple with unknown 465%%% size is represented as {tuple,0}. First is either [] (meaning that 466%%% the tuple's first element is unknown) or [FirstElement] (the contents 467%%% of the first element). 468%%% 469%%% 'float' means that the register contains a float. 470 471%% tdb_new() -> EmptyDataBase 472%% Creates a new, empty type database. 473 474tdb_new() -> []. 475 476%% tdb_find(Register, Db) -> Information|error 477%% Returns type information or the atom error if there are no type 478%% information available for Register. 479 480tdb_find(Key, [{K,_}|_]) when Key < K -> error; 481tdb_find(Key, [{Key,Info}|_]) -> Info; 482tdb_find(Key, [_|Db]) -> tdb_find(Key, Db); 483tdb_find(_, []) -> error. 484 485%% tdb_update([UpdateOp], Db) -> NewDb 486%% UpdateOp = {Register,kill}|{Register,NewInfo} 487%% Updates a type database. If a 'kill' operation is given, the type 488%% information for that register will be removed from the database. 489%% A kill operation takes precende over other operations for the same 490%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5}}] means that the 491%% the existing type information, if any, will be discarded, and the 492%% the '{tuple,5}' information ignored. 493%% 494%% If NewInfo information is given and there exists information about 495%% the register, the old and new type information will be merged. 496%% For instance, {tuple,5} and {tuple,10} will be merged to produce 497%% {tuple,10}. 498 499tdb_update(Uis0, Ts0) -> 500 Uis1 = filter(fun ({{x,_},_Op}) -> true; 501 ({{y,_},_Op}) -> true; 502 (_) -> false 503 end, Uis0), 504 tdb_update1(lists:sort(Uis1), Ts0). 505 506tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K -> 507 tdb_update1(remove_key(Key, Ops), Db); 508tdb_update1([{Key,_New}=New|Ops], [{K,_Old}|_]=Db) when Key < K -> 509 [New|tdb_update1(Ops, Db)]; 510tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) -> 511 tdb_update1(remove_key(Key, Ops), Db); 512tdb_update1([{Key,NewInfo}|Ops], [{Key,OldInfo}|Db]) -> 513 [{Key,merge_type_info(NewInfo, OldInfo)}|tdb_update1(Ops, Db)]; 514tdb_update1([{_,_}|_]=Ops, [Old|Db]) -> 515 [Old|tdb_update1(Ops, Db)]; 516tdb_update1([{Key,kill}|Ops], []) -> 517 tdb_update1(remove_key(Key, Ops), []); 518tdb_update1([{_,_}=New|Ops], []) -> 519 [New|tdb_update1(Ops, [])]; 520tdb_update1([], Db) -> Db. 521 522%% tdb_kill_xregs(Db) -> NewDb 523%% Kill all information about x registers. Also kill all tuple_element 524%% dependencies from y registers to x registers. 525 526tdb_kill_xregs([{{x,_},_Type}|Db]) -> tdb_kill_xregs(Db); 527tdb_kill_xregs([{{y,_},{tuple_element,{x,_},_}}|Db]) -> tdb_kill_xregs(Db); 528tdb_kill_xregs([Any|Db]) -> [Any|tdb_kill_xregs(Db)]; 529tdb_kill_xregs([]) -> []. 530 531remove_key(Key, [{Key,_Op}|Ops]) -> remove_key(Key, Ops); 532remove_key(_, Ops) -> Ops. 533 534merge_type_info(I, I) -> I; 535merge_type_info({tuple,Sz1,Same}, {tuple,Sz2,Same}=Max) when Sz1 < Sz2 -> 536 Max; 537merge_type_info({tuple,Sz1,Same}=Max, {tuple,Sz2,Same}) when Sz1 > Sz2 -> 538 Max; 539merge_type_info({tuple,Sz1,[]}, {tuple,Sz2,First}) -> 540 merge_type_info({tuple,Sz1,First}, {tuple,Sz2,First}); 541merge_type_info({tuple,Sz1,First}, {tuple,Sz2,_}) -> 542 merge_type_info({tuple,Sz1,First}, {tuple,Sz2,First}); 543merge_type_info(NewType, _) -> 544 verify_type(NewType), 545 NewType. 546 547verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; 548verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok; 549verify_type({tuple_element,_,_}) -> ok; 550verify_type(float) -> ok; 551verify_type({atom,_}) -> ok. 552