1%% -*- erlang-indent-level: 4;indent-tabs-mode: nil -*- 2%% -------------------------------------------------- 3%% This file is provided to you under the Apache License, 4%% Version 2.0 (the "License"); you may not use this file 5%% except in compliance with the License. You may obtain 6%% a copy of the License at 7%% 8%% http://www.apache.org/licenses/LICENSE-2.0 9%% 10%% Unless required by applicable law or agreed to in writing, 11%% software distributed under the License is distributed on an 12%% "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 13%% KIND, either express or implied. See the License for the 14%% specific language governing permissions and limitations 15%% under the License. 16%% -------------------------------------------------- 17%% File : exprecs.erl 18%% @author : Ulf Wiger <ulf@wiger.net> 19%% @end 20%% Description : 21%% 22%% Created : 13 Feb 2006 by Ulf Wiger <ulf@wiger.net> 23%% Rewritten: Jan-Feb 2010 by Ulf Wiger <ulf@wiger.net> 24%%------------------------------------------------------------------- 25 26%% @doc Parse transform for generating record access functions. 27%% <p>This parse transform can be used to reduce compile-time 28%% dependencies in large systems.</p> 29%% <p>In the old days, before records, Erlang programmers often wrote 30%% access functions for tuple data. This was tedious and error-prone. 31%% The record syntax made this easier, but since records were implemented 32%% fully in the pre-processor, a nasty compile-time dependency was 33%% introduced.</p> 34%% <p>This module automates the generation of access functions for 35%% records. While this method cannot fully replace the utility of 36%% pattern matching, it does allow a fair bit of functionality on 37%% records without the need for compile-time dependencies.</p> 38%% <p>Whenever record definitions need to be exported from a module, 39%% inserting a compiler attribute, 40%% <code>export_records([RecName|...])</code> causes this transform 41%% to lay out access functions for the exported records:</p> 42%% 43%% As an example, consider the following module: 44%% <pre lang="erlang"> 45%% -module(test_exprecs). 46%% 47%% -record(r,{a = 0 :: integer(),b = 0 :: integer(),c = 0 :: integer()}). 48%% -record(s,{a}). 49%% -record(t,{}). 50%% 51%% -export_records([r,s,t]). 52%% 53%% -export_type(['#prop-r'/0, 54%% '#attr-r'/0, 55%% '#prop-s'/0, 56%% '#attr-s'/0, 57%% '#prop-t'/0, 58%% '#attr-t'/0]). 59%% 60%% -type '#prop-s'() :: {a, any()}. 61%% 62%% -type '#attr-s'() :: a. 63%% 64%% -type '#prop-r'() :: {a, any()} | {b, any()} | {c, any()}. 65%% 66%% -type '#attr-r'() :: a | b | c. 67%% 68%% -type '#prop-t'() :: any(). 69%% 70%% -type '#attr-t'() :: any(). 71%% 72%% -spec '#exported_records-'() -> [r | s | t]. 73%% 74%% -spec '#new-'(r) -> #r{}; 75%% (s) -> #s{}; 76%% (t) -> #t{}. 77%% 78%% -spec '#info-'(r) -> ['#attr-r'()]; 79%% (s) -> ['#attr-s'()]; 80%% (t) -> ['#attr-t'()]. 81%% 82%% -spec '#info-'(r, size) -> 4; 83%% (r, fields) -> ['#attr-r'()]; 84%% (s, size) -> 2; 85%% (s, fields) -> ['#attr-s'()]; 86%% (t, size) -> 1; 87%% (t, fields) -> ['#attr-t'()]. 88%% 89%% -spec '#pos-'(r, a) -> 1; 90%% (r, b) -> 2; 91%% (r, c) -> 3; 92%% (s, a) -> 1. 93%% 94%% -spec '#is_record-'(any()) -> boolean(). 95%% 96%% -spec '#is_record-'(any(), any()) -> boolean(). 97%% 98%% -spec '#get-'(a, #s{}) -> any(); 99%% (a, #r{}) -> any(); 100%% (b, #r{}) -> any(); 101%% (c, #r{}) -> any(); 102%% (['#attr-t'()], #t{}) -> []; 103%% (['#attr-s'()], #s{}) -> [any()]; 104%% (['#attr-r'()], #r{}) -> [any()]. 105%% 106%% -spec '#set-'(['#prop-r'()], #r{}) -> #r{}; 107%% (['#prop-s'()], #s{}) -> #s{}; 108%% (['#prop-t'()], #t{}) -> #t{}. 109%% 110%% -spec '#fromlist-'(['#prop-r'()], #r{}) -> #r{}; 111%% (['#prop-s'()], #s{}) -> #s{}; 112%% (['#prop-t'()], #t{}) -> #t{}. 113%% 114%% -spec '#frommap-'(#{a => any(), b => any(), c => any()}, #r{}) -> #r{}; 115%% (#{a => any()}, #s{}) -> #s{}; 116%% (#{}, #t{}) -> #t{}. 117%% 118%% -spec '#lens-'('#attr-r'(), r) -> 119%% {fun((#r{}) -> any()), fun((any(), #r{}) -> #r{})}; 120%% ('#attr-s'(), s) -> 121%% {fun((#s{}) -> any()), fun((any(), #s{}) -> #s{})}; 122%% ('#attr-t'(), t) -> 123%% {fun((#t{}) -> any()), fun((any(), #t{}) -> #t{})}. 124%% 125%% -spec '#new-r'() -> #r{}. 126%% 127%% -spec '#new-r'(['#prop-r'()]) -> #r{}. 128%% 129%% -spec '#get-r'(a, #r{}) -> any(); 130%% (b, #r{}) -> any(); 131%% (c, #r{}) -> any(); 132%% (['#attr-r'()], #r{}) -> [any()]. 133%% 134%% -spec '#set-r'(['#prop-r'()], #r{}) -> #r{}. 135%% 136%% -spec '#fromlist-r'(['#prop-r'()]) -> #r{}. 137%% 138%% -spec '#fromlist-r'(['#prop-r'()], #r{}) -> #r{}. 139%% 140%% -spec '#frommap-r'(#{a => any(), b => any(), c => any()}) -> #r{}. 141%% 142%% -spec '#frommap-r'(#{a => any(), b => any(), c => any()}, #r{}) -> #r{}. 143%% 144%% -spec '#pos-r'('#attr-r'() | atom()) -> integer(). 145%% 146%% -spec '#info-r'(fields) -> [a | b | c]; 147%% (size) -> 4. 148%% 149%% -spec '#lens-r'('#attr-r'()) -> 150%% {fun((#r{}) -> any()), fun((any(), #r{}) -> #r{})}. 151%% 152%% -spec '#new-s'() -> #s{}. 153%% 154%% -spec '#new-s'(['#prop-s'()]) -> #s{}. 155%% 156%% -spec '#get-s'(a, #s{}) -> any(); 157%% (['#attr-s'()], #s{}) -> [any()]. 158%% 159%% -spec '#set-s'(['#prop-s'()], #s{}) -> #s{}. 160%% 161%% -spec '#fromlist-s'(['#prop-s'()]) -> #s{}. 162%% 163%% -spec '#fromlist-s'(['#prop-s'()], #s{}) -> #s{}. 164%% 165%% -spec '#frommap-s'(#{a => any()}) -> #s{}. 166%% 167%% -spec '#frommap-s'(#{a => any()}, #s{}) -> #s{}. 168%% 169%% -spec '#pos-s'('#attr-s'() | atom()) -> integer(). 170%% 171%% -spec '#info-s'(fields) -> [a]; 172%% (size) -> 2. 173%% 174%% -spec '#lens-s'('#attr-s'()) -> 175%% {fun((#s{}) -> any()), fun((any(), #s{}) -> #s{})}. 176%% 177%% -spec '#new-t'() -> #t{}. 178%% 179%% -spec '#new-t'(['#prop-t'()]) -> #t{}. 180%% 181%% -spec '#get-t'(['#attr-t'()], #t{}) -> [any()]. 182%% 183%% -spec '#set-t'(['#prop-t'()], #t{}) -> #t{}. 184%% 185%% -spec '#fromlist-t'(['#prop-t'()]) -> #t{}. 186%% 187%% -spec '#fromlist-t'(['#prop-t'()], #t{}) -> #t{}. 188%% 189%% -spec '#frommap-t'(#{}) -> #t{}. 190%% 191%% -spec '#frommap-t'(#{}, #t{}) -> #t{}. 192%% 193%% -spec '#pos-t'('#attr-t'() | atom()) -> integer(). 194%% 195%% -spec '#info-t'(fields) -> []; 196%% (size) -> 1. 197%% 198%% -spec '#lens-t'('#attr-t'()) -> 199%% {fun((#t{}) -> any()), fun((any(), #t{}) -> #t{})}. 200%% 201%% -file("c:/git/etp/_checkouts/parse_trans/examples/test_exprecs.erl", 1). 202%% 203%% '#exported_records-'() -> 204%% [r,s,t]. 205%% 206%% '#new-'(r) -> 207%% '#new-r'(); 208%% '#new-'(s) -> 209%% '#new-s'(); 210%% '#new-'(t) -> 211%% '#new-t'(). 212%% 213%% '#info-'(RecName) -> 214%% '#info-'(RecName, fields). 215%% 216%% '#info-'(r, Info) -> 217%% '#info-r'(Info); 218%% '#info-'(s, Info) -> 219%% '#info-s'(Info); 220%% '#info-'(t, Info) -> 221%% '#info-t'(Info). 222%% 223%% '#pos-'(r, Attr) -> 224%% '#pos-r'(Attr); 225%% '#pos-'(s, Attr) -> 226%% '#pos-s'(Attr); 227%% '#pos-'(t, Attr) -> 228%% '#pos-t'(Attr). 229%% 230%% '#is_record-'(X) -> 231%% if 232%% is_record(X, r, 4) -> 233%% true; 234%% is_record(X, s, 2) -> 235%% true; 236%% is_record(X, t, 1) -> 237%% true; 238%% true -> 239%% false 240%% end. 241%% 242%% '#is_record-'(t, Rec) when tuple_size(Rec) == 1, element(1, Rec) == t -> 243%% true; 244%% '#is_record-'(s, Rec) when tuple_size(Rec) == 2, element(1, Rec) == s -> 245%% true; 246%% '#is_record-'(r, Rec) when tuple_size(Rec) == 4, element(1, Rec) == r -> 247%% true; 248%% '#is_record-'(_, _) -> 249%% false. 250%% 251%% '#get-'(Attrs, {r,_,_,_} = Rec) when true -> 252%% '#get-r'(Attrs, Rec); 253%% '#get-'(Attrs, {s,_} = Rec) when true -> 254%% '#get-s'(Attrs, Rec); 255%% '#get-'(Attrs, {t} = Rec) when true -> 256%% '#get-t'(Attrs, Rec). 257%% 258%% '#set-'(Vals, {r,_,_,_} = Rec) when true -> 259%% '#set-r'(Vals, Rec); 260%% '#set-'(Vals, {s,_} = Rec) when true -> 261%% '#set-s'(Vals, Rec); 262%% '#set-'(Vals, {t} = Rec) when true -> 263%% '#set-t'(Vals, Rec). 264%% 265%% '#fromlist-'(Vals, {r,_,_,_} = Rec) when true -> 266%% '#fromlist-r'(Vals, Rec); 267%% '#fromlist-'(Vals, {s,_} = Rec) when true -> 268%% '#fromlist-s'(Vals, Rec); 269%% '#fromlist-'(Vals, {t} = Rec) when true -> 270%% '#fromlist-t'(Vals, Rec). 271%% 272%% '#frommap-'(Vals, {r,_,_,_} = Rec) when true -> 273%% '#frommap-r'(Vals, Rec); 274%% '#frommap-'(Vals, {s,_} = Rec) when true -> 275%% '#frommap-s'(Vals, Rec); 276%% '#frommap-'(Vals, {t} = Rec) when true -> 277%% '#frommap-t'(Vals, Rec). 278%% 279%% '#lens-'(Attr, r) -> 280%% '#lens-r'(Attr); 281%% '#lens-'(Attr, s) -> 282%% '#lens-s'(Attr); 283%% '#lens-'(Attr, t) -> 284%% '#lens-t'(Attr). 285%% 286%% '#new-r'() -> 287%% {r,0,0,0}. 288%% 289%% '#new-r'(Vals) -> 290%% '#set-r'(Vals, {r,0,0,0}). 291%% 292%% '#get-r'(Attrs, R) when is_list(Attrs) -> 293%% [ 294%% '#get-r'(A, R) || 295%% A <- Attrs 296%% ]; 297%% '#get-r'(a, R) -> 298%% case R of 299%% {r,rec0,_,_} -> 300%% rec0; 301%% _ -> 302%% error({badrecord,r}) 303%% end; 304%% '#get-r'(b, R) -> 305%% case R of 306%% {r,_,rec1,_} -> 307%% rec1; 308%% _ -> 309%% error({badrecord,r}) 310%% end; 311%% '#get-r'(c, R) -> 312%% case R of 313%% {r,_,_,rec2} -> 314%% rec2; 315%% _ -> 316%% error({badrecord,r}) 317%% end; 318%% '#get-r'(Attr, R) -> 319%% error(bad_record_op, ['#get-r',Attr,R]). 320%% 321%% '#set-r'(Vals, Rec) -> 322%% F = % fun-info: {0,0,'-#set-r/2-fun-0-'} 323%% fun([], R, _F1) -> 324%% R; 325%% ([{a,V}|T], R, F1) when is_list(T) -> 326%% F1(T, 327%% begin 328%% rec3 = R, 329%% case rec3 of 330%% {r,_,_,_} -> 331%% setelement(2, rec3, V); 332%% _ -> 333%% error({badrecord,r}) 334%% end 335%% end, 336%% F1); 337%% ([{b,V}|T], R, F1) when is_list(T) -> 338%% F1(T, 339%% begin 340%% rec4 = R, 341%% case rec4 of 342%% {r,_,_,_} -> 343%% setelement(3, rec4, V); 344%% _ -> 345%% error({badrecord,r}) 346%% end 347%% end, 348%% F1); 349%% ([{c,V}|T], R, F1) when is_list(T) -> 350%% F1(T, 351%% begin 352%% rec5 = R, 353%% case rec5 of 354%% {r,_,_,_} -> 355%% setelement(4, rec5, V); 356%% _ -> 357%% error({badrecord,r}) 358%% end 359%% end, 360%% F1); 361%% (Vs, R, _) -> 362%% error(bad_record_op, ['#set-r',Vs,R]) 363%% end, 364%% F(Vals, Rec, F). 365%% 366%% '#fromlist-r'(Vals) when is_list(Vals) -> 367%% '#fromlist-r'(Vals, '#new-r'()). 368%% 369%% '#fromlist-r'(Vals, Rec) -> 370%% AttrNames = [{a,2},{b,3},{c,4}], 371%% F = % fun-info: {0,0,'-#fromlist-r/2-fun-0-'} 372%% fun([], R, _F1) -> 373%% R; 374%% ([{H,Pos}|T], R, F1) when is_list(T) -> 375%% case lists:keyfind(H, 1, Vals) of 376%% false -> 377%% F1(T, R, F1); 378%% {_,Val} -> 379%% F1(T, setelement(Pos, R, Val), F1) 380%% end 381%% end, 382%% F(AttrNames, Rec, F). 383%% 384%% '#frommap-r'(Vals) when is_map(Vals) -> 385%% '#frommap-r'(Vals, '#new-r'()). 386%% 387%% '#frommap-r'(Vals, Rec) -> 388%% List = maps:to_list(Vals), 389%% '#fromlist-r'(List, Rec). 390%% 391%% '#pos-r'(a) -> 392%% 2; 393%% '#pos-r'(b) -> 394%% 3; 395%% '#pos-r'(c) -> 396%% 4; 397%% '#pos-r'(A) when is_atom(A) -> 398%% 0. 399%% 400%% '#info-r'(fields) -> 401%% [a,b,c]; 402%% '#info-r'(size) -> 403%% 4. 404%% 405%% '#lens-r'(a) -> 406%% {% fun-info: {0,0,'-#lens-r/1-fun-0-'} 407%% fun(R) -> 408%% '#get-r'(a, R) 409%% end, 410%% % fun-info: {0,0,'-#lens-r/1-fun-1-'} 411%% fun(X, R) -> 412%% '#set-r'([{a,X}], R) 413%% end}; 414%% '#lens-r'(b) -> 415%% {% fun-info: {0,0,'-#lens-r/1-fun-2-'} 416%% fun(R) -> 417%% '#get-r'(b, R) 418%% end, 419%% % fun-info: {0,0,'-#lens-r/1-fun-3-'} 420%% fun(X, R) -> 421%% '#set-r'([{b,X}], R) 422%% end}; 423%% '#lens-r'(c) -> 424%% {% fun-info: {0,0,'-#lens-r/1-fun-4-'} 425%% fun(R) -> 426%% '#get-r'(c, R) 427%% end, 428%% % fun-info: {0,0,'-#lens-r/1-fun-5-'} 429%% fun(X, R) -> 430%% '#set-r'([{c,X}], R) 431%% end}; 432%% '#lens-r'(Attr) -> 433%% error(bad_record_op, ['#lens-r',Attr]). 434%% 435%% '#new-s'() -> 436%% {s,undefined}. 437%% 438%% '#new-s'(Vals) -> 439%% '#set-s'(Vals, {s,undefined}). 440%% 441%% '#get-s'(Attrs, R) when is_list(Attrs) -> 442%% [ 443%% '#get-s'(A, R) || 444%% A <- Attrs 445%% ]; 446%% '#get-s'(a, R) -> 447%% case R of 448%% {s,rec6} -> 449%% rec6; 450%% _ -> 451%% error({badrecord,s}) 452%% end; 453%% '#get-s'(Attr, R) -> 454%% error(bad_record_op, ['#get-s',Attr,R]). 455%% 456%% '#set-s'(Vals, Rec) -> 457%% F = % fun-info: {0,0,'-#set-s/2-fun-0-'} 458%% fun([], R, _F1) -> 459%% R; 460%% ([{a,V}|T], R, F1) when is_list(T) -> 461%% F1(T, 462%% begin 463%% rec7 = R, 464%% case rec7 of 465%% {s,rec8} -> 466%% {s,V}; 467%% _ -> 468%% error({badrecord,s}) 469%% end 470%% end, 471%% F1); 472%% (Vs, R, _) -> 473%% error(bad_record_op, ['#set-s',Vs,R]) 474%% end, 475%% F(Vals, Rec, F). 476%% 477%% '#fromlist-s'(Vals) when is_list(Vals) -> 478%% '#fromlist-s'(Vals, '#new-s'()). 479%% 480%% '#fromlist-s'(Vals, Rec) -> 481%% AttrNames = [{a,2}], 482%% F = % fun-info: {0,0,'-#fromlist-s/2-fun-0-'} 483%% fun([], R, _F1) -> 484%% R; 485%% ([{H,Pos}|T], R, F1) when is_list(T) -> 486%% case lists:keyfind(H, 1, Vals) of 487%% false -> 488%% F1(T, R, F1); 489%% {_,Val} -> 490%% F1(T, setelement(Pos, R, Val), F1) 491%% end 492%% end, 493%% F(AttrNames, Rec, F). 494%% 495%% '#frommap-s'(Vals) when is_map(Vals) -> 496%% '#frommap-s'(Vals, '#new-s'()). 497%% 498%% '#frommap-s'(Vals, Rec) -> 499%% List = maps:to_list(Vals), 500%% '#fromlist-s'(List, Rec). 501%% 502%% '#pos-s'(a) -> 503%% 2; 504%% '#pos-s'(A) when is_atom(A) -> 505%% 0. 506%% 507%% '#info-s'(fields) -> 508%% [a]; 509%% '#info-s'(size) -> 510%% 2. 511%% 512%% '#lens-s'(a) -> 513%% {% fun-info: {0,0,'-#lens-s/1-fun-0-'} 514%% fun(R) -> 515%% '#get-s'(a, R) 516%% end, 517%% % fun-info: {0,0,'-#lens-s/1-fun-1-'} 518%% fun(X, R) -> 519%% '#set-s'([{a,X}], R) 520%% end}; 521%% '#lens-s'(Attr) -> 522%% error(bad_record_op, ['#lens-s',Attr]). 523%% 524%% '#new-t'() -> 525%% {t}. 526%% 527%% '#new-t'(Vals) -> 528%% '#set-t'(Vals, {t}). 529%% 530%% '#get-t'(Attrs, R) when is_list(Attrs) -> 531%% [ 532%% '#get-t'(A, R) || 533%% A <- Attrs 534%% ]; 535%% '#get-t'(Attr, R) -> 536%% error(bad_record_op, ['#get-t',Attr,R]). 537%% 538%% '#set-t'(Vals, Rec) -> 539%% F = % fun-info: {0,0,'-#set-t/2-fun-0-'} 540%% fun([], R, _F1) -> 541%% R; 542%% (Vs, R, _) -> 543%% error(bad_record_op, ['#set-t',Vs,R]) 544%% end, 545%% F(Vals, Rec, F). 546%% 547%% '#fromlist-t'(Vals) when is_list(Vals) -> 548%% '#fromlist-t'(Vals, '#new-t'()). 549%% 550%% '#fromlist-t'(Vals, Rec) -> 551%% AttrNames = [], 552%% F = % fun-info: {0,0,'-#fromlist-t/2-fun-0-'} 553%% fun([], R, _F1) -> 554%% R; 555%% ([{H,Pos}|T], R, F1) when is_list(T) -> 556%% case lists:keyfind(H, 1, Vals) of 557%% false -> 558%% F1(T, R, F1); 559%% {_,Val} -> 560%% F1(T, setelement(Pos, R, Val), F1) 561%% end 562%% end, 563%% F(AttrNames, Rec, F). 564%% 565%% '#frommap-t'(Vals) when is_map(Vals) -> 566%% '#frommap-t'(Vals, '#new-t'()). 567%% 568%% '#frommap-t'(Vals, Rec) -> 569%% List = maps:to_list(Vals), 570%% '#fromlist-t'(List, Rec). 571%% 572%% '#pos-t'(A) when is_atom(A) -> 573%% 0. 574%% 575%% '#info-t'(fields) -> 576%% []; 577%% '#info-t'(size) -> 578%% 1. 579%% 580%% '#lens-t'(Attr) -> 581%% error(bad_record_op, ['#lens-t',Attr]). 582%% 583%% f() -> 584%% foo. 585%% </pre> 586%% 587%% It is possible to modify the naming rules of exprecs, through the use 588%% of the following attributes (example reflecting the current rules): 589%% 590%% <pre> 591%% -exprecs_prefix(["#", operation, "-"]). 592%% -exprecs_fname([prefix, record]). 593%% -exprecs_vfname([fname, "__", version]). 594%% </pre> 595%% 596%% The lists must contain strings or any of the following control atoms: 597%% <ul> 598%% <li>in `exprecs_prefix': `operation'</li> 599%% <li>in `exprecs_fname': `operation', `record', `prefix'</li> 600%% <li>in `exprecs_vfname': `operation', `record', `prefix', `fname', `version' 601%% </li> 602%% </ul> 603%% 604%% Exprecs will substitute the control atoms with the string values of the 605%% corresponding items. The result will then be flattened and converted to an 606%% atom (a valid function or type name). 607%% 608%% `operation' is one of: 609%% <dl> 610%% <dt>`new'</dt> <dd>Creates a new record</dd> 611%% <dt>`get'</dt> <dd>Retrieves given attribute values from a record</dd> 612%% <dt>`set'</dt> <dd>Sets given attribute values in a record</dd> 613%% <dt>`fromlist'</dt> <dd>Creates a record from a key-value list</dd> 614%% <dt>`info'</dt> <dd>Equivalent to record_info/2</dd> 615%% <dt>`pos'</dt> <dd>Returns the position of a given attribute</dd> 616%% <dt>`is_record'</dt> <dd>Tests if a value is a specific record</dd> 617%% <dt>`convert'</dt> <dd>Converts an old record to the current version</dd> 618%% <dt>`prop'</dt> <dd>Used only in type specs</dd> 619%% <dt>`attr'</dt> <dd>Used only in type specs</dd> 620%% <dt>`lens'</dt> <dd>Returns a 'lens' (an accessor pair) as described in 621%% [http://github.com/jlouis/erl-lenses]</dd> 622%% </dl> 623%% 624%% @end 625 626-module(exprecs). 627 628-export([parse_transform/2, 629 format_error/1, 630% transform/3, 631 context/2]). 632 633-record(context, {module, 634 function, 635 arity}). 636 637-record(pass1, {exports = [], 638 generated = false, 639 records = [], 640 record_types = [], 641 versions = orddict:new(), 642 inserted = false, 643 prefix = ["#", operation, "-"], 644 fname = [prefix, record], 645 vfname = [fname, "__", version]}). 646 647-include("../include/codegen.hrl"). 648 649-define(HERE, {?MODULE, ?LINE}). 650 651-define(ERROR(R, F, I), 652 begin 653 rpt_error(R, F, I), 654 throw({error,get_pos(I),{unknown,R}}) 655 end). 656 657-type form() :: any(). 658-type forms() :: [form()]. 659-type options() :: [{atom(), any()}]. 660 661 662get_pos(I) -> 663 case proplists:get_value(form, I) of 664 undefined -> 665 0; 666 Form -> 667 erl_syntax:get_pos(Form) 668 end. 669 670-spec parse_transform(forms(), options()) -> 671 forms(). 672parse_transform(Forms, Options) -> 673 parse_trans:top(fun do_transform/2, Forms, Options). 674 675do_transform(Forms, Context) -> 676 Acc1 = versioned_records( 677 add_untyped_recs( 678 parse_trans:do_inspect(fun inspect_f/4, #pass1{}, 679 Forms, Context))), 680 {Forms2, Acc2} = 681 parse_trans:do_transform(fun generate_f/4, Acc1, Forms, Context), 682 parse_trans:revert(verify_generated(Forms2, Acc2, Context)). 683 684add_untyped_recs(#pass1{records = Rs, 685 record_types = RTypes, 686 exports = Es} = Acc) -> 687 Untyped = 688 [{R, Def} || {R, Def} <- Rs, 689 lists:member(R, Es), 690 not lists:keymember(R, 1, RTypes)], 691 RTypes1 = [{R, lists:map( 692 fun({record_field,L,{atom,_,A}}) -> {A, t_any(L)}; 693 ({record_field,L,{atom,_,A},_}) -> {A, t_any(L)}; 694 ({typed_record_field, 695 {record_field,L,{atom,_,A}},_}) -> {A, t_any(L)}; 696 ({typed_record_field, 697 {record_field,L,{atom,_,A},_},_}) -> {A, t_any(L)} 698 end, Def)} || {R, Def} <- Untyped], 699 Acc#pass1{record_types = RTypes ++ RTypes1}. 700 701inspect_f(attribute, {attribute,_L,exprecs_prefix,Pattern}, _Ctxt, Acc) -> 702 {false, Acc#pass1{prefix = Pattern}}; 703inspect_f(attribute, {attribute,_L,exprecs_fname,Pattern}, _Ctxt, Acc) -> 704 {false, Acc#pass1{fname = Pattern}}; 705inspect_f(attribute, {attribute,_L,exprecs_vfname,Pattern}, _Ctxt, Acc) -> 706 {false, Acc#pass1{vfname = Pattern}}; 707inspect_f(attribute, {attribute,_L,record,RecDef}, _Ctxt, Acc) -> 708 Recs0 = Acc#pass1.records, 709 {false, Acc#pass1{records = [RecDef|Recs0]}}; 710inspect_f(attribute, {attribute,_L,export_records, E}, _Ctxt, Acc) -> 711 Exports0 = Acc#pass1.exports, 712 NewExports = Exports0 ++ E, 713 {false, Acc#pass1{exports = NewExports}}; 714inspect_f(attribute, {attribute, _L, type, 715 {{record, R}, RType,_}}, _Ctxt, Acc) -> 716 Type = lists:map( 717 fun({typed_record_field, {record_field,_,{atom,_,A}}, T}) -> 718 {A, T}; 719 ({typed_record_field, {record_field,_,{atom,_,A},_}, T}) -> 720 {A, T}; 721 ({record_field, _, {atom,L,A}, _}) -> 722 {A, t_any(L)}; 723 ({record_field, _, {atom,L,A}}) -> 724 {A, t_any(L)} 725 end, RType), 726 {false, Acc#pass1{record_types = [{R, Type}|Acc#pass1.record_types]}}; 727inspect_f(_Type, _Form, _Context, Acc) -> 728 {false, Acc}. 729 730generate_f(attribute, {attribute,L,export_records,_} = Form, _Ctxt, 731 #pass1{exports = [_|_] = Es, versions = Vsns, 732 inserted = false} = Acc) -> 733 case check_record_names(Es, L, Acc) of 734 ok -> continue; 735 {error, Bad} -> 736 ?ERROR(invalid_record_exports, ?HERE, Bad) 737 end, 738 Exports = [{fname(exported_records, Acc), 0}, 739 {fname(new, Acc), 1}, 740 {fname(info, Acc), 1}, 741 {fname(info, Acc), 2}, 742 {fname(pos, Acc), 2}, 743 {fname(is_record, Acc), 1}, 744 {fname(is_record, Acc), 2}, 745 {fname(get, Acc), 2}, 746 {fname(set, Acc), 2}, 747 {fname(fromlist, Acc), 2}, 748 {fname(frommap, Acc), 2}, 749 {fname(lens, Acc), 2} | 750 lists:flatmap( 751 fun(Rec) -> 752 RecS = atom_to_list(Rec), 753 FNew = fname(new, RecS, Acc), 754 [{FNew, 0}, {FNew,1}, 755 {fname(get, RecS, Acc), 2}, 756 {fname(set, RecS, Acc), 2}, 757 {fname(pos, RecS, Acc), 1}, 758 {fname(fromlist, RecS, Acc), 1}, 759 {fname(frommap, RecS, Acc), 1}, 760 {fname(fromlist, RecS, Acc), 2}, 761 {fname(frommap, RecS, Acc), 2}, 762 {fname(info, RecS, Acc), 1}, 763 {fname(lens, RecS, Acc), 1}] 764 end, Es)] ++ version_exports(Vsns, Acc), 765 TypeExports = 766 lists:flatmap( 767 fun(Rec) -> 768 [{fname(prop, Rec, Acc), 0}, 769 {fname(attr, Rec, Acc), 0}] 770 end, Es), 771 {[], Form, 772 [{attribute,L,export,Exports}, 773 {attribute,L,export_type, TypeExports}], 774 false, Acc#pass1{inserted = true}}; 775generate_f(function, Form, _Context, #pass1{generated = false} = Acc) -> 776 % Layout record funs before first function 777 L = erl_syntax:get_pos(Form), 778 Forms = generate_specs_and_accessors(L, Acc), 779 {Forms, Form, [], false, Acc#pass1{generated = true}}; 780generate_f(_Type, Form, _Ctxt, Acc) -> 781 {Form, false, Acc}. 782 783generate_specs_and_accessors(L, #pass1{exports = [_|_] = Es, 784 record_types = Ts} = Acc) -> 785 Specs = generate_specs(L, [{R,T} || {R,T} <- Ts, lists:member(R, Es)], Acc), 786 Funs = generate_accessors(L, Acc), 787 Specs ++ Funs; 788generate_specs_and_accessors(_, _) -> 789 []. 790 791verify_generated(Forms, #pass1{} = Acc, _Context) -> 792 case (Acc#pass1.generated == true) orelse (Acc#pass1.exports == []) of 793 true -> 794 Forms; 795 false -> 796 % should be re-written to use the parse_trans helper...? 797 [{eof,Last}|RevForms] = lists:reverse(Forms), 798 [{function, NewLast, _, _, _}|_] = RevAs = 799 lists:reverse(generate_specs_and_accessors(Last, Acc)), 800 lists:reverse([{eof, NewLast+1} | RevAs] ++ RevForms) 801 end. 802 803 804check_record_names(Es, L, #pass1{records = Rs}) -> 805 case [E || E <- Es, 806 not(lists:keymember(E, 1, Rs))] of 807 [] -> 808 ok; 809 Bad -> 810 {error, [{L,E} || E <- Bad]} 811 end. 812 813versioned_records(#pass1{exports = Es, records = Rs} = Pass1) -> 814 case split_recnames(Rs) of 815 [] -> 816 Pass1#pass1{versions = []}; 817 [_|_] = Versions -> 818 Exp_vsns = 819 lists:foldl( 820 fun(Re, Acc) -> 821 case orddict:find(atom_to_list(Re), Versions) of 822 {ok, Vs} -> 823 orddict:store(Re, Vs, Acc); 824 error -> 825 Acc 826 end 827 end, orddict:new(), Es), 828 Pass1#pass1{versions = Exp_vsns} 829 end. 830 831version_exports([], _Acc) -> 832 []; 833version_exports([_|_] = _Vsns, Acc) -> 834 [{list_to_atom(fname_prefix(info, Acc)), 3}, 835 {list_to_atom(fname_prefix(convert, Acc)), 2}]. 836 837 838version_accessors(_L, #pass1{versions = []}) -> 839 []; 840version_accessors(L, #pass1{versions = Vsns} = Acc) -> 841 Flat_vsns = flat_versions(Vsns), 842 [f_convert(Vsns, L, Acc), 843 f_info_3(Vsns, L, Acc)] 844 ++ [f_info_1(Rname, Acc, L, V) || {Rname,V} <- Flat_vsns]. 845 846flat_versions(Vsns) -> 847 lists:flatmap(fun({R,Vs}) -> 848 [{R,V} || V <- Vs] 849 end, Vsns). 850 851split_recnames(Rs) -> 852 lists:foldl( 853 fun({R,_As}, Acc) -> 854 case re:split(atom_to_list(R), "__", [{return, list}]) of 855 [Base, V] -> 856 orddict:append(Base,V,Acc); 857 [_] -> 858 Acc 859 end 860 end, orddict:new(), Rs). 861 862generate_specs(L, Specs, Acc) -> 863 [[ 864 {attribute, L, type, 865 {fname(prop, R, Acc), 866 {type, L, union, 867 [{type, L, tuple, [{atom,L,A},T]} || {A,T} <- Attrs]}, []}}, 868 {attribute, L, type, 869 {fname(attr, R, Acc), 870 {type, L, union, 871 [{atom, L, A} || {A,_} <- Attrs]}, []}} 872 ] || {R, Attrs} <- Specs, Attrs =/= []] ++ 873 [[{attribute, L, type, 874 {fname(prop, R, Acc), 875 {type, L, any, []}, []}}, 876 {attribute, L, type, 877 {fname(attr, R, Acc), 878 {type, L, any, []}, []}}] || {R, []} <- Specs]. 879 880 881generate_accessors(L, Acc) -> 882 lists:flatten( 883 [f_exported_recs(Acc, L), 884 f_new_(Acc, L), 885 f_info(Acc, L), 886 f_info_2(Acc, L), 887 f_pos_2(Acc, L), 888 f_isrec_1(Acc, L), 889 f_isrec_2(Acc, L), 890 f_get(Acc, L), 891 f_set(Acc, L), 892 f_fromlist(Acc, L), 893 f_frommap(Acc, L), 894 f_lens_(Acc, L)| 895 lists:append( 896 lists:map( 897 fun(Rname) -> 898 Fields = get_flds(Rname, Acc), 899 [f_new_0(Rname, L, Acc), 900 f_new_1(Rname, L, Acc), 901 f_get_2(Rname, Fields, L, Acc), 902 f_set_2(Rname, Fields, L, Acc), 903 f_fromlist_1(Rname, L, Acc), 904 f_fromlist_2(Rname, Fields, L, Acc), 905 f_frommap_1(Rname, L, Acc), 906 f_frommap_2(Rname, L, Acc), 907 f_pos_1(Rname, Fields, L, Acc), 908 f_info_1(Rname, Acc, L), 909 f_lens_1(Rname, Fields, L, Acc)] 910 end, Acc#pass1.exports))] ++ version_accessors(L, Acc)). 911 912get_flds(Rname, #pass1{records = Rs}) -> 913 {_, Flds} = lists:keyfind(Rname, 1, Rs), 914 lists:map( 915 fun({record_field,_, {atom,_,N}}) -> N; 916 ({record_field,_, {atom,_,N}, _}) -> N; 917 ({typed_record_field,{record_field,_,{atom,_,N}},_}) -> N; 918 ({typed_record_field,{record_field,_,{atom,_,N},_},_}) -> N 919 end, Flds). 920 921 922fname_prefix(Op, #pass1{prefix = Pat}) -> 923 lists:flatten( 924 lists:map(fun(operation) -> str(Op); 925 (X) -> str(X) 926 end, Pat)). 927%% fname_prefix(Op, #pass1{} = Acc) -> 928%% case Op of 929%% new -> "#new-"; 930%% get -> "#get-"; 931%% set -> "#set-"; 932%% fromlist -> "#fromlist-"; 933%% info -> "#info-"; 934%% pos -> "#pos-"; 935%% is_record -> "#is_record-"; 936%% convert -> "#convert-"; 937%% prop -> "#prop-"; 938%% attr -> "#attr-" 939%% end. 940 941%% fname_prefix(Op, Rname, Acc) -> 942%% fname_prefix(Op, Acc) ++ str(Rname). 943 944str(A) when is_atom(A) -> 945 atom_to_list(A); 946str(S) when is_list(S) -> 947 S. 948 949fname(Op, #pass1{} = Acc) -> 950 list_to_atom(fname_prefix(Op, Acc)). 951 %% list_to_atom(fname_prefix(Op, Acc)). 952 953fname(Op, Rname, #pass1{fname = FPat} = Acc) -> 954 Prefix = fname_prefix(Op, Acc), 955 list_to_atom( 956 lists:flatten( 957 lists:map(fun(prefix) -> str(Prefix); 958 (record) -> str(Rname); 959 (operation) -> str(Op); 960 (X) -> str(X) 961 end, FPat))). 962 %% list_to_atom(fname_prefix(Op, Rname, Acc)). 963 964fname(Op, Rname, V, #pass1{vfname = VPat} = Acc) -> 965 list_to_atom( 966 lists:flatten( 967 lists:map(fun(prefix) -> fname_prefix(Op, Acc); 968 (operation) -> str(Op); 969 (record) -> str(Rname); 970 (version) -> str(V); 971 (fname) -> str(fname(Op, Rname, Acc)); 972 (X) -> str(X) 973 end, VPat))). 974 %% list_to_atom(fname_prefix(Op, Rname, Acc) ++ "__" ++ V). 975 976 977%%% Meta functions 978 979f_exported_recs(#pass1{exports = Es} = Acc, L) -> 980 Fname = fname(exported_records, Acc), 981 [funspec(L, Fname, [], 982 t_list(L, [t_union(L, [t_atom(L, E) || E <- Es])])), 983 {function, L, Fname, 0, 984 [{clause, L, [], [], 985 [erl_parse:abstract(Es, L)]}]} 986 ]. 987 988%%% Accessor functions 989%%% 990f_new_(#pass1{exports = Es} = Acc, L) -> 991 Fname = fname(new, Acc), 992 [funspec(L, Fname, [ {[t_atom(L, E)], t_record(L, E)} || 993 E <- Es ]), 994 {function, L, fname(new, Acc), 1, 995 [{clause, L, [{atom, L, Re}], [], 996 [{call, L, {atom, L, fname(new, Re, Acc)}, []}]} 997 || Re <- Es]} 998 ]. 999 1000f_new_0(Rname, L, Acc) -> 1001 Fname = fname(new, Rname, Acc), 1002 [funspec(L, Fname, [], t_record(L, Rname)), 1003 {function, L, fname(new, Rname, Acc), 0, 1004 [{clause, L, [], [], 1005 [{record, L, Rname, []}]}]} 1006 ]. 1007 1008 1009f_new_1(Rname, L, Acc) -> 1010 Fname = fname(new, Rname, Acc), 1011 [funspec(L, Fname, [t_list(L, [t_prop(L, Rname, Acc)])], 1012 t_record(L, Rname)), 1013 {function, L, Fname, 1, 1014 [{clause, L, [{var, L, 'Vals'}], [], 1015 [{call, L, {atom, L, fname(set, Rname, Acc)}, 1016 [{var, L, 'Vals'}, 1017 {record, L, Rname, []} 1018 ]}] 1019 }]}]. 1020 1021funspec(L, Fname, [{H,_} | _] = Alts) -> 1022 Arity = length(H), 1023 {attribute, L, spec, 1024 {{Fname, Arity}, 1025 [{type, L, 'fun', [{type, L, product, Head}, Ret]} || 1026 {Head, Ret} <- Alts, 1027 no_empty_union(Head)]}}. 1028 1029no_empty_union({type,_,union,[]}) -> 1030 false; 1031no_empty_union(T) when is_tuple(T) -> 1032 no_empty_union(tuple_to_list(T)); 1033no_empty_union([H|T]) -> 1034 no_empty_union(H) andalso no_empty_union(T); 1035no_empty_union(_) -> 1036 true. 1037 1038 1039 1040 1041funspec(L, Fname, Head, Returns) -> 1042 Arity = length(Head), 1043 {attribute, L, spec, 1044 {{Fname, Arity}, 1045 [{type, L, 'fun', 1046 [{type, L, product, Head}, Returns]}]}}. 1047 1048 1049t_prop(L, Rname, Acc) -> {user_type, L, fname(prop, Rname, Acc), []}. 1050t_attr(L, Rname, Acc) -> {user_type, L, fname(attr, Rname, Acc), []}. 1051t_union(L, Alt) -> {type, L, union, lists:usort(Alt)}. 1052t_any(L) -> {type, L, any, []}. 1053t_atom(L) -> {type, L, atom, []}. 1054t_atom(L, A) -> {atom, L, A}. 1055t_integer(L) -> {type, L, integer, []}. 1056t_integer(L, I) -> {integer, L, I}. 1057t_list(L, Es) -> {type, L, list, Es}. 1058t_fun(L, As, Res) -> {type, L, 'fun', [{type, L, product, As}, Res]}. 1059t_tuple(L, Es) -> {type, L, tuple, Es}. 1060t_boolean(L) -> {type, L, boolean, []}. 1061t_record(L, A) -> {type, L, record, [{atom, L, A}]}. 1062t_map(L, Rname, Acc) -> {type, L, map, 1063 [{type, L, map_field_assoc, [t_atom(L, F), t_any(L)]} 1064 || F <- get_flds(Rname, Acc) 1065 ] 1066 }. 1067 1068f_set_2(Rname, Flds, L, Acc) -> 1069 Fname = fname(set, Rname, Acc), 1070 TRec = t_record(L, Rname), 1071 [funspec(L, Fname, [t_list(L, [t_prop(L, Rname, Acc)]), TRec], TRec), 1072 {function, L, Fname, 2, 1073 [{clause, L, [{var, L, 'Vals'}, {var, L, 'Rec'}], [], 1074 [{match, L, {var, L, 'F'}, 1075 {'fun', L, 1076 {clauses, 1077 [{clause, L, [{nil,L}, 1078 {var,L,'R'}, 1079 {var,L,'_F1'}], 1080 [], 1081 [{var, L, 'R'}]} | 1082 [{clause, L, 1083 [{cons, L, {tuple, L, [{atom, L, Attr}, 1084 {var, L, 'V'}]}, 1085 {var, L, 'T'}}, 1086 {var, L, 'R'}, 1087 {var, L, 'F1'}], 1088 [[{call, L, {atom, L, is_list}, [{var, L, 'T'}]}]], 1089 [{call, L, {var, L, 'F1'}, 1090 [{var,L,'T'}, 1091 {record, L, {var,L,'R'}, Rname, 1092 [{record_field, L, 1093 {atom, L, Attr}, 1094 {var, L, 'V'}}]}, 1095 {var, L, 'F1'}]}]} || Attr <- Flds] 1096 ++ [{clause, L, [{var, L, 'Vs'}, {var,L,'R'},{var,L,'_'}], 1097 [], 1098 [bad_record_op(L, Fname, 'Vs', 'R')]}] 1099 ]}}}, 1100 {call, L, {var, L, 'F'}, [{var, L, 'Vals'}, 1101 {var, L, 'Rec'}, 1102 {var, L, 'F'}]}]}]}]. 1103 1104bad_record_op(L, Fname, Val) -> 1105 {call, L, {remote, L, {atom,L,erlang}, {atom,L,error}}, 1106 [{atom,L,bad_record_op}, {cons, L, {atom, L, Fname}, 1107 {cons, L, {var, L, Val}, 1108 {nil, L}}}]}. 1109 1110bad_record_op(L, Fname, Val, R) -> 1111 {call, L, {remote, L, {atom,L,erlang}, {atom,L,error}}, 1112 [{atom,L,bad_record_op}, {cons, L, {atom, L, Fname}, 1113 {cons, L, {var, L, Val}, 1114 {cons, L, {var, L, R}, 1115 {nil, L}}}}]}. 1116 1117 1118f_pos_1(Rname, Flds, L, Acc) -> 1119 Fname = fname(pos, Rname, Acc), 1120 FieldList = lists:zip(Flds, lists:seq(2, length(Flds)+1)), 1121 [ 1122 funspec(L, Fname, [t_union(L, [t_attr(L, Rname, Acc), 1123 t_atom(L)])], 1124 t_integer(L)), 1125 {function, L, Fname, 1, 1126 [{clause, L, 1127 [{atom, L, FldName}], 1128 [], 1129 [{integer, L, Pos}]} || {FldName, Pos} <- FieldList] ++ 1130 [{clause, L, 1131 [{var, L, 'A'}], 1132 [[{call, L, {atom, L, is_atom}, [{var, L, 'A'}]}]], 1133 [{integer, L, 0}]}] 1134 }]. 1135 1136f_frommap_1(Rname, L, Acc) -> 1137 Fname = fname(frommap, Rname, Acc), 1138 [ 1139 funspec(L, Fname, [t_map(L, Rname, Acc)], 1140 t_record(L, Rname)), 1141 {function, L, Fname, 1, 1142 [{clause, L, [{var, L, 'Vals'}], 1143 [[ {call, L, {atom, L, is_map}, [{var, L, 'Vals'}]} ]], 1144 [{call, L, {atom, L, Fname}, 1145 [{var, L, 'Vals'}, 1146 {call, L, {atom, L, fname(new, Rname, Acc)}, []}]} 1147 ]} 1148 ]}]. 1149 1150f_fromlist_1(Rname, L, Acc) -> 1151 Fname = fname(fromlist, Rname, Acc), 1152 [ 1153 funspec(L, Fname, [t_list(L, [t_prop(L, Rname, Acc)])], 1154 t_record(L, Rname)), 1155 {function, L, Fname, 1, 1156 [{clause, L, [{var, L, 'Vals'}], 1157 [[ {call, L, {atom, L, is_list}, [{var, L, 'Vals'}]} ]], 1158 [{call, L, {atom, L, Fname}, 1159 [{var, L, 'Vals'}, 1160 {call, L, {atom, L, fname(new, Rname, Acc)}, []}]} 1161 ]} 1162 ]}]. 1163 1164f_frommap_2(Rname, L, Acc) -> 1165 Fname = fname(frommap, Rname, Acc), 1166 TRec = t_record(L, Rname), 1167 [ 1168 funspec(L, Fname, [t_map(L, Rname, Acc), TRec], 1169 TRec), 1170 {function, L, Fname, 2, 1171 [{clause, L, [{var, L, 'Vals'}, {var, L, 'Rec'}], [], 1172 [{match, L, {var, L, 'List'}, 1173 {call, L, {remote, L, {atom, L, maps}, {atom, L, to_list}}, 1174 [{var, L, 'Vals'}] 1175 } 1176 }, 1177 {call, L, {atom, L, fname(fromlist, Rname, Acc)}, 1178 [{var, L, 'List'}, {var, L, 'Rec'}] 1179 } 1180 ]} 1181 ]}]. 1182 1183f_fromlist_2(Rname, Flds, L, Acc) -> 1184 Fname = fname(fromlist, Rname, Acc), 1185 FldList = field_list(Flds), 1186 TRec = t_record(L, Rname), 1187 [ 1188 funspec(L, Fname, [t_list(L, [t_prop(L, Rname, Acc)]), TRec], 1189 TRec), 1190 {function, L, Fname, 2, 1191 [{clause, L, [{var, L, 'Vals'}, {var, L, 'Rec'}], [], 1192 [{match, L, {var, L, 'AttrNames'}, FldList}, 1193 {match, L, {var, L, 'F'}, 1194 {'fun', L, 1195 {clauses, 1196 [{clause, L, [{nil, L}, 1197 {var, L,'R'}, 1198 {var, L,'_F1'}], 1199 [], 1200 [{var, L, 'R'}]}, 1201 {clause, L, [{cons, L, 1202 {tuple, L, [{var, L, 'H'}, 1203 {var, L, 'Pos'}]}, 1204 {var, L, 'T'}}, 1205 {var, L, 'R'}, {var, L, 'F1'}], 1206 [[{call, L, {atom, L, is_list}, [{var, L, 'T'}]}]], 1207 [{'case', L, {call, L, {remote, L, 1208 {atom,L,lists},{atom,L,keyfind}}, 1209 [{var,L,'H'},{integer,L,1},{var,L,'Vals'}]}, 1210 [{clause, L, [{atom,L,false}], [], 1211 [{call, L, {var, L, 'F1'}, [{var, L, 'T'}, 1212 {var, L, 'R'}, 1213 {var, L, 'F1'}]}]}, 1214 {clause, L, [{tuple, L, [{var,L,'_'},{var,L,'Val'}]}], 1215 [], 1216 [{call, L, {var, L, 'F1'}, 1217 [{var, L, 'T'}, 1218 {call, L, {atom, L, 'setelement'}, 1219 [{var, L, 'Pos'}, {var, L, 'R'}, {var, L, 'Val'}]}, 1220 {var, L, 'F1'}]}]} 1221 ]} 1222 ]} 1223 ]}}}, 1224 {call, L, {var, L, 'F'}, [{var, L, 'AttrNames'}, 1225 {var, L, 'Rec'}, 1226 {var, L, 'F'}]} 1227 ]} 1228 ]}]. 1229 1230field_list(Flds) -> 1231 erl_parse:abstract( 1232 lists:zip(Flds, lists:seq(2, length(Flds)+1))). 1233 1234 1235 1236f_get_2(R, Flds, L, Acc) -> 1237 FName = fname(get, R, Acc), 1238 {_, Types} = lists:keyfind(R, 1, Acc#pass1.record_types), 1239 [funspec(L, FName, 1240 [{[t_atom(L, A), t_record(L, R)], T} 1241 || {A, T} <- Types] 1242 ++ [{[t_list(L, [t_attr(L, R, Acc)]), t_record(L, R)], 1243 t_list(L, [t_any(L)])}] 1244 ), 1245 {function, L, FName, 2, 1246 [{clause, L, [{var, L, 'Attrs'}, {var, L, 'R'}], 1247 [[{call, L, {atom, L, is_list}, [{var, L, 'Attrs'}]}]], 1248 [{lc, L, {call, L, {atom, L, FName}, [{var, L, 'A'}, {var, L, 'R'}]}, 1249 [{generate, L, {var, L, 'A'}, {var, L, 'Attrs'}}]}] 1250 } | 1251 [{clause, L, [{atom, L, Attr}, {var, L, 'R'}], [], 1252 [{record_field, L, {var, L, 'R'}, R, {atom, L, Attr}}]} || 1253 Attr <- Flds]] ++ 1254 [{clause, L, [{var, L, 'Attr'}, {var, L, 'R'}], [], 1255 [bad_record_op(L, FName, 'Attr', 'R')]}] 1256 }]. 1257 1258 1259f_info(Acc, L) -> 1260 Fname = list_to_atom(fname_prefix(info, Acc)), 1261 [funspec(L, Fname, 1262 [{[t_atom(L, R)], 1263 t_list(L, [t_attr(L, R, Acc)])} 1264 || R <- Acc#pass1.exports]), 1265 {function, L, Fname, 1, 1266 [{clause, L, 1267 [{var, L, 'RecName'}], [], 1268 [{call, L, {atom, L, Fname}, [{var, L, 'RecName'}, {atom, L, fields}]}] 1269 }]} 1270 ]. 1271 1272f_isrec_2(#pass1{records = Rs, exports = Es} = Acc, L) -> 1273 Fname = list_to_atom(fname_prefix(is_record, Acc)), 1274 Info = [{R,length(As) + 1} || {R,As} <- Rs, lists:member(R, Es)], 1275 [%% This contract is correct, but is ignored by Dialyzer because it 1276 %% has overlapping domains: 1277 %% funspec(L, Fname, 1278 %% [{[t_atom(L, R), t_record(L, R)], t_atom(L, true)} 1279 %% || R <- Es] ++ 1280 %% [{[t_any(L), t_any(L)], t_atom(L, false)}]), 1281 %% This is less specific, but more useful to Dialyzer: 1282 funspec(L, Fname, [{[t_any(L), t_any(L)], t_boolean(L)}]), 1283 {function, L, Fname, 2, 1284 lists:map( 1285 fun({R, Ln}) -> 1286 {clause, L, 1287 [{atom, L, R}, {var, L, 'Rec'}], 1288 [[{op,L,'==', 1289 {call, L, {atom,L,tuple_size},[{var,L,'Rec'}]}, 1290 {integer, L, Ln}}, 1291 {op,L,'==', 1292 {call,L,{atom,L,element},[{integer,L,1}, 1293 {var,L,'Rec'}]}, 1294 {atom, L, R}}]], 1295 [{atom, L, true}]} 1296 end, Info) ++ 1297 [{clause, L, [{var,L,'_'}, {var,L,'_'}], [], 1298 [{atom, L, false}]}]} 1299 ]. 1300 1301 1302f_info_2(Acc, L) -> 1303 Fname = list_to_atom(fname_prefix(info, Acc)), 1304 [funspec(L, Fname, 1305 lists:flatmap( 1306 fun(Rname) -> 1307 Flds = get_flds(Rname, Acc), 1308 TRec = t_atom(L, Rname), 1309 [{[TRec, t_atom(L, size)], t_integer(L, length(Flds)+1)}, 1310 {[TRec, t_atom(L, fields)], 1311 t_list(L, [t_attr(L, Rname, Acc)])}] 1312 end, Acc#pass1.exports)), 1313 {function, L, Fname, 2, 1314 [{clause, L, 1315 [{atom, L, R}, 1316 {var, L, 'Info'}], 1317 [], 1318 [{call, L, {atom, L, fname(info, R, Acc)}, [{var, L, 'Info'}]}]} || 1319 R <- Acc#pass1.exports]} 1320 ]. 1321 1322f_info_3(Versions, L, Acc) -> 1323 Fname = list_to_atom(fname_prefix(info, Acc)), 1324 [ 1325 {function, L, Fname, 3, 1326 [{clause, L, 1327 [{atom, L, R}, 1328 {var, L, 'Info'}, 1329 {string, L, V}], 1330 [], 1331 [{call, L, {atom, L, fname(info,R,V,Acc)}, [{var, L, 'Info'}]}]} || 1332 {R,V} <- flat_versions(Versions)]} 1333 ]. 1334 1335f_pos_2(#pass1{exports = Es} = Acc, L) -> 1336 Fname = list_to_atom(fname_prefix(pos, Acc)), 1337 [ 1338 funspec(L, Fname, lists:flatmap( 1339 fun(R) -> 1340 Flds = get_flds(R, Acc), 1341 %% PFlds = lists:zip( 1342 %% lists:seq(2, length(Flds)+1), Flds), 1343 Ps = lists:seq(2, length(Flds)+1), 1344 [{[t_atom(L, R), t_union( 1345 L, ([t_atom(L, F) 1346 || F <- Flds] 1347 ++ [t_atom(L)]))], 1348 t_union(L, ([t_integer(L, P) || P <- Ps] 1349 ++ [t_integer(L, 0)]))}] 1350 %% [{[t_atom(L, R), t_atom(L, A)], 1351 %% t_integer(L, P)} || {P,A} <- PFlds] 1352 %% ++ [{[t_atom(L, R), t_any(L)], 1353 %% t_integer(L, 0)}] 1354 end, Es)), 1355 {function, L, Fname, 2, 1356 [{clause, L, 1357 [{atom, L, R}, 1358 {var, L, 'Attr'}], 1359 [], 1360 [{call, L, {atom, L, fname(pos, R, Acc)}, [{var, L, 'Attr'}]}]} || 1361 R <- Acc#pass1.exports]} 1362 ]. 1363 1364f_isrec_1(Acc, L) -> 1365 Fname = list_to_atom(fname_prefix(is_record, Acc)), 1366 [%% This contract is correct, but is ignored by Dialyzer because it 1367 %% has overlapping domains: 1368 %% funspec(L, Fname, 1369 %% [{[t_record(L, R)], t_atom(L, true)} 1370 %% || R <- Acc#pass1.exports] 1371 %% ++ [{[t_any(L)], t_atom(L, false)}]), 1372 %% This is less specific, but more useful to Dialyzer: 1373 funspec(L, Fname, [{[t_any(L)], t_boolean(L)}]), 1374 {function, L, Fname, 1, 1375 [{clause, L, 1376 [{var, L, 'X'}], 1377 [], 1378 [{'if',L, 1379 [{clause, L, [], [[{call, L, {atom,L,is_record}, 1380 [{var,L,'X'},{atom,L,R}]}]], 1381 [{atom,L,true}]} || R <- Acc#pass1.exports] ++ 1382 [{clause,L, [], [[{atom,L,true}]], 1383 [{atom, L, false}]}]}]} 1384 ]} 1385 ]. 1386 1387 1388 1389f_get(#pass1{record_types = RTypes, exports = Es} = Acc, L) -> 1390 Fname = list_to_atom(fname_prefix(get, Acc)), 1391 [funspec(L, Fname, 1392 lists:append( 1393 [[{[t_atom(L, A), t_record(L, R)], T} 1394 || {A, T} <- Types] 1395 || {R, Types} <- RTypes, lists:member(R, Es)]) 1396 ++ [{[t_list(L, [t_attr(L, R, Acc)]), t_record(L, R)], 1397 t_list(L, [t_union(L, [Ts || {_, Ts} <- Types])])} 1398 || {R, Types} <- RTypes, lists:member(R, Es)] 1399 ), 1400 {function, L, Fname, 2, 1401 [{clause, L, 1402 [{var, L, 'Attrs'}, 1403 {var, L, 'Rec'}], 1404 [[{call, L, 1405 {atom, L, is_record}, 1406 [{var, L, 'Rec'}, {atom, L, R}]}]], 1407 [{call, L, {atom, L, fname(get, R, Acc)}, [{var, L, 'Attrs'}, 1408 {var, L, 'Rec'}]}]} || 1409 R <- Es]} 1410 ]. 1411 1412 1413f_set(Acc, L) -> 1414 Fname = list_to_atom(fname_prefix(set, Acc)), 1415 [funspec(L, Fname, 1416 lists:map( 1417 fun(Rname) -> 1418 TRec = t_record(L, Rname), 1419 {[t_list(L, [t_prop(L, Rname, Acc)]), TRec], TRec} 1420 end, Acc#pass1.exports)), 1421 {function, L, Fname, 2, 1422 [{clause, L, 1423 [{var, L, 'Vals'}, 1424 {var, L, 'Rec'}], 1425 [[{call, L, 1426 {atom, L, is_record}, 1427 [{var, L, 'Rec'}, {atom, L, R}]}]], 1428 [{call, L, {atom, L, fname(set, R, Acc)}, [{var, L, 'Vals'}, 1429 {var, L, 'Rec'}]}]} || 1430 R <- Acc#pass1.exports]} 1431 ]. 1432 1433f_fromlist(Acc, L) -> 1434 Fname = list_to_atom(fname_prefix(fromlist, Acc)), 1435 [funspec(L, Fname, 1436 lists:map( 1437 fun(Rname) -> 1438 TRec = t_record(L, Rname), 1439 {[t_list(L, [t_prop(L, Rname, Acc)]), TRec], TRec} 1440 end, Acc#pass1.exports)), 1441 {function, L, Fname, 2, 1442 [{clause, L, 1443 [{var, L, 'Vals'}, 1444 {var, L, 'Rec'}], 1445 [[{call, L, 1446 {atom, L, is_record}, 1447 [{var, L, 'Rec'}, {atom, L, R}]}]], 1448 [{call, L, {atom, L, fname(fromlist, R, Acc)}, [{var, L, 'Vals'}, 1449 {var, L, 'Rec'}]}]} || 1450 R <- Acc#pass1.exports]} 1451 ]. 1452 1453f_frommap(Acc, L) -> 1454 Fname = list_to_atom(fname_prefix(frommap, Acc)), 1455 [funspec(L, Fname, 1456 lists:map( 1457 fun(Rname) -> 1458 TRec = t_record(L, Rname), 1459 {[t_map(L, Rname, Acc), TRec], TRec} 1460 end, Acc#pass1.exports)), 1461 {function, L, Fname, 2, 1462 [{clause, L, 1463 [{var, L, 'Vals'}, 1464 {var, L, 'Rec'}], 1465 [[{call, L, 1466 {atom, L, is_record}, 1467 [{var, L, 'Rec'}, {atom, L, R}]}]], 1468 [{call, L, {atom, L, fname(frommap, R, Acc)}, [{var, L, 'Vals'}, 1469 {var, L, 'Rec'}]}]} || 1470 R <- Acc#pass1.exports]} 1471 ]. 1472 1473f_info_1(Rname, Acc, L) -> 1474 Fname = fname(info, Rname, Acc), 1475 Flds = get_flds(Rname, Acc), 1476 [funspec(L, Fname, [{[t_atom(L, fields)], 1477 t_list(L, [t_union(L, [t_atom(L,F) || F <- Flds])])}, 1478 {[t_atom(L, size)], t_integer(L, length(Flds)+1)}]), 1479 {function, L, Fname, 1, 1480 [{clause, L, [{atom, L, fields}], [], 1481 [{call, L, {atom, L, record_info}, 1482 [{atom, L, fields}, {atom, L, Rname}]}] 1483 }, 1484 {clause, L, [{atom, L, size}], [], 1485 [{call, L, {atom, L, record_info}, 1486 [{atom, L, size}, {atom, L, Rname}]}] 1487 }]} 1488 ]. 1489 1490f_info_1(Rname, Acc, L, V) -> 1491 f_info_1(recname(Rname, V), Acc, L). 1492 1493recname(Rname, V) -> 1494 list_to_atom(lists:concat([Rname,"__",V])). 1495 1496f_convert(_Vsns, L, Acc) -> 1497 {function, L, fname(convert, Acc), 2, 1498 [{clause, L, 1499 [{var, L, 'FromVsn'}, 1500 {var, L, 'Rec'}], 1501 [[{call,L,{atom, L, is_tuple}, 1502 [{var, L, 'Rec'}]}]], 1503 [{match, L, {var, L, 'Rname'}, 1504 {call, L, {atom, L, element}, 1505 [{integer, L, 1}, {var, 1, 'Rec'}]}}, 1506 {match,L,{var,L,'Size'}, 1507 {call, L, {atom, L, fname(info, Acc)}, 1508 [{var,L,'Rname'}, {atom, L, size}, {var,L,'FromVsn'}]}}, 1509 {match, L, {var, L, 'Size'}, 1510 {call, L, {atom, L, size}, 1511 [{var, L, 'Rec'}]}}, 1512 %% 1513 %% {match, L, {var, L, 'Old_fields'}, 1514 %% {call, L, {atom,L,fname(info, Acc)}, 1515 %% [{var,L,'Rname'},{atom,L,fields},{var,L,'FromVsn'}]}}, 1516 {match, L, {var, L, 'New_fields'}, 1517 {call, L, {atom,L,fname(info, Acc)}, 1518 [{var,L,'Rname'},{atom,L,fields}]}}, 1519 1520 {match, L, {var, L, 'Values'}, 1521 {call, L, {remote, L, {atom, L, lists}, {atom, L, zip}}, 1522 [{call, L, {atom,L,fname(info, Acc)}, 1523 [{var,L,'Rname'},{atom,L,fields},{var,L,'FromVsn'}]}, 1524 {call, L, {atom, L, 'tl'}, 1525 [{call, L, {atom, L, tuple_to_list}, 1526 [{var, L, 'Rec'}]}]}]}}, 1527 {match, L, {tuple, L, [{var, L, 'Matching'}, 1528 {var, L, 'Discarded'}]}, 1529 {call, L, {remote, L, {atom, L, lists}, {atom, L, partition}}, 1530 [{'fun',L, 1531 {clauses, 1532 [{clause,L, 1533 [{tuple,L,[{var,L,'F'},{var,L,'_'}]}], 1534 [], 1535 [{call,L, 1536 {remote,L,{atom,L,lists},{atom,L,member}}, 1537 [{var, L, 'F'}, {var,L,'New_fields'}]}]}]}}, 1538 {var, L, 'Values'}]}}, 1539 {tuple, L, [{call, L, {atom, L, fname(set, Acc)}, 1540 [{var, L, 'Matching'}, 1541 {call, L, {atom, L, fname(new, Acc)}, 1542 [{var, L, 'Rname'}]}]}, 1543 {var, L, 'Discarded'}]}] 1544 }]}. 1545 1546f_lens_(#pass1{exports = Es} = Acc, L) -> 1547 Fname = fname(lens, Acc), 1548 [ 1549 funspec(L, Fname, [ {[t_attr(L, Rname, Acc), t_atom(L, Rname)], 1550 t_tuple(L, [t_fun(L, [t_record(L, Rname)], t_any(L)), 1551 t_fun(L, [t_any(L), 1552 t_record(L, Rname)], 1553 t_record(L, Rname))])} 1554 || Rname <- Es]), 1555 {function, L, Fname, 2, 1556 [{clause, L, [{var, L, 'Attr'}, {atom, L, Re}], [], 1557 [{call, L, {atom, L, fname(lens, Re, Acc)}, [{var, L, 'Attr'}]}]} 1558 || Re <- Es]} 1559 ]. 1560 1561f_lens_1(Rname, Flds, L, Acc) -> 1562 Fname = fname(lens, Rname, Acc), 1563 [funspec(L, Fname, [ {[t_attr(L, Rname, Acc)], 1564 t_tuple(L, [t_fun(L, [t_record(L, Rname)], t_any(L)), 1565 t_fun(L, [t_any(L), 1566 t_record(L, Rname)], 1567 t_record(L, Rname))])} ]), 1568 {function, L, Fname, 1, 1569 [{clause, L, [{atom, L, Attr}], [], 1570 [{tuple, L, [{'fun', L, 1571 {clauses, 1572 [{clause, L, [{var, L, 'R'}], [], 1573 [{call, L, {atom, L, fname(get, Rname, Acc)}, 1574 [{atom, L, Attr}, {var, L, 'R'}]}]} 1575 ]}}, 1576 {'fun', L, 1577 {clauses, 1578 [{clause, L, [{var, L, 'X'}, {var, L, 'R'}], [], 1579 [{call, L, {atom, L, fname(set, Rname, Acc)}, 1580 [{cons,L, {tuple, L, [{atom, L, Attr}, 1581 {var, L, 'X'}]}, {nil,L}}, 1582 {var, L, 'R'}]}] 1583 }]}} 1584 ]}]} || Attr <- Flds] ++ 1585 [{clause, L, [{var, L, 'Attr'}], [], 1586 [bad_record_op(L, Fname, 'Attr')]}] 1587 }]. 1588 1589%%% ========== generic parse_transform stuff ============== 1590 1591-spec context(atom(), #context{}) -> 1592 term(). 1593%% @hidden 1594context(module, #context{module = M} ) -> M; 1595context(function, #context{function = F}) -> F; 1596context(arity, #context{arity = A} ) -> A. 1597 1598 1599 1600rpt_error(Reason, Fun, Info) -> 1601 Fmt = lists:flatten( 1602 ["*** ERROR in parse_transform function:~n" 1603 "*** Reason = ~p~n", 1604 "*** Location: ~p~n", 1605 ["*** ~10w = ~p~n" || _ <- Info]]), 1606 Args = [Reason, Fun | 1607 lists:foldr( 1608 fun({K,V}, Acc) -> 1609 [K, V | Acc] 1610 end, [], Info)], 1611 io:format(Fmt, Args). 1612 1613-spec format_error({atom(), term()}) -> 1614 iolist(). 1615%% @hidden 1616format_error({_Cat, Error}) -> 1617 Error. 1618