1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2002-2020. All Rights Reserved. 5%% 6%% Licensed under the Apache License, Version 2.0 (the "License"); 7%% you may not use this file except in compliance with the License. 8%% You may obtain a copy of the License at 9%% 10%% http://www.apache.org/licenses/LICENSE-2.0 11%% 12%% Unless required by applicable law or agreed to in writing, software 13%% distributed under the License is distributed on an "AS IS" BASIS, 14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15%% See the License for the specific language governing permissions and 16%% limitations under the License. 17%% 18%% %CopyrightEnd% 19%% 20-module(ms_transform). 21 22-export([format_error/1,transform_from_shell/3, 23 parse_transform/2,parse_transform_info/0]). 24 25%% Error codes. 26-define(ERROR_BASE_GUARD,0). 27-define(ERROR_BASE_BODY,100). 28-define(ERR_NOFUN,1). 29-define(ERR_ETS_HEAD,2). 30-define(ERR_DBG_HEAD,3). 31-define(ERR_HEADMATCH,4). 32-define(ERR_SEMI_GUARD,5). 33-define(ERR_UNBOUND_VARIABLE,6). 34-define(ERR_HEADBADREC,7). 35-define(ERR_HEADBADFIELD,8). 36-define(ERR_HEADMULTIFIELD,9). 37-define(ERR_HEADDOLLARATOM,10). 38-define(ERR_HEADBINMATCH,11). 39-define(ERR_GENMATCH,16). 40-define(ERR_GENLOCALCALL,17). 41-define(ERR_GENELEMENT,18). 42-define(ERR_GENBADFIELD,19). 43-define(ERR_GENBADREC,20). 44-define(ERR_GENMULTIFIELD,21). 45-define(ERR_GENREMOTECALL,22). 46-define(ERR_GENBINCONSTRUCT,23). 47-define(ERR_GENDISALLOWEDOP,24). 48-define(WARN_SHADOW_VAR,50). 49-define(ERR_GUARDMATCH,?ERR_GENMATCH+?ERROR_BASE_GUARD). 50-define(ERR_BODYMATCH,?ERR_GENMATCH+?ERROR_BASE_BODY). 51-define(ERR_GUARDLOCALCALL,?ERR_GENLOCALCALL+?ERROR_BASE_GUARD). 52-define(ERR_BODYLOCALCALL,?ERR_GENLOCALCALL+?ERROR_BASE_BODY). 53-define(ERR_GUARDELEMENT,?ERR_GENELEMENT+?ERROR_BASE_GUARD). 54-define(ERR_BODYELEMENT,?ERR_GENELEMENT+?ERROR_BASE_BODY). 55-define(ERR_GUARDBADFIELD,?ERR_GENBADFIELD+?ERROR_BASE_GUARD). 56-define(ERR_BODYBADFIELD,?ERR_GENBADFIELD+?ERROR_BASE_BODY). 57-define(ERR_GUARDBADREC,?ERR_GENBADREC+?ERROR_BASE_GUARD). 58-define(ERR_BODYBADREC,?ERR_GENBADREC+?ERROR_BASE_BODY). 59-define(ERR_GUARDMULTIFIELD,?ERR_GENMULTIFIELD+?ERROR_BASE_GUARD). 60-define(ERR_BODYMULTIFIELD,?ERR_GENMULTIFIELD+?ERROR_BASE_BODY). 61-define(ERR_GUARDREMOTECALL,?ERR_GENREMOTECALL+?ERROR_BASE_GUARD). 62-define(ERR_BODYREMOTECALL,?ERR_GENREMOTECALL+?ERROR_BASE_BODY). 63-define(ERR_GUARDBINCONSTRUCT,?ERR_GENBINCONSTRUCT+?ERROR_BASE_GUARD). 64-define(ERR_BODYBINCONSTRUCT,?ERR_GENBINCONSTRUCT+?ERROR_BASE_BODY). 65-define(ERR_GUARDDISALLOWEDOP,?ERR_GENDISALLOWEDOP+?ERROR_BASE_GUARD). 66-define(ERR_BODYDISALLOWEDOP,?ERR_GENDISALLOWEDOP+?ERROR_BASE_BODY). 67 68%% 69%% Called by compiler or ets/dbg:fun2ms when errors/warnings occur 70%% 71 72-spec(format_error(Error) -> Chars when 73 Error :: {error, module(), term()}, 74 Chars :: io_lib:chars()). 75 76format_error({?WARN_SHADOW_VAR,Name}) -> 77 lists:flatten( 78 io_lib:format("variable ~p shadowed in ms_transform fun head", 79 [Name])); 80 81format_error(?ERR_NOFUN) -> 82 "Parameter of ets/dbg:fun2ms/1 is not a literal fun"; 83format_error(?ERR_ETS_HEAD) -> 84 "ets:fun2ms requires fun with single variable or tuple parameter"; 85format_error(?ERR_DBG_HEAD) -> 86 "dbg:fun2ms requires fun with single variable or list parameter"; 87format_error(?ERR_HEADMATCH) -> 88 "in fun head, only matching (=) on toplevel can be translated into match_spec"; 89format_error(?ERR_SEMI_GUARD) -> 90 "fun with semicolon (;) in guard cannot be translated into match_spec"; 91format_error(?ERR_GUARDMATCH) -> 92 "fun with guard matching ('=' in guard) is illegal as match_spec as well"; 93format_error({?ERR_GUARDLOCALCALL, Name, Arithy}) -> 94 lists:flatten(io_lib:format("fun containing the local function call " 95 "'~tw/~w' (called in guard) " 96 "cannot be translated into match_spec", 97 [Name, Arithy])); 98format_error({?ERR_GUARDREMOTECALL, Module, Name, Arithy}) -> 99 lists:flatten(io_lib:format("fun containing the remote function call " 100 "'~w:~tw/~w' (called in guard) " 101 "cannot be translated into match_spec", 102 [Module,Name,Arithy])); 103format_error({?ERR_GUARDELEMENT, Str}) -> 104 lists:flatten( 105 io_lib:format("the language element ~ts (in guard) cannot be translated " 106 "into match_spec", [Str])); 107format_error({?ERR_GUARDBINCONSTRUCT, Var}) -> 108 lists:flatten( 109 io_lib:format("bit syntax construction with variable ~w (in guard) " 110 "cannot be translated " 111 "into match_spec", [Var])); 112format_error({?ERR_GUARDDISALLOWEDOP, Operator}) -> 113 %% There is presently no operators that are allowed in bodies but 114 %% not in guards. 115 lists:flatten( 116 io_lib:format("the operator ~w is not allowed in guards", [Operator])); 117format_error(?ERR_BODYMATCH) -> 118 "fun with body matching ('=' in body) is illegal as match_spec"; 119format_error({?ERR_BODYLOCALCALL, Name, Arithy}) -> 120 lists:flatten(io_lib:format("fun containing the local function " 121 "call '~tw/~w' (called in body) " 122 "cannot be translated into match_spec", 123 [Name,Arithy])); 124format_error({?ERR_BODYREMOTECALL, Module, Name, Arithy}) -> 125 lists:flatten(io_lib:format("fun containing the remote function call " 126 "'~w:~tw/~w' (called in body) " 127 "cannot be translated into match_spec", 128 [Module,Name,Arithy])); 129format_error({?ERR_BODYELEMENT, Str}) -> 130 lists:flatten( 131 io_lib:format("the language element ~ts (in body) cannot be translated " 132 "into match_spec", [Str])); 133format_error({?ERR_BODYBINCONSTRUCT, Var}) -> 134 lists:flatten( 135 io_lib:format("bit syntax construction with variable ~w (in body) " 136 "cannot be translated " 137 "into match_spec", [Var])); 138format_error({?ERR_BODYDISALLOWEDOP, Operator}) -> 139 %% This will probably never happen, Are there op's that are allowed in 140 %% guards but not in bodies? Not at time of writing anyway... 141 lists:flatten( 142 io_lib:format("the operator ~w is not allowed in function bodies", 143 [Operator])); 144 145format_error({?ERR_UNBOUND_VARIABLE, Str}) -> 146 lists:flatten( 147 io_lib:format("the variable ~s is unbound, cannot translate " 148 "into match_spec", [Str])); 149format_error({?ERR_HEADBADREC,Name}) -> 150 lists:flatten( 151 io_lib:format("fun head contains unknown record type ~tw",[Name])); 152format_error({?ERR_HEADBADFIELD,RName,FName}) -> 153 lists:flatten( 154 io_lib:format("fun head contains reference to unknown field ~tw in " 155 "record type ~tw",[FName, RName])); 156format_error({?ERR_HEADMULTIFIELD,RName,FName}) -> 157 lists:flatten( 158 io_lib:format("fun head contains already defined field ~tw in " 159 "record type ~tw",[FName, RName])); 160format_error({?ERR_HEADDOLLARATOM,Atom}) -> 161 lists:flatten( 162 io_lib:format("fun head contains atom ~w, which conflics with reserved " 163 "atoms in match_spec heads",[Atom])); 164format_error({?ERR_HEADBINMATCH,Atom}) -> 165 lists:flatten( 166 io_lib:format("fun head contains bit syntax matching of variable ~w, " 167 "which cannot be translated into match_spec", [Atom])); 168format_error({?ERR_GUARDBADREC,Name}) -> 169 lists:flatten( 170 io_lib:format("fun guard contains unknown record type ~tw",[Name])); 171format_error({?ERR_GUARDBADFIELD,RName,FName}) -> 172 lists:flatten( 173 io_lib:format("fun guard contains reference to unknown field ~tw in " 174 "record type ~tw",[FName, RName])); 175format_error({?ERR_GUARDMULTIFIELD,RName,FName}) -> 176 lists:flatten( 177 io_lib:format("fun guard contains already defined field ~tw in " 178 "record type ~tw",[FName, RName])); 179format_error({?ERR_BODYBADREC,Name}) -> 180 lists:flatten( 181 io_lib:format("fun body contains unknown record type ~tw",[Name])); 182format_error({?ERR_BODYBADFIELD,RName,FName}) -> 183 lists:flatten( 184 io_lib:format("fun body contains reference to unknown field ~tw in " 185 "record type ~tw",[FName, RName])); 186format_error({?ERR_BODYMULTIFIELD,RName,FName}) -> 187 lists:flatten( 188 io_lib:format("fun body contains already defined field ~tw in " 189 "record type ~tw",[FName, RName])); 190format_error(Else) -> 191 lists:flatten(io_lib:format("Unknown error code ~tw",[Else])). 192 193-spec parse_transform_info() -> #{'error_location' => 'column'}. 194 195parse_transform_info() -> 196 #{error_location => column}. 197 198%% 199%% Called when translating in shell 200%% 201 202-spec transform_from_shell(Dialect, Clauses, BoundEnvironment) -> term() when 203 Dialect :: ets | dbg, 204 Clauses :: [erl_parse:abstract_clause()], 205 BoundEnvironment :: erl_eval:binding_struct(). 206 207transform_from_shell(Dialect, Clauses, BoundEnvironment) -> 208 SaveFilename = setup_filename(), 209 case catch ms_clause_list(1,Clauses,Dialect,gb_sets:new()) of 210 {'EXIT',Reason} -> 211 cleanup_filename(SaveFilename), 212 exit(Reason); 213 {error,AnnoOrUnknown,R} -> 214 {error, [{cleanup_filename(SaveFilename), 215 [{location(AnnoOrUnknown), ?MODULE, R}]}], []}; 216 Else -> 217 case (catch fixup_environment(Else,BoundEnvironment)) of 218 {error,AnnoOrUnknown1,R1} -> 219 {error, [{cleanup_filename(SaveFilename), 220 [{location(AnnoOrUnknown1), ?MODULE, R1}]}], []}; 221 Else1 -> 222 Ret = normalise(Else1), 223 cleanup_filename(SaveFilename), 224 Ret 225 end 226 end. 227 228 229%% 230%% Called when translating during compiling 231%% 232 233-spec parse_transform(Forms, Options) -> Forms2 | Errors | Warnings when 234 Forms :: [erl_parse:abstract_form() | erl_parse:form_info()], 235 Forms2 :: [erl_parse:abstract_form() | erl_parse:form_info()], 236 Options :: term(), 237 Errors :: {error, ErrInfo :: [tuple()], WarnInfo :: []}, 238 Warnings :: {warning, Forms2, WarnInfo :: [tuple()]}. 239 240parse_transform(Forms, _Options) -> 241 SaveFilename = setup_filename(), 242 %io:format("Forms: ~p~n",[Forms]), 243 case catch forms(Forms) of 244 {'EXIT',Reason} -> 245 cleanup_filename(SaveFilename), 246 exit(Reason); 247 {error,AnnoOrUnknown,R} -> 248 {error, [{cleanup_filename(SaveFilename), 249 [{location(AnnoOrUnknown), ?MODULE, R}]}], []}; 250 Else -> 251 %io:format("Transformed into: ~p~n",[Else]), 252 case get_warnings() of 253 [] -> 254 cleanup_filename(SaveFilename), 255 Else; 256 WL -> 257 FName = cleanup_filename(SaveFilename) , 258 WList = [ {FName, [{L, ?MODULE, R}]} || {L,R} <- WL ], 259 {warning, Else, WList} 260 end 261 end. 262 263location(unknown) -> 264 none; 265location(Anno) -> 266 erl_anno:location(Anno). 267 268get_warnings() -> 269 case get(warnings) of 270 undefined -> 271 []; 272 Else -> 273 Else 274 end. 275 276add_warning(Location,R) -> 277 put(warnings,[{Location,R}| get_warnings()]). 278 279setup_filename() -> 280 {erase(filename),erase(records),erase(warnings)}. 281 282put_filename(Name) -> 283 put(filename,Name). 284 285put_records(R) -> 286 put(records,R), 287 ok. 288 289get_records() -> 290 case get(records) of 291 undefined -> 292 []; 293 Else -> 294 Else 295 end. 296 297get_record(RName) -> 298 case lists:keyfind(RName, 1, get_records()) of 299 {RName, FieldList} -> 300 put(records_replaced_by_tuples, 301 [RName|get(records_replaced_by_tuples)]), 302 FieldList; 303 false -> 304 not_found 305 end. 306 307cleanup_filename({Old,OldRec,OldWarnings}) -> 308 Ret = case erase(filename) of 309 undefined -> 310 "TOP_LEVEL"; 311 X -> 312 X 313 end, 314 case OldRec of 315 undefined -> 316 erase(records); 317 Rec -> 318 put(records,Rec) 319 end, 320 case OldWarnings of 321 undefined -> 322 erase(warnings); 323 Warn -> 324 put(warnings,Warn) 325 end, 326 case Old of 327 undefined -> 328 Ret; 329 Y -> 330 put(filename,Y), 331 Ret 332 end. 333 334add_record_definition({Name,FieldList}) -> 335 {KeyList,_} = lists:foldl( 336 fun(F, {L,C}) -> {[record_field(F, C)|L],C+1} end, 337 {[],2}, 338 FieldList), 339 put_records([{Name,KeyList}|get_records()]). 340 341record_field({record_field,_,{atom,Anno0,FieldName}}, C) -> 342 {FieldName,C,{atom,Anno0,undefined}}; 343record_field({record_field,_,{atom,_,FieldName},Def}, C) -> 344 {FieldName,C,Def}; 345record_field({typed_record_field,Field,_Type}, C) -> 346 record_field(Field, C). 347 348forms(Forms0) -> 349 put(records_replaced_by_tuples, []), 350 try 351 Forms = [form(F) || F <- Forms0], 352 %% Add `-compile({nowarn_unused_record, RecordNames}).', where 353 %% RecordNames is the names of all records replaced by tuples, 354 %% in order to silence the code linter's warnings about unused 355 %% records. 356 case get(records_replaced_by_tuples) of 357 [] -> 358 Forms; 359 RNames -> 360 NoWarn = {nowarn_unused_record,[lists:usort(RNames)]}, 361 [{attribute,erl_anno:new(0),compile,NoWarn}] ++ Forms 362 end 363 after 364 erase(records_replaced_by_tuples) 365 end. 366 367form({attribute,_,file,{Filename,_}}=Form) -> 368 put_filename(Filename), 369 Form; 370form({attribute,_,record,Definition}=Form) -> 371 add_record_definition(Definition), 372 Form; 373form({function,Anno,Name0,Arity0,Clauses0}) -> 374 {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0), 375 {function,Anno,Name,Arity,Clauses}; 376form(AnyOther) -> 377 AnyOther. 378 379function(Name, Arity, Clauses0) -> 380 Clauses1 = clauses(Clauses0), 381 {Name,Arity,Clauses1}. 382 383clauses([C0|Cs]) -> 384 C1 = clause(C0,gb_sets:new()), 385 C2 = clauses(Cs), 386 [C1|C2]; 387clauses([]) -> []. 388 389clause({clause,Anno,H0,G0,B0},Bound) -> 390 {H1,Bound1} = copy(H0,Bound), 391 {B1,_Bound2} = copy(B0,Bound1), 392 {clause,Anno,H1,G0,B1}. 393 394copy({call,Anno,{remote,_Anno2,{atom,_Anno3,ets},{atom,_Anno4,fun2ms}}, 395 As0},Bound) -> 396 {transform_call(ets,Anno,As0,Bound),Bound}; 397copy({call,Anno,{remote,_Anno2,{atom,_Anno3,dbg},{atom,_Anno4,fun2ms}}, 398 As0},Bound) -> 399 {transform_call(dbg,Anno,As0,Bound),Bound}; 400copy({match,Anno,A,B},Bound) -> 401 {B1,Bound1} = copy(B,Bound), 402 {A1,Bound2} = copy(A,Bound), 403 {{match,Anno,A1,B1},gb_sets:union(Bound1,Bound2)}; 404copy({var,_Anno,'_'} = VarDef,Bound) -> 405 {VarDef,Bound}; 406copy({var,_Anno,Name} = VarDef,Bound) -> 407 Bound1 = gb_sets:add(Name,Bound), 408 {VarDef,Bound1}; 409copy({'fun',Anno,{clauses,Clauses}},Bound) -> % Dont export bindings from funs 410 {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound), 411 {{'fun',Anno,{clauses,NewClauses}},Bound}; 412copy({named_fun,Anno,Name,Clauses},Bound) -> % Dont export bindings from funs 413 Bound1 = case Name of 414 '_' -> Bound; 415 Name -> gb_sets:add(Name,Bound) 416 end, 417 {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound1), 418 {{named_fun,Anno,Name,NewClauses},Bound}; 419copy({'case',Anno,Of,ClausesList},Bound) -> % Dont export bindings from funs 420 {NewOf,NewBind0} = copy(Of,Bound), 421 {NewClausesList,NewBindings} = copy_case_clauses(ClausesList,NewBind0,[]), 422 {{'case',Anno,NewOf,NewClausesList},NewBindings}; 423copy(T,Bound) when is_tuple(T) -> 424 {L,Bound1} = copy_list(tuple_to_list(T),Bound), 425 {list_to_tuple(L),Bound1}; 426copy(L,Bound) when is_list(L) -> 427 copy_list(L,Bound); 428copy(AnyOther,Bound) -> 429 {AnyOther,Bound}. 430 431copy_case_clauses([],Bound,AddSets) -> 432 ReallyAdded = gb_sets:intersection(AddSets), 433 {[],gb_sets:union(Bound,ReallyAdded)}; 434copy_case_clauses([{clause,Anno,Match,Guard,Clauses}|T],Bound,AddSets) -> 435 {NewMatch,MatchBinds} = copy(Match,Bound), 436 {NewGuard,GuardBinds} = copy(Guard,MatchBinds), %% Really no new binds 437 {NewClauses,AllBinds} = copy(Clauses,GuardBinds), 438 %% To limit the setsizes, I subtract what I had before the case clause 439 %% and add it in the end 440 AddedBinds = gb_sets:subtract(AllBinds,Bound), 441 {NewTail,ExportedBindings} = 442 copy_case_clauses(T,Bound,[AddedBinds | AddSets]), 443 {[{clause,Anno,NewMatch,NewGuard,NewClauses}|NewTail],ExportedBindings}. 444 445copy_list([H|T],Bound) -> 446 {C1,Bound1} = copy(H,Bound), 447 {C2,Bound2} = copy_list(T,Bound1), 448 {[C1|C2],Bound2}; 449copy_list([],Bound) -> 450 {[],Bound}. 451 452transform_call(Type,_Anno,[{'fun',Anno2,{clauses, ClauseList}}],Bound) -> 453 ms_clause_list(Anno2, ClauseList,Type,Bound); 454transform_call(_Type,Anno,_NoAbstractFun,_) -> 455 throw({error,Anno,?ERR_NOFUN}). 456 457% Fixup semicolons in guards 458ms_clause_expand({clause, Anno, Parameters, Guard = [_,_|_], Body}) -> 459 [ {clause, Anno, Parameters, [X], Body} || X <- Guard ]; 460ms_clause_expand(_Other) -> 461 false. 462 463ms_clause_list(Anno,[H|T],Type,Bound) -> 464 case ms_clause_expand(H) of 465 NewHead when is_list(NewHead) -> 466 ms_clause_list(Anno,NewHead ++ T, Type, Bound); 467 false -> 468 {cons, Anno, ms_clause(H, Type, Bound), 469 ms_clause_list(Anno, T, Type, Bound)} 470 end; 471ms_clause_list(Anno,[],_,_) -> 472 {nil,Anno}. 473ms_clause({clause, Anno, Parameters, Guards, Body},Type,Bound) -> 474 check_type(Anno,Parameters,Type), 475 {MSHead,Bindings} = transform_head(Parameters,Bound), 476 MSGuards = transform_guards(Anno, Guards, Bindings), 477 MSBody = transform_body(Anno,Body,Bindings), 478 {tuple, Anno, [MSHead,MSGuards,MSBody]}. 479 480 481check_type(_,[{var,_,_}],_) -> 482 ok; 483check_type(_,[{tuple,_,_}],ets) -> 484 ok; 485check_type(_,[{record,_,_,_}],ets) -> 486 ok; 487check_type(_,[{cons,_,_,_}],dbg) -> 488 ok; 489check_type(_,[{nil,_}],dbg) -> 490 ok; 491check_type(Anno0,[{match,_,{var,_,_},X}],Any) -> 492 check_type(Anno0,[X],Any); 493check_type(Anno0,[{match,_,X,{var,_,_}}],Any) -> 494 check_type(Anno0,[X],Any); 495check_type(Anno,_Type,ets) -> 496 throw({error,Anno,?ERR_ETS_HEAD}); 497check_type(Anno,_,dbg) -> 498 throw({error,Anno,?ERR_DBG_HEAD}). 499 500-record(tgd,{ b, %Bindings 501 p, %Part of spec 502 eb %Error code base, 0 for guards, 100 for bodies 503 }). 504 505transform_guards(Anno,[],_Bindings) -> 506 {nil,Anno}; 507transform_guards(Anno,[G],Bindings) -> 508 B = #tgd{b = Bindings, p = guard, eb = ?ERROR_BASE_GUARD}, 509 tg0(Anno,G,B); 510transform_guards(Anno,_,_) -> 511 throw({error,Anno,?ERR_SEMI_GUARD}). 512 513transform_body(Anno,Body,Bindings) -> 514 B = #tgd{b = Bindings, p = body, eb = ?ERROR_BASE_BODY}, 515 tg0(Anno,Body,B). 516 517 518guard_top_trans({call,Anno0,{atom,Anno1,OldTest},Params}) -> 519 case old_bool_test(OldTest,length(Params)) of 520 undefined -> 521 {call,Anno0,{atom,Anno1,OldTest},Params}; 522 Trans -> 523 {call,Anno0,{atom,Anno1,Trans},Params} 524 end; 525guard_top_trans(Else) -> 526 Else. 527 528tg0(Anno,[],_) -> 529 {nil,Anno}; 530tg0(Anno,[H0|T],B) when B#tgd.p =:= guard -> 531 H = guard_top_trans(H0), 532 {cons,Anno, tg(H,B), tg0(Anno,T,B)}; 533tg0(Anno,[H|T],B) -> 534 {cons,Anno, tg(H,B), tg0(Anno,T,B)}. 535 536 537tg({match,Anno,_,_},B) -> 538 throw({error,Anno,?ERR_GENMATCH+B#tgd.eb}); 539tg({op, Anno, Operator, O1, O2}=Expr, B) -> 540 case erl_eval:partial_eval(Expr) of 541 Expr -> 542 {tuple, Anno, [{atom, Anno, Operator}, tg(O1, B), tg(O2, B)]}; 543 Value -> 544 Value 545 end; 546tg({op, Anno, Operator, O1}=Expr, B) -> 547 case erl_eval:partial_eval(Expr) of 548 Expr -> 549 {tuple, Anno, [{atom, Anno, Operator}, tg(O1, B)]}; 550 Value -> 551 Value 552 end; 553tg({call, _Anno, {atom, Anno2, bindings},[]},_B) -> 554 {atom, Anno2, '$*'}; 555tg({call, _Anno, {atom, Anno2, object},[]},_B) -> 556 {atom, Anno2, '$_'}; 557tg({call, Anno, {atom, _, is_record}=Call,[Object, {atom,Anno3,RName}=R]},B) -> 558 MSObject = tg(Object,B), 559 case get_record(RName) of 560 FieldList when is_list(FieldList) -> 561 RSize = length(FieldList)+1, 562 {tuple, Anno, [Call, MSObject, R, {integer, Anno3, RSize}]}; 563 not_found -> 564 throw({error,Anno3,{?ERR_GENBADREC+B#tgd.eb,RName}}) 565 end; 566tg({call, Anno, {atom, Anno2, FunName},ParaList},B) -> 567 case is_ms_function(FunName,length(ParaList), B#tgd.p) of 568 true -> 569 {tuple, Anno, [{atom, Anno2, FunName} | 570 lists:map(fun(X) -> tg(X,B) end, ParaList)]}; 571 _ -> 572 throw({error,Anno,{?ERR_GENLOCALCALL+B#tgd.eb, 573 FunName,length(ParaList)}}) 574 end; 575tg({call, Anno, {remote,_,{atom,_,erlang},{atom, Anno2, FunName}},ParaList}, 576 B) -> 577 L = length(ParaList), 578 case is_imported_from_erlang(FunName,L,B#tgd.p) of 579 true -> 580 case is_operator(FunName,L,B#tgd.p) of 581 false -> 582 tg({call, Anno, {atom, Anno2, FunName},ParaList},B); 583 true -> 584 tg(list_to_tuple([op,Anno2,FunName | ParaList]),B) 585 end; 586 _ -> 587 throw({error,Anno,{?ERR_GENREMOTECALL+B#tgd.eb,erlang, 588 FunName,length(ParaList)}}) 589 end; 590tg({call, Anno, {remote,_,{atom,_,ModuleName}, 591 {atom, _, FunName}},ParaList},B) -> 592 throw({error,Anno,{?ERR_GENREMOTECALL+B#tgd.eb,ModuleName,FunName,length(ParaList)}}); 593tg({cons,Anno, H, T},B) -> 594 {cons, Anno, tg(H,B), tg(T,B)}; 595tg({nil, Anno},_B) -> 596 {nil, Anno}; 597tg({tuple,Anno,L},B) -> 598 {tuple,Anno,[{tuple,Anno,lists:map(fun(X) -> tg(X,B) end, L)}]}; 599tg({integer,Anno,I},_) -> 600 {integer,Anno,I}; 601tg({char,Anno,C},_) -> 602 {char,Anno,C}; 603tg({float, Anno,F},_) -> 604 {float,Anno,F}; 605tg({atom,Anno,A},_) -> 606 case atom_to_list(A) of 607 [$$|_] -> 608 {tuple, Anno,[{atom, Anno, 'const'},{atom,Anno,A}]}; 609 _ -> 610 {atom,Anno,A} 611 end; 612tg({string,Anno,S},_) -> 613 {string,Anno,S}; 614tg({var,Anno,VarName},B) -> 615 case lkup_bind(VarName, B#tgd.b) of 616 undefined -> 617 {tuple, Anno,[{atom, Anno, 'const'},{var,Anno,VarName}]}; 618 AtomName -> 619 {atom, Anno, AtomName} 620 end; 621tg({record_field,Anno,Object,RName,{atom,_Anno1,KeyName}},B) -> 622 case get_record(RName) of 623 FieldList when is_list(FieldList) -> 624 case lists:keysearch(KeyName,1, FieldList) of 625 {value, {KeyName,Position,_}} -> 626 NewObject = tg(Object,B), 627 {tuple, Anno, [{atom, Anno, 'element'}, 628 {integer, Anno, Position}, NewObject]}; 629 _ -> 630 throw({error,Anno,{?ERR_GENBADFIELD+B#tgd.eb, RName, 631 KeyName}}) 632 end; 633 not_found -> 634 throw({error,Anno,{?ERR_GENBADREC+B#tgd.eb,RName}}) 635 end; 636 637tg({record,Anno,RName,RFields},B) -> 638 KeyList0 = lists:foldl(fun({record_field,_,{atom,_,Key},Value}, 639 L) -> 640 NV = tg(Value,B), 641 [{Key,NV}|L]; 642 ({record_field,_,{var,_,'_'},Value}, 643 L) -> 644 NV = tg(Value,B), 645 [{{default},NV}|L]; 646 (_,_) -> 647 throw({error,Anno, 648 {?ERR_GENBADREC+B#tgd.eb, 649 RName}}) 650 end, 651 [], 652 RFields), 653 DefValue = case lists:keysearch({default},1,KeyList0) of 654 {value,{{default},OverriddenDefValue}} -> 655 {true,OverriddenDefValue}; 656 _ -> 657 false 658 end, 659 KeyList = lists:keydelete({default},1,KeyList0), 660 case lists:keysearch({default},1,KeyList) of 661 {value,{{default},_}} -> 662 throw({error,Anno,{?ERR_GENMULTIFIELD+B#tgd.eb,RName,'_'}}); 663 _ -> 664 ok 665 end, 666 case get_record(RName) of 667 FieldList0 when is_list(FieldList0) -> 668 FieldList1 = lists:foldl( 669 fun({FN,_,Def},Acc) -> 670 El = case lists:keysearch(FN,1,KeyList) of 671 {value, {FN, X0}} -> 672 X0; 673 _ -> 674 case DefValue of 675 {true,Overridden} -> 676 Overridden; 677 false -> 678 Def 679 end 680 end, 681 [El | Acc] 682 end, 683 [], 684 FieldList0), 685 check_multi_field(RName,Anno,KeyList, 686 ?ERR_GENMULTIFIELD+B#tgd.eb), 687 check_undef_field(RName,Anno,KeyList,FieldList0, 688 ?ERR_GENBADFIELD+B#tgd.eb), 689 {tuple,Anno,[{tuple,Anno,[{atom,Anno,RName}|FieldList1]}]}; 690 not_found -> 691 throw({error,Anno,{?ERR_GENBADREC+B#tgd.eb,RName}}) 692 end; 693 694tg({record_index,Anno,RName,{atom,Anno2,KeyName}},B) -> 695 case get_record(RName) of 696 FieldList when is_list(FieldList) -> 697 case lists:keysearch(KeyName,1, FieldList) of 698 {value, {KeyName,Position,_}} -> 699 {integer, Anno2, Position}; 700 _ -> 701 throw({error,Anno2,{?ERR_GENBADFIELD+B#tgd.eb, RName, 702 KeyName}}) 703 end; 704 not_found -> 705 throw({error,Anno,{?ERR_GENBADREC+B#tgd.eb,RName}}) 706 end; 707 708tg({record,Anno,{var,Anno2,_VName}=AVName, RName,RFields},B) -> 709 MSVName = tg(AVName,B), 710 KeyList = lists:foldl(fun({record_field,_,{atom,_,Key},Value}, 711 L) -> 712 NV = tg(Value,B), 713 [{Key,NV}|L]; 714 (_,_) -> 715 throw({error,Anno,?ERR_HEADBADREC}) 716 end, 717 [], 718 RFields), 719 case get_record(RName) of 720 FieldList0 when is_list(FieldList0) -> 721 FieldList1 = lists:foldl( 722 fun({FN,Pos,_},Acc) -> 723 El = case lists:keysearch(FN,1,KeyList) of 724 {value, {FN, X0}} -> 725 X0; 726 _ -> 727 {tuple, Anno2, 728 [{atom, Anno2, element}, 729 {integer, Anno2, Pos}, 730 MSVName]} 731 end, 732 [El | Acc] 733 end, 734 [], 735 FieldList0), 736 check_multi_field(RName,Anno,KeyList, 737 ?ERR_GENMULTIFIELD+B#tgd.eb), 738 check_undef_field(RName,Anno,KeyList,FieldList0, 739 ?ERR_GENBADFIELD+B#tgd.eb), 740 {tuple,Anno,[{tuple,Anno,[{atom,Anno,RName}|FieldList1]}]}; 741 not_found -> 742 throw({error,Anno,{?ERR_GENBADREC+B#tgd.eb,RName}}) 743 end; 744 745tg({bin_element,_Anno0,{var, Anno, A},_,_} = Whole,B) -> 746 case lkup_bind(A, B#tgd.b) of 747 undefined -> 748 Whole; % exists in environment hopefully 749 _AtomName -> 750 throw({error,Anno,{?ERR_GENBINCONSTRUCT+B#tgd.eb,A}}) 751 end; 752tg(default,_B) -> 753 default; 754tg({bin_element,Anno,X,Y,Z},B) -> 755 {bin_element, Anno, tg(X,B), tg(Y,B), Z}; 756 757tg({bin,Anno,List},B) -> 758 {bin,Anno,[tg(X,B) || X <- List]}; 759 760tg(T,B) when is_tuple(T), tuple_size(T) >= 2 -> 761 Element = element(1,T), 762 Anno = element(2,T), 763 throw({error,Anno,{?ERR_GENELEMENT+B#tgd.eb, 764 translate_language_element(Element)}}); 765tg(Other,B) -> 766 Element = io_lib:format("unknown element ~tw", [Other]), 767 throw({error,erl_anno:new(0),{?ERR_GENELEMENT+B#tgd.eb,Element}}). 768 769transform_head([V],OuterBound) -> 770 Bind = cre_bind(), 771 {NewV,NewBind} = toplevel_head_match(V,Bind,OuterBound), 772 th(NewV,NewBind,OuterBound). 773 774 775toplevel_head_match({match,_,{var,Anno,VName},Expr},B,OB) -> 776 warn_var_clash(Anno,VName,OB), 777 {Expr,new_bind({VName,'$_'},B)}; 778toplevel_head_match({match,_,Expr,{var,Anno,VName}},B,OB) -> 779 warn_var_clash(Anno,VName,OB), 780 {Expr,new_bind({VName,'$_'},B)}; 781toplevel_head_match(Other,B,_OB) -> 782 {Other,B}. 783 784th({record,Anno,RName,RFields},B,OB) -> 785 % youch... 786 {KeyList0,NewB} = lists:foldl(fun({record_field,_,{atom,_,Key},Value}, 787 {L,B0}) -> 788 {NV,B1} = th(Value,B0,OB), 789 {[{Key,NV}|L],B1}; 790 ({record_field,_,{var,_,'_'},Value}, 791 {L,B0}) -> 792 {NV,B1} = th(Value,B0,OB), 793 {[{{default},NV}|L],B1}; 794 (_,_) -> 795 throw({error,Anno,{?ERR_HEADBADREC, 796 RName}}) 797 end, 798 {[],B}, 799 RFields), 800 DefValue = case lists:keysearch({default},1,KeyList0) of 801 {value,{{default},OverriddenDefValue}} -> 802 OverriddenDefValue; 803 _ -> 804 {atom,Anno,'_'} 805 end, 806 KeyList = lists:keydelete({default},1,KeyList0), 807 case lists:keysearch({default},1,KeyList) of 808 {value,{{default},_}} -> 809 throw({error,Anno,{?ERR_HEADMULTIFIELD,RName,'_'}}); 810 _ -> 811 ok 812 end, 813 case get_record(RName) of 814 FieldList0 when is_list(FieldList0) -> 815 FieldList1 = lists:foldl( 816 fun({FN,_,_},Acc) -> 817 El = case lists:keysearch(FN,1,KeyList) of 818 {value, {FN, X0}} -> 819 X0; 820 _ -> 821 DefValue 822 end, 823 [El | Acc] 824 end, 825 [], 826 FieldList0), 827 check_multi_field(RName,Anno,KeyList, 828 ?ERR_HEADMULTIFIELD), 829 check_undef_field(RName,Anno,KeyList,FieldList0, 830 ?ERR_HEADBADFIELD), 831 {{tuple,Anno,[{atom,Anno,RName}|FieldList1]},NewB}; 832 not_found -> 833 throw({error,Anno,{?ERR_HEADBADREC,RName}}) 834 end; 835th({match,Anno,_,_},_,_) -> 836 throw({error,Anno,?ERR_HEADMATCH}); 837th({atom,Anno,A},B,_OB) -> 838 case atom_to_list(A) of 839 [$$|NL] -> 840 case (catch list_to_integer(NL)) of 841 N when is_integer(N) -> 842 throw({error,Anno,{?ERR_HEADDOLLARATOM,A}}); 843 _ -> 844 {{atom,Anno,A},B} 845 end; 846 _ -> 847 {{atom,Anno,A},B} 848 end; 849th({bin_element,_Anno0,{var, Anno, A},_,_},_,_) -> 850 throw({error,Anno,{?ERR_HEADBINMATCH,A}}); 851 852th({var,Anno,Name},B,OB) -> 853 warn_var_clash(Anno,Name,OB), 854 case lkup_bind(Name,B) of 855 undefined -> 856 NewB = new_bind(Name,B), 857 {{atom,Anno,lkup_bind(Name,NewB)},NewB}; 858 Trans -> 859 {{atom,Anno,Trans},B} 860 end; 861th([H|T],B,OB) -> 862 {NH,NB} = th(H,B,OB), 863 {NT,NNB} = th(T,NB,OB), 864 {[NH|NT],NNB}; 865th(T,B,OB) when is_tuple(T) -> 866 {L,NB} = th(tuple_to_list(T),B,OB), 867 {list_to_tuple(L),NB}; 868th(Nonstruct,B,_OB) -> 869 {Nonstruct,B}. 870 871warn_var_clash(Anno,Name,OuterBound) -> 872 case gb_sets:is_member(Name,OuterBound) of 873 true -> 874 Location = erl_anno:location(Anno), 875 add_warning(Location,{?WARN_SHADOW_VAR,Name}); 876 _ -> 877 ok 878 end. 879 880%% Could be more efficient... 881check_multi_field(_, _, [], _) -> 882 ok; 883check_multi_field(RName, Anno, [{Key,_}|T], ErrCode) -> 884 case lists:keymember(Key,1,T) of 885 true -> 886 throw({error,Anno,{ErrCode,RName,Key}}); 887 false -> 888 check_multi_field(RName, Anno, T, ErrCode) 889 end. 890check_undef_field(_, _, [], _, _) -> 891 ok; 892check_undef_field(RName, Anno, [{Key,_}|T], FieldList, ErrCode) -> 893 case lists:keymember(Key, 1, FieldList) of 894 true -> 895 check_undef_field(RName, Anno, T, FieldList, ErrCode); 896 false -> 897 throw({error,Anno,{ErrCode,RName,Key}}) 898 end. 899 900cre_bind() -> 901 {1,[{'_','_'}]}. 902 903lkup_bind(Name,{_,List}) -> 904 case lists:keysearch(Name,1,List) of 905 {value, {Name, Trans}} -> 906 Trans; 907 _ -> 908 undefined 909 end. 910 911new_bind({Name,Trans},{Next,L}) -> 912 {Next,[{Name,Trans}|L]}; 913new_bind(Name,{Next,L}) -> 914 Trans = list_to_atom([$$|integer_to_list(Next)]), 915 {Next+1,[{Name,Trans}|L]}. 916 917translate_language_element(Atom) -> 918 Transtab = [ 919 {lc,"list comprehension"}, 920 {bc,"binary comprehension"}, 921 {block, "begin/end block"}, 922 {'if', "if"}, 923 {'case', "case"}, 924 {'receive', "receive"}, 925 {'try', "try"}, 926 {'catch', "catch"}, 927 {'match', "match (=)"}, 928 {remote, "external function call"} 929 ], 930 case lists:keysearch(Atom,1,Transtab) of 931 {value,{Atom, String}} -> 932 String; 933 _ -> 934 atom_to_list(Atom) 935 end. 936 937old_bool_test(atom,1) -> is_atom; 938old_bool_test(float,1) -> is_float; 939old_bool_test(integer,1) -> is_integer; 940old_bool_test(list,1) -> is_list; 941old_bool_test(number,1) -> is_number; 942old_bool_test(pid,1) -> is_pid; 943old_bool_test(port,1) -> is_port; 944old_bool_test(reference,1) -> is_reference; 945old_bool_test(tuple,1) -> is_tuple; 946old_bool_test(binary,1) -> is_binary; 947old_bool_test(function,1) -> is_function; 948old_bool_test(record,2) -> is_record; 949old_bool_test(_,_) -> undefined. 950 951bool_test(is_atom,1) -> true; 952bool_test(is_float,1) -> true; 953bool_test(is_integer,1) -> true; 954bool_test(is_list,1) -> true; 955bool_test(is_number,1) -> true; 956bool_test(is_pid,1) -> true; 957bool_test(is_port,1) -> true; 958bool_test(is_reference,1) -> true; 959bool_test(is_tuple,1) -> true; 960bool_test(is_map,1) -> true; 961bool_test(is_map_key, 2) -> true; 962bool_test(is_binary,1) -> true; 963bool_test(is_function,1) -> true; 964bool_test(is_record,2) -> true; 965bool_test(is_seq_trace,0) -> true; 966bool_test(_,_) -> false. 967 968real_guard_function(abs,1) -> true; 969real_guard_function(element,2) -> true; 970real_guard_function(hd,1) -> true; 971real_guard_function(length,1) -> true; 972real_guard_function(node,0) -> true; 973real_guard_function(node,1) -> true; 974real_guard_function(round,1) -> true; 975real_guard_function(size,1) -> true; 976real_guard_function(bit_size,1) -> true; 977real_guard_function(map_size,1) -> true; 978real_guard_function(map_get,2) -> true; 979real_guard_function(tl,1) -> true; 980real_guard_function(trunc,1) -> true; 981real_guard_function(self,0) -> true; 982real_guard_function(float,1) -> true; 983real_guard_function(_,_) -> false. 984 985pseudo_guard_function(get_tcw,0) -> true; 986pseudo_guard_function(_,_) -> false. 987 988guard_function(X,A) -> 989 real_guard_function(X,A) or pseudo_guard_function(X,A). 990 991action_function(set_seq_token,2) -> true; 992action_function(get_seq_token,0) -> true; 993action_function(message,1) -> true; 994action_function(return_trace,0) -> true; 995action_function(exception_trace,0) -> true; 996action_function(process_dump,0) -> true; 997action_function(enable_trace,1) -> true; 998action_function(enable_trace,2) -> true; 999action_function(disable_trace,1) -> true; 1000action_function(disable_trace,2) -> true; 1001action_function(display,1) -> true; 1002action_function(caller,0) -> true; 1003action_function(set_tcw,1) -> true; 1004action_function(silent,1) -> true; 1005action_function(trace,2) -> true; 1006action_function(trace,3) -> true; 1007action_function(_,_) -> false. 1008 1009bool_operator('and',2) -> 1010 true; 1011bool_operator('or',2) -> 1012 true; 1013bool_operator('xor',2) -> 1014 true; 1015bool_operator('not',1) -> 1016 true; 1017bool_operator('andalso',2) -> 1018 true; 1019bool_operator('orelse',2) -> 1020 true; 1021bool_operator(_,_) -> 1022 false. 1023 1024arith_operator('+',1) -> 1025 true; 1026arith_operator('+',2) -> 1027 true; 1028arith_operator('-',1) -> 1029 true; 1030arith_operator('-',2) -> 1031 true; 1032arith_operator('*',2) -> 1033 true; 1034arith_operator('/',2) -> 1035 true; 1036arith_operator('div',2) -> 1037 true; 1038arith_operator('rem',2) -> 1039 true; 1040arith_operator('band',2) -> 1041 true; 1042arith_operator('bor',2) -> 1043 true; 1044arith_operator('bxor',2) -> 1045 true; 1046arith_operator('bnot',1) -> 1047 true; 1048arith_operator('bsl',2) -> 1049 true; 1050arith_operator('bsr',2) -> 1051 true; 1052arith_operator(_,_) -> 1053 false. 1054 1055cmp_operator('>',2) -> 1056 true; 1057cmp_operator('>=',2) -> 1058 true; 1059cmp_operator('<',2) -> 1060 true; 1061cmp_operator('=<',2) -> 1062 true; 1063cmp_operator('==',2) -> 1064 true; 1065cmp_operator('=:=',2) -> 1066 true; 1067cmp_operator('/=',2) -> 1068 true; 1069cmp_operator('=/=',2) -> 1070 true; 1071cmp_operator(_,_) -> 1072 false. 1073 1074is_operator(X,A,_) -> 1075 bool_operator(X,A) or arith_operator(X,A) or cmp_operator(X,A). 1076 1077is_imported_from_erlang(X,A,_) -> 1078 real_guard_function(X,A) or bool_test(X,A) or bool_operator(X,A) or 1079 arith_operator(X,A) or cmp_operator(X,A). 1080 1081is_ms_function(X,A,body) -> 1082 action_function(X,A) or guard_function(X,A) or bool_test(X,A); 1083 1084is_ms_function(X,A,guard) -> 1085 guard_function(X,A) or bool_test(X,A). 1086 1087fixup_environment(L,B) when is_list(L) -> 1088 lists:map(fun(X) -> 1089 fixup_environment(X,B) 1090 end, 1091 L); 1092fixup_environment({var,Anno,Name},B) -> 1093 case lists:keysearch(Name,1,B) of 1094 {value,{Name,Value}} -> 1095 freeze(Anno,Value); 1096 _ -> 1097 throw({error,Anno,{?ERR_UNBOUND_VARIABLE,atom_to_list(Name)}}) 1098 end; 1099fixup_environment(T,B) when is_tuple(T) -> 1100 list_to_tuple( 1101 lists:map(fun(X) -> 1102 fixup_environment(X,B) 1103 end, 1104 tuple_to_list(T))); 1105fixup_environment(Other,_B) -> 1106 Other. 1107 1108freeze(Anno,Term) -> 1109 {frozen,Anno,Term}. 1110 1111%% Most of this is bluntly stolen from erl_parse. 1112 1113normalise({frozen,_,Term}) -> 1114 Term; 1115normalise({char,_,C}) -> C; 1116normalise({integer,_,I}) -> I; 1117normalise({float,_,F}) -> F; 1118normalise({atom,_,A}) -> A; 1119normalise({string,_,S}) -> S; 1120normalise({nil,_}) -> []; 1121normalise({bin,_,Fs}) -> 1122 {value, B, _} = 1123 eval_bits:expr_grp(Fs, [], 1124 fun(E, _) -> 1125 {value, normalise(E), []} 1126 end, [], true), 1127 B; 1128normalise({cons,_,Head,Tail}) -> 1129 [normalise(Head)|normalise(Tail)]; 1130normalise({op,_,'++',A,B}) -> 1131 normalise(A) ++ normalise(B); 1132normalise({tuple,_,Args}) -> 1133 list_to_tuple(normalise_list(Args)); 1134normalise({map,_,Pairs0}) -> 1135 Pairs1 = lists:map(fun ({map_field_exact,_,K,V}) -> 1136 {normalise(K),normalise(V)} 1137 end, 1138 Pairs0), 1139 maps:from_list(Pairs1); 1140%% Special case for unary +/-. 1141normalise({op,_,'+',{char,_,I}}) -> I; 1142normalise({op,_,'+',{integer,_,I}}) -> I; 1143normalise({op,_,'+',{float,_,F}}) -> F; 1144normalise({op,_,'-',{char,_,I}}) -> -I; % Weird, but compatible! 1145normalise({op,_,'-',{integer,_,I}}) -> -I; 1146normalise({op,_,'-',{float,_,F}}) -> -F. 1147 1148normalise_list([H|T]) -> 1149 [normalise(H)|normalise_list(T)]; 1150normalise_list([]) -> 1151 []. 1152