├── .gitignore ├── COPYING ├── Makefile ├── README.asciidoc ├── TODO ├── changelog ├── doc ├── overview.edoc └── style.css ├── predef ├── bifs ├── cheats └── primops ├── purity ├── scripts ├── common ├── coredump ├── empty_plt ├── export_plt ├── extract ├── findsrc ├── purity_bifs ├── runtests └── utests ├── src ├── cl_parser.erl ├── cl_parser_tests.hrl ├── core_aliases.erl ├── purity.app.src ├── purity.erl ├── purity_analyse.erl ├── purity_cli.erl ├── purity_collect.erl ├── purity_plt.erl ├── purity_plt_tests.hrl ├── purity_stats.erl ├── purity_utils.erl ├── purity_utils_tests.hrl └── runtest.erl ├── test ├── args.erl ├── caseargs.erl ├── combined_analysis ├── d1 │ └── a.erl ├── d2 │ └── a.erl ├── dest.erl ├── duplicates ├── exceptions.erl ├── expr.erl ├── higher.erl ├── indirect.erl ├── letrec.erl ├── mutual.erl ├── names.erl ├── nested.erl ├── plt ├── selfrec.erl ├── simple.erl ├── term.erl └── values.erl └── vsn.mk /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | # Binaries and intermediate files: 3 | *.beam 4 | .*.swp 5 | *~ 6 | ebin/*.app 7 | src/purity_bifs.erl 8 | 9 | # Documentation related: 10 | doc/edoc-info 11 | doc/*.html 12 | doc/*.png 13 | doc/*.css 14 | !doc/style.css 15 | README.html 16 | 17 | # Byproducts of coredump script: 18 | *.{core,dump,labl} 19 | 20 | # etags 21 | TAGS 22 | 23 | # Common suffix of result/stats files: 24 | *.out 25 | *.sts 26 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 2.1, February 1999 3 | 4 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | [This is the first released version of the Lesser GPL. It also counts 10 | as the successor of the GNU Library Public License, version 2, hence 11 | the version number 2.1.] 12 | 13 | Preamble 14 | 15 | The licenses for most software are designed to take away your 16 | freedom to share and change it. By contrast, the GNU General Public 17 | Licenses are intended to guarantee your freedom to share and change 18 | free software--to make sure the software is free for all its users. 19 | 20 | This license, the Lesser General Public License, applies to some 21 | specially designated software packages--typically libraries--of the 22 | Free Software Foundation and other authors who decide to use it. You 23 | can use it too, but we suggest you first think carefully about whether 24 | this license or the ordinary General Public License is the better 25 | strategy to use in any particular case, based on the explanations below. 26 | 27 | When we speak of free software, we are referring to freedom of use, 28 | not price. Our General Public Licenses are designed to make sure that 29 | you have the freedom to distribute copies of free software (and charge 30 | for this service if you wish); that you receive source code or can get 31 | it if you want it; that you can change the software and use pieces of 32 | it in new free programs; and that you are informed that you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid 36 | distributors to deny you these rights or to ask you to surrender these 37 | rights. These restrictions translate to certain responsibilities for 38 | you if you distribute copies of the library or if you modify it. 39 | 40 | For example, if you distribute copies of the library, whether gratis 41 | or for a fee, you must give the recipients all the rights that we gave 42 | you. You must make sure that they, too, receive or can get the source 43 | code. If you link other code with the library, you must provide 44 | complete object files to the recipients, so that they can relink them 45 | with the library after making changes to the library and recompiling 46 | it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the 49 | library, and (2) we offer you this license, which gives you legal 50 | permission to copy, distribute and/or modify the library. 51 | 52 | To protect each distributor, we want to make it very clear that 53 | there is no warranty for the free library. Also, if the library is 54 | modified by someone else and passed on, the recipients should know 55 | that what they have is not the original version, so that the original 56 | author's reputation will not be affected by problems that might be 57 | introduced by others. 58 | 59 | Finally, software patents pose a constant threat to the existence of 60 | any free program. We wish to make sure that a company cannot 61 | effectively restrict the users of a free program by obtaining a 62 | restrictive license from a patent holder. Therefore, we insist that 63 | any patent license obtained for a version of the library must be 64 | consistent with the full freedom of use specified in this license. 65 | 66 | Most GNU software, including some libraries, is covered by the 67 | ordinary GNU General Public License. This license, the GNU Lesser 68 | General Public License, applies to certain designated libraries, and 69 | is quite different from the ordinary General Public License. We use 70 | this license for certain libraries in order to permit linking those 71 | libraries into non-free programs. 72 | 73 | When a program is linked with a library, whether statically or using 74 | a shared library, the combination of the two is legally speaking a 75 | combined work, a derivative of the original library. The ordinary 76 | General Public License therefore permits such linking only if the 77 | entire combination fits its criteria of freedom. The Lesser General 78 | Public License permits more lax criteria for linking other code with 79 | the library. 80 | 81 | We call this license the "Lesser" General Public License because it 82 | does Less to protect the user's freedom than the ordinary General 83 | Public License. It also provides other free software developers Less 84 | of an advantage over competing non-free programs. These disadvantages 85 | are the reason we use the ordinary General Public License for many 86 | libraries. However, the Lesser license provides advantages in certain 87 | special circumstances. 88 | 89 | For example, on rare occasions, there may be a special need to 90 | encourage the widest possible use of a certain library, so that it becomes 91 | a de-facto standard. To achieve this, non-free programs must be 92 | allowed to use the library. A more frequent case is that a free 93 | library does the same job as widely used non-free libraries. In this 94 | case, there is little to gain by limiting the free library to free 95 | software only, so we use the Lesser General Public License. 96 | 97 | In other cases, permission to use a particular library in non-free 98 | programs enables a greater number of people to use a large body of 99 | free software. For example, permission to use the GNU C Library in 100 | non-free programs enables many more people to use the whole GNU 101 | operating system, as well as its variant, the GNU/Linux operating 102 | system. 103 | 104 | Although the Lesser General Public License is Less protective of the 105 | users' freedom, it does ensure that the user of a program that is 106 | linked with the Library has the freedom and the wherewithal to run 107 | that program using a modified version of the Library. 108 | 109 | The precise terms and conditions for copying, distribution and 110 | modification follow. Pay close attention to the difference between a 111 | "work based on the library" and a "work that uses the library". The 112 | former contains code derived from the library, whereas the latter must 113 | be combined with the library in order to run. 114 | 115 | GNU LESSER GENERAL PUBLIC LICENSE 116 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 117 | 118 | 0. This License Agreement applies to any software library or other 119 | program which contains a notice placed by the copyright holder or 120 | other authorized party saying it may be distributed under the terms of 121 | this Lesser General Public License (also called "this License"). 122 | Each licensee is addressed as "you". 123 | 124 | A "library" means a collection of software functions and/or data 125 | prepared so as to be conveniently linked with application programs 126 | (which use some of those functions and data) to form executables. 127 | 128 | The "Library", below, refers to any such software library or work 129 | which has been distributed under these terms. A "work based on the 130 | Library" means either the Library or any derivative work under 131 | copyright law: that is to say, a work containing the Library or a 132 | portion of it, either verbatim or with modifications and/or translated 133 | straightforwardly into another language. (Hereinafter, translation is 134 | included without limitation in the term "modification".) 135 | 136 | "Source code" for a work means the preferred form of the work for 137 | making modifications to it. For a library, complete source code means 138 | all the source code for all modules it contains, plus any associated 139 | interface definition files, plus the scripts used to control compilation 140 | and installation of the library. 141 | 142 | Activities other than copying, distribution and modification are not 143 | covered by this License; they are outside its scope. The act of 144 | running a program using the Library is not restricted, and output from 145 | such a program is covered only if its contents constitute a work based 146 | on the Library (independent of the use of the Library in a tool for 147 | writing it). Whether that is true depends on what the Library does 148 | and what the program that uses the Library does. 149 | 150 | 1. You may copy and distribute verbatim copies of the Library's 151 | complete source code as you receive it, in any medium, provided that 152 | you conspicuously and appropriately publish on each copy an 153 | appropriate copyright notice and disclaimer of warranty; keep intact 154 | all the notices that refer to this License and to the absence of any 155 | warranty; and distribute a copy of this License along with the 156 | Library. 157 | 158 | You may charge a fee for the physical act of transferring a copy, 159 | and you may at your option offer warranty protection in exchange for a 160 | fee. 161 | 162 | 2. You may modify your copy or copies of the Library or any portion 163 | of it, thus forming a work based on the Library, and copy and 164 | distribute such modifications or work under the terms of Section 1 165 | above, provided that you also meet all of these conditions: 166 | 167 | a) The modified work must itself be a software library. 168 | 169 | b) You must cause the files modified to carry prominent notices 170 | stating that you changed the files and the date of any change. 171 | 172 | c) You must cause the whole of the work to be licensed at no 173 | charge to all third parties under the terms of this License. 174 | 175 | d) If a facility in the modified Library refers to a function or a 176 | table of data to be supplied by an application program that uses 177 | the facility, other than as an argument passed when the facility 178 | is invoked, then you must make a good faith effort to ensure that, 179 | in the event an application does not supply such function or 180 | table, the facility still operates, and performs whatever part of 181 | its purpose remains meaningful. 182 | 183 | (For example, a function in a library to compute square roots has 184 | a purpose that is entirely well-defined independent of the 185 | application. Therefore, Subsection 2d requires that any 186 | application-supplied function or table used by this function must 187 | be optional: if the application does not supply it, the square 188 | root function must still compute square roots.) 189 | 190 | These requirements apply to the modified work as a whole. If 191 | identifiable sections of that work are not derived from the Library, 192 | and can be reasonably considered independent and separate works in 193 | themselves, then this License, and its terms, do not apply to those 194 | sections when you distribute them as separate works. But when you 195 | distribute the same sections as part of a whole which is a work based 196 | on the Library, the distribution of the whole must be on the terms of 197 | this License, whose permissions for other licensees extend to the 198 | entire whole, and thus to each and every part regardless of who wrote 199 | it. 200 | 201 | Thus, it is not the intent of this section to claim rights or contest 202 | your rights to work written entirely by you; rather, the intent is to 203 | exercise the right to control the distribution of derivative or 204 | collective works based on the Library. 205 | 206 | In addition, mere aggregation of another work not based on the Library 207 | with the Library (or with a work based on the Library) on a volume of 208 | a storage or distribution medium does not bring the other work under 209 | the scope of this License. 210 | 211 | 3. You may opt to apply the terms of the ordinary GNU General Public 212 | License instead of this License to a given copy of the Library. To do 213 | this, you must alter all the notices that refer to this License, so 214 | that they refer to the ordinary GNU General Public License, version 2, 215 | instead of to this License. (If a newer version than version 2 of the 216 | ordinary GNU General Public License has appeared, then you can specify 217 | that version instead if you wish.) Do not make any other change in 218 | these notices. 219 | 220 | Once this change is made in a given copy, it is irreversible for 221 | that copy, so the ordinary GNU General Public License applies to all 222 | subsequent copies and derivative works made from that copy. 223 | 224 | This option is useful when you wish to copy part of the code of 225 | the Library into a program that is not a library. 226 | 227 | 4. You may copy and distribute the Library (or a portion or 228 | derivative of it, under Section 2) in object code or executable form 229 | under the terms of Sections 1 and 2 above provided that you accompany 230 | it with the complete corresponding machine-readable source code, which 231 | must be distributed under the terms of Sections 1 and 2 above on a 232 | medium customarily used for software interchange. 233 | 234 | If distribution of object code is made by offering access to copy 235 | from a designated place, then offering equivalent access to copy the 236 | source code from the same place satisfies the requirement to 237 | distribute the source code, even though third parties are not 238 | compelled to copy the source along with the object code. 239 | 240 | 5. A program that contains no derivative of any portion of the 241 | Library, but is designed to work with the Library by being compiled or 242 | linked with it, is called a "work that uses the Library". Such a 243 | work, in isolation, is not a derivative work of the Library, and 244 | therefore falls outside the scope of this License. 245 | 246 | However, linking a "work that uses the Library" with the Library 247 | creates an executable that is a derivative of the Library (because it 248 | contains portions of the Library), rather than a "work that uses the 249 | library". The executable is therefore covered by this License. 250 | Section 6 states terms for distribution of such executables. 251 | 252 | When a "work that uses the Library" uses material from a header file 253 | that is part of the Library, the object code for the work may be a 254 | derivative work of the Library even though the source code is not. 255 | Whether this is true is especially significant if the work can be 256 | linked without the Library, or if the work is itself a library. The 257 | threshold for this to be true is not precisely defined by law. 258 | 259 | If such an object file uses only numerical parameters, data 260 | structure layouts and accessors, and small macros and small inline 261 | functions (ten lines or less in length), then the use of the object 262 | file is unrestricted, regardless of whether it is legally a derivative 263 | work. (Executables containing this object code plus portions of the 264 | Library will still fall under Section 6.) 265 | 266 | Otherwise, if the work is a derivative of the Library, you may 267 | distribute the object code for the work under the terms of Section 6. 268 | Any executables containing that work also fall under Section 6, 269 | whether or not they are linked directly with the Library itself. 270 | 271 | 6. As an exception to the Sections above, you may also combine or 272 | link a "work that uses the Library" with the Library to produce a 273 | work containing portions of the Library, and distribute that work 274 | under terms of your choice, provided that the terms permit 275 | modification of the work for the customer's own use and reverse 276 | engineering for debugging such modifications. 277 | 278 | You must give prominent notice with each copy of the work that the 279 | Library is used in it and that the Library and its use are covered by 280 | this License. You must supply a copy of this License. If the work 281 | during execution displays copyright notices, you must include the 282 | copyright notice for the Library among them, as well as a reference 283 | directing the user to the copy of this License. Also, you must do one 284 | of these things: 285 | 286 | a) Accompany the work with the complete corresponding 287 | machine-readable source code for the Library including whatever 288 | changes were used in the work (which must be distributed under 289 | Sections 1 and 2 above); and, if the work is an executable linked 290 | with the Library, with the complete machine-readable "work that 291 | uses the Library", as object code and/or source code, so that the 292 | user can modify the Library and then relink to produce a modified 293 | executable containing the modified Library. (It is understood 294 | that the user who changes the contents of definitions files in the 295 | Library will not necessarily be able to recompile the application 296 | to use the modified definitions.) 297 | 298 | b) Use a suitable shared library mechanism for linking with the 299 | Library. A suitable mechanism is one that (1) uses at run time a 300 | copy of the library already present on the user's computer system, 301 | rather than copying library functions into the executable, and (2) 302 | will operate properly with a modified version of the library, if 303 | the user installs one, as long as the modified version is 304 | interface-compatible with the version that the work was made with. 305 | 306 | c) Accompany the work with a written offer, valid for at 307 | least three years, to give the same user the materials 308 | specified in Subsection 6a, above, for a charge no more 309 | than the cost of performing this distribution. 310 | 311 | d) If distribution of the work is made by offering access to copy 312 | from a designated place, offer equivalent access to copy the above 313 | specified materials from the same place. 314 | 315 | e) Verify that the user has already received a copy of these 316 | materials or that you have already sent this user a copy. 317 | 318 | For an executable, the required form of the "work that uses the 319 | Library" must include any data and utility programs needed for 320 | reproducing the executable from it. However, as a special exception, 321 | the materials to be distributed need not include anything that is 322 | normally distributed (in either source or binary form) with the major 323 | components (compiler, kernel, and so on) of the operating system on 324 | which the executable runs, unless that component itself accompanies 325 | the executable. 326 | 327 | It may happen that this requirement contradicts the license 328 | restrictions of other proprietary libraries that do not normally 329 | accompany the operating system. Such a contradiction means you cannot 330 | use both them and the Library together in an executable that you 331 | distribute. 332 | 333 | 7. You may place library facilities that are a work based on the 334 | Library side-by-side in a single library together with other library 335 | facilities not covered by this License, and distribute such a combined 336 | library, provided that the separate distribution of the work based on 337 | the Library and of the other library facilities is otherwise 338 | permitted, and provided that you do these two things: 339 | 340 | a) Accompany the combined library with a copy of the same work 341 | based on the Library, uncombined with any other library 342 | facilities. This must be distributed under the terms of the 343 | Sections above. 344 | 345 | b) Give prominent notice with the combined library of the fact 346 | that part of it is a work based on the Library, and explaining 347 | where to find the accompanying uncombined form of the same work. 348 | 349 | 8. You may not copy, modify, sublicense, link with, or distribute 350 | the Library except as expressly provided under this License. Any 351 | attempt otherwise to copy, modify, sublicense, link with, or 352 | distribute the Library is void, and will automatically terminate your 353 | rights under this License. However, parties who have received copies, 354 | or rights, from you under this License will not have their licenses 355 | terminated so long as such parties remain in full compliance. 356 | 357 | 9. You are not required to accept this License, since you have not 358 | signed it. However, nothing else grants you permission to modify or 359 | distribute the Library or its derivative works. These actions are 360 | prohibited by law if you do not accept this License. Therefore, by 361 | modifying or distributing the Library (or any work based on the 362 | Library), you indicate your acceptance of this License to do so, and 363 | all its terms and conditions for copying, distributing or modifying 364 | the Library or works based on it. 365 | 366 | 10. Each time you redistribute the Library (or any work based on the 367 | Library), the recipient automatically receives a license from the 368 | original licensor to copy, distribute, link with or modify the Library 369 | subject to these terms and conditions. You may not impose any further 370 | restrictions on the recipients' exercise of the rights granted herein. 371 | You are not responsible for enforcing compliance by third parties with 372 | this License. 373 | 374 | 11. If, as a consequence of a court judgment or allegation of patent 375 | infringement or for any other reason (not limited to patent issues), 376 | conditions are imposed on you (whether by court order, agreement or 377 | otherwise) that contradict the conditions of this License, they do not 378 | excuse you from the conditions of this License. If you cannot 379 | distribute so as to satisfy simultaneously your obligations under this 380 | License and any other pertinent obligations, then as a consequence you 381 | may not distribute the Library at all. For example, if a patent 382 | license would not permit royalty-free redistribution of the Library by 383 | all those who receive copies directly or indirectly through you, then 384 | the only way you could satisfy both it and this License would be to 385 | refrain entirely from distribution of the Library. 386 | 387 | If any portion of this section is held invalid or unenforceable under any 388 | particular circumstance, the balance of the section is intended to apply, 389 | and the section as a whole is intended to apply in other circumstances. 390 | 391 | It is not the purpose of this section to induce you to infringe any 392 | patents or other property right claims or to contest validity of any 393 | such claims; this section has the sole purpose of protecting the 394 | integrity of the free software distribution system which is 395 | implemented by public license practices. Many people have made 396 | generous contributions to the wide range of software distributed 397 | through that system in reliance on consistent application of that 398 | system; it is up to the author/donor to decide if he or she is willing 399 | to distribute software through any other system and a licensee cannot 400 | impose that choice. 401 | 402 | This section is intended to make thoroughly clear what is believed to 403 | be a consequence of the rest of this License. 404 | 405 | 12. If the distribution and/or use of the Library is restricted in 406 | certain countries either by patents or by copyrighted interfaces, the 407 | original copyright holder who places the Library under this License may add 408 | an explicit geographical distribution limitation excluding those countries, 409 | so that distribution is permitted only in or among countries not thus 410 | excluded. In such case, this License incorporates the limitation as if 411 | written in the body of this License. 412 | 413 | 13. The Free Software Foundation may publish revised and/or new 414 | versions of the Lesser General Public License from time to time. 415 | Such new versions will be similar in spirit to the present version, 416 | but may differ in detail to address new problems or concerns. 417 | 418 | Each version is given a distinguishing version number. If the Library 419 | specifies a version number of this License which applies to it and 420 | "any later version", you have the option of following the terms and 421 | conditions either of that version or of any later version published by 422 | the Free Software Foundation. If the Library does not specify a 423 | license version number, you may choose any version ever published by 424 | the Free Software Foundation. 425 | 426 | 14. If you wish to incorporate parts of the Library into other free 427 | programs whose distribution conditions are incompatible with these, 428 | write to the author to ask for permission. For software which is 429 | copyrighted by the Free Software Foundation, write to the Free 430 | Software Foundation; we sometimes make exceptions for this. Our 431 | decision will be guided by the two goals of preserving the free status 432 | of all derivatives of our free software and of promoting the sharing 433 | and reuse of software generally. 434 | 435 | NO WARRANTY 436 | 437 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 438 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 439 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 440 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 441 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 442 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 443 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 444 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 445 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 446 | 447 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 448 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 449 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 450 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 451 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 452 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 453 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 454 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 455 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 456 | DAMAGES. 457 | 458 | END OF TERMS AND CONDITIONS 459 | 460 | How to Apply These Terms to Your New Libraries 461 | 462 | If you develop a new library, and you want it to be of the greatest 463 | possible use to the public, we recommend making it free software that 464 | everyone can redistribute and change. You can do so by permitting 465 | redistribution under these terms (or, alternatively, under the terms of the 466 | ordinary General Public License). 467 | 468 | To apply these terms, attach the following notices to the library. It is 469 | safest to attach them to the start of each source file to most effectively 470 | convey the exclusion of warranty; and each file should have at least the 471 | "copyright" line and a pointer to where the full notice is found. 472 | 473 | 474 | Copyright (C) 475 | 476 | This library is free software; you can redistribute it and/or 477 | modify it under the terms of the GNU Lesser General Public 478 | License as published by the Free Software Foundation; either 479 | version 2.1 of the License, or (at your option) any later version. 480 | 481 | This library is distributed in the hope that it will be useful, 482 | but WITHOUT ANY WARRANTY; without even the implied warranty of 483 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 484 | Lesser General Public License for more details. 485 | 486 | You should have received a copy of the GNU Lesser General Public 487 | License along with this library; if not, write to the Free Software 488 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 489 | 490 | Also add information on how to contact you by electronic and paper mail. 491 | 492 | You should also get your employer (if you work as a programmer) or your 493 | school, if any, to sign a "copyright disclaimer" for the library, if 494 | necessary. Here is a sample; alter the names: 495 | 496 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 497 | library `Frob' (a library for tweaking knobs) written by James Random Hacker. 498 | 499 | , 1 April 1990 500 | Ty Coon, President of Vice 501 | 502 | That's all there is to it! 503 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # vim: set noet ts=8 sw=8: 2 | 3 | .PHONY: units clean count build_tests tests dialyzer_plt dialyzer docs 4 | 5 | ERLC ?= erlc 6 | DIALYZER ?= dialyzer 7 | 8 | EFLAGS += -DVSN='"$(VSN)"' +debug_info +warn_exported_vars +warn_unused_vars +warn_unused_import +warn_missing_spec 9 | DFLAGS += -n -Wunmatched_returns -Wunderspecs -Wrace_conditions -Wbehaviours 10 | 11 | ESRC ?= src 12 | EBIN ?= ebin 13 | TEST ?= test 14 | SCRIPTS ?= scripts 15 | 16 | include vsn.mk 17 | VSN := $(PURITY_VSN) 18 | 19 | FILES := purity purity_collect purity_analyse \ 20 | purity_cli purity_plt \ 21 | purity_utils purity_stats purity_bifs \ 22 | cl_parser core_aliases runtest 23 | 24 | SRC := $(addsuffix .erl, $(FILES)) 25 | BIN := $(addprefix $(EBIN)/, $(addsuffix .beam, $(FILES))) 26 | CHEATS := predef/cheats predef/bifs predef/primops 27 | 28 | APP_FILE := purity.app 29 | APP_SRC := $(APP_FILE).src 30 | APP := $(EBIN)/$(APP_FILE) 31 | 32 | 33 | GENERATED := $(ESRC)/purity_bifs.erl 34 | 35 | TEST_SRC := $(wildcard $(TEST)/*.erl) 36 | TEST_BIN := $(patsubst %.erl, %.beam, $(TEST_SRC)) 37 | 38 | 39 | all: $(EBIN) $(GENERATED) $(BIN) $(APP) 40 | 41 | ## Dependencies ## 42 | 43 | 44 | ## Generic rules ## 45 | 46 | # Mercurial does not track empty directories, so create build dir if missing. 47 | $(EBIN): 48 | mkdir -p $(EBIN) 49 | 50 | $(EBIN)/%.beam: $(ESRC)/%.erl $(ESRC)/%.hrl 51 | @echo " h ERLC $<" 52 | @$(ERLC) $(EFLAGS) -o $(EBIN) $< 53 | 54 | $(EBIN)/%.beam: $(ESRC)/%.erl $(ESRC)/%_tests.hrl 55 | @echo " t ERLC $<" 56 | @$(ERLC) $(EFLAGS) -o $(EBIN) $< 57 | 58 | $(EBIN)/%.beam: $(ESRC)/%.erl 59 | @echo " ERLC $<" 60 | @$(ERLC) $(EFLAGS) -o $(EBIN) $< 61 | 62 | 63 | $(TEST)/%.beam: $(TEST)/%.erl 64 | @echo "T ERLC $<" 65 | @$(ERLC) $(EFLAGS) -o $(dir $<) $< 66 | 67 | #.erl.beam: 68 | %.beam: %.erl 69 | $(ERLC) $(EFLAGS) -o $(dir $@) $< 70 | 71 | %.html: %.txt 72 | asciidoc $< 73 | 74 | $(ESRC)/purity_bifs.erl: $(CHEATS) 75 | @$(SCRIPTS)/purity_bifs $^ > $@ 76 | 77 | $(APP): $(ESRC)/$(APP_SRC) vsn.mk 78 | sed -e 's/%VSN%/$(VSN)/' $< > $@ 79 | 80 | ## Specific rules ## 81 | 82 | build_tests: $(TEST_BIN) 83 | @echo "Done building test files." 84 | 85 | tests: $(BIN) build_tests 86 | $(SCRIPTS)/runtests $(TEST_BIN) 87 | 88 | units: 89 | EFLAGS=-DTEST $(MAKE) 90 | @./scripts/utests `echo src/*_tests.hrl | sed 's/_tests//g'` 91 | 92 | 93 | dialyzer: $(EBIN) $(BIN) 94 | $(DIALYZER) $(DFLAGS) -c $(BIN) 95 | 96 | dialyzer_plt: 97 | $(DIALYZER) --build_plt --apps erts compiler dialyzer hipe kernel stdlib syntax_tools 98 | 99 | 100 | README.html: README.asciidoc TODO changelog 101 | asciidoc -a numbered $< 102 | 103 | # eDoc related stuff: 104 | APP_NAME = purity 105 | DOCOPTS = [{def,{vsn,"$(VSN)"}},{stylesheet,"style.css"},todo] 106 | 107 | DOCFILES := $(addsuffix .html, $(FILES) index overview-summary modules-frame packages-frame)\ 108 | erlang.png edoc-info 109 | 110 | docs: 111 | erl -noshell -run edoc_run application "'$(APP_NAME)'" '"."' '$(DOCOPTS)' 112 | 113 | 114 | clean: 115 | $(RM) $(BIN) 116 | 117 | distclean: clean 118 | $(RM) $(TEST_BIN) $(GENERATED) $(APP) README.html $(addprefix doc/,$(DOCFILES)) 119 | 120 | count: 121 | @sloccount . | awk '/^SLOC\t/,/^Total Physical/ { print }' | grep -v '^$$' 122 | 123 | -------------------------------------------------------------------------------- /README.asciidoc: -------------------------------------------------------------------------------- 1 | 2 | Purity 3 | ====== 4 | Michael Pitidis 5 | 6 | Purity is a static analyzer which determines the purity of Erlang 7 | functions. It can be used as a standalone application or as part of 8 | other applications, through a simple API. 9 | 10 | Installation 11 | ------------ 12 | After retrieving a copy of the source code with 13 | 14 | --------------- 15 | git clone git://github.com/mpitid/purity.git 16 | --------------- 17 | 18 | change into the `purity` directory and run `make` to build the code. 19 | 20 | Currently there is no mechanism for automated installation, so you will 21 | have to do the following manually: 22 | 23 | Add the directory to the `ERL_LIBS` environment variable. Assuming you 24 | cloned the code to your home directory, something like the following 25 | will suffice: 26 | 27 | -------------------------------- 28 | export ERL_LIBS="$HOME/purity" 29 | -------------------------------- 30 | 31 | Bash users may place this directive in their `$HOME/.bashrc` file, so 32 | that it's executed upon login. 33 | 34 | You also need to place a copy of the `purity` script in the toplevel 35 | directory to some other directory in your `PATH`, for instance 36 | `/usr/local/bin`. Alternatively you can add the cloned directory to the 37 | `PATH` environment variable as well, with 38 | 39 | -------------------------------- 40 | export PATH="$PATH:$HOME/purity" 41 | -------------------------------- 42 | 43 | To sum up, these are the complete instructions for a user of the bash 44 | shell: 45 | 46 | -------------------------------- 47 | git clone git://github.com/mpitid/purity.git 48 | cd purity 49 | make 50 | echo ERL_LIBS="`pwd`" >> $HOME/.bashrc 51 | echo PATH=\$PATH:`pwd` >> $HOME/.bashrc 52 | source $HOME/.bashrc 53 | -------------------------------- 54 | 55 | Purity has only been tested on Debian GNU/Linux so far. 56 | 57 | Usage 58 | ----- 59 | 60 | Consult the 'edoc' overview in the `doc/` directory. 61 | 62 | Licence 63 | ------- 64 | 65 | Purity 66 | Copyright (c) 2009-2010, Michael Pitidis, Kostis Sagonas 67 | 68 | Purity is distributed under the GNU Lesser General Public License 69 | (LGPL). This means that you can link Purity into proprietary 70 | applications, provided you follow the rules stated in the LGPL. You can 71 | also modify Purity; if you distribute a modified version, you must 72 | distribute it under the terms of the LGPL, which in particular means 73 | that you must release the source code for the modified software. See 74 | COPYING for more information. 75 | 76 | include::TODO[tabsize=4] 77 | include::changelog[tabsize=4] 78 | 79 | // vim: set ft=asciidoc tw=72: 80 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | 2 | == TODO 3 | 4 | .Urgent 5 | 6 | .Sometime 7 | - Somehow store guard *expressions* in the lookup table, so that guards 8 | like `when lists:all(fun pure/1, L)` can be resolved. 9 | 10 | .Maybe 11 | - Make error handling pure, by passing errors/warnings around in the 12 | state record 13 | 14 | - Add plt option to keep only certain applications in the PLT. This 15 | would provide more refined results, while making subsequent runs 16 | faster, given that only the kept subset is of interest to the user. 17 | 18 | // vim: set ft=asciidoc tw=72: 19 | -------------------------------------------------------------------------------- /changelog: -------------------------------------------------------------------------------- 1 | 2 | == Changelog 3 | 4 | .Version 0.2, September 2010 5 | 6 | First public release on github 7 | 8 | // vim: set ft=asciidoc tw=72: 9 | -------------------------------------------------------------------------------- /doc/overview.edoc: -------------------------------------------------------------------------------- 1 | 2 | -*- html -*- 3 | 4 | Purity overview page 5 | 6 | @author Michael Pitidis 7 | @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 8 | @version {@version} (purity {@vsn}) 9 | @title Purity - a lightweight side-effect analyser for Erlang programs 10 | 11 | @doc Purity is a static analyser which determines the purity of Erlang 12 | functions. It can be used as a standalone application, or as part of the 13 | Erlang compiler, to allow for user defined pure functions to be used as 14 | guards in Erlang programs. 15 | 16 |
    17 |
  • {@section Introduction}
    • 18 |
  • {@section Getting started}
    • 19 |
  • {@section Analysing your code}
    • 20 |
    • {@section Levels of Purity}
    21 |
  • {@section Purity API}
    • 22 |
  • {@section Compatibility}
    • 23 |
24 | 25 | == Introduction == 26 | 27 | Purity can be invoked from the command line with a helper script, as 28 | long as the `ERL_LIBS' environment variable points to the correct 29 | installation path. Assuming you have downloaded and compiled the purity 30 | distribution in the directory `$HOME/src/purity', you have to place a 31 | line like the following in your `$HOME/.bashrc' file: 32 | 33 | ```export ERL_LIBS="$HOME/src/purity"''' 34 | 35 | Other shells offer similar mechanisms for setting environment variables. 36 | 37 | == Getting started == 38 | 39 | To get started with Purity, one usually needs to create a Persistent 40 | Lookup Table (PLT) first. This should contain analysis results of 41 | frequently used libraries, such as parts of the Open Telecoms Platform 42 | (OTP). To create a PLT of some common OTP applications in the default 43 | location (`$HOME/.purity.plt') run the following: 44 | 45 | ```purity --build-plt --quiet --apps erts stdlib kernel''' 46 | 47 | Any application in the Erlang code path can be added, as well as 48 | other directories containing BEAM files. 49 | 50 | == Analysing your code == 51 | 52 | To test your own code, you can invoke purity in a similar way, with the 53 | `--apps' option, or just pass it any BEAM file you wish. Make sure these 54 | are compiled with `+debug_info' however. Alternatively you can also 55 | provide Erlang source files, but working with BEAM files is the 56 | preferred mode of operation, since this correctly handles header file 57 | includes and guarantees the lack of compilation errors. 58 | 59 | Assuming you are in your project directory and your built files are 60 | placed in the `ebin' directory: 61 | ```purity --apps ebin''' 62 | 63 | or for source files: 64 | ```purity src/*.erl''' 65 | 66 | You can increase the verbosity with the `-v' option, and collect 67 | statistics regarding the analysis results with the `-s ' 68 | option. You can also see which functions are not known to the analysis 69 | with the `-m' option. 70 | 71 | ``` 72 | $ purity -v -m -s my_stats -o my_results src/*.erl 73 | 74 | Analyzing the following files: 75 | src/cl_parser.erl 76 | src/core_aliases.erl 77 | src/purity_bifs.erl 78 | src/purity_cli.erl 79 | src/purity.erl 80 | src/purity_hofs.erl 81 | src/purity_plt.erl 82 | src/purity_stats.erl 83 | src/purity_utils.erl 84 | Loading PLT ... done in 0m01.36s 85 | Traversing AST ... done in 0m00.64s 86 | Propagating values ... done in 0m01.12s 87 | Generating statistics ... done in 0m00.08s 88 | Analysis completed in 0m03.29s 89 | ''' 90 | 91 | === Levels of Purity === 92 | 93 | Purity distinguishes between three properties which may classify a 94 | function as impure: 95 | 96 |
    97 |
  1. Presence of side-effects
    2. 98 |
  2. Dependencies on the environment of execution (non-determinism)
    3. 99 |
  3. Presence of exceptions
    4. 100 |
101 | 102 | These are organised in a way so that they form progressively stricter 103 | criteria, which can be selected by the `--level' command line option. 104 | Level 1 will consider functions pure only if they lack side-effects. 105 | Level 2 will add a further constraint, that functions should also lack 106 | dependencies on the execution environment. Finally, level 3 will also 107 | require that functions may never raise an exception of any type. The 108 | default is level 1. 109 | 110 | An example will better illustrate this. Consider the following three 111 | functions: 112 | 113 | ``` 114 | -module(example). 115 | 116 | may_raise(X) -> 117 | 42 / X. 118 | 119 | read(Val) -> 120 | get(key). 121 | 122 | write(Val) -> 123 | put(key, Val). 124 | ''' 125 | 126 | Depending on the value of the `--level' command line option, the results 127 | of the analysis will vary in the following ways: 128 | 129 | ``` 130 | $ purity example.erl 131 | Results: 132 | example:may_raise/1 true. 133 | example:read/1 true. 134 | example:write/1 {false,"call to impure erlang:put/2"}. 135 | 136 | $ purity example.erl --level 2 137 | Results: 138 | example:may_raise/1 true. 139 | example:read/1 {false,"call to impure erlang:get/1"}. 140 | example:write/1 {false,"call to impure erlang:put/2"}. 141 | 142 | $ purity example.erl --level 3 143 | example:may_raise/1 {false,"call to impure erlang:'/'/2"}. 144 | example:read/1 {false,"call to impure erlang:get/1"}. 145 | example:write/1 {false,"call to impure erlang:put/2"}. 146 | ''' 147 | 148 | Note how the difference in levels of purity produces different results 149 | for the functions. The `write/1' function will always be impure, because 150 | it modifies the execution environment (a side-effect). `The read/0' 151 | function on the other hand only depends on the execution environment 152 | (making it non-deterministic), and will thus require a level of at least 153 | 2 to be considered impure. Finally, the `may_raise/1' function depends 154 | on the division operator, which in turn may raise an exception 155 | (arithmetic error or badarg), but is otherwise pure. Thus it will only be 156 | considered impure at level 3. 157 | 158 | == Purity API == 159 | 160 | In order to use purity with your application, you will most likely need 161 | to call some of the functions in the {@link purity} and {@link 162 | purity_plt} modules. 163 | 164 | Have a look at the corresponding documentation, in particular the {@link 165 | purity:module/2}, {@link purity:module/3} and {@link purity:propagate/2} 166 | functions. 167 | 168 | Roughly, you should load a PLT if necessary, proceed to build a 169 | dependency list with a call to {@link purity:module/3}, and then derive 170 | concrete results with a call to {@link purity:propagate/2}. The result 171 | is a lookup table (a dict), indexed by a `{Module, Function, Arity}' 172 | tuple. You can perform simple boolean queries with {@link 173 | purity:is_pure/2}. 174 | 175 | == Compatibility == 176 | 177 | Purity has been tested under Erlang R13 and Erlang R14. 178 | 179 | Purity has only been tested on Debian GNU/Linux so far, but it should 180 | work fine on most GNU/Linux distributions and other Unix systems 181 | supported by Erlang. Non-Unix systems are theoretically supported, but 182 | have not been tested. To invoke purity without the script wrapper from 183 | the command line, execute: 184 | 185 | ```erl -noshell -run purity_cli main -extra ''' 186 | 187 | where `' represents any files or command line arguments you wish 188 | to pass to it. 189 | 190 | -------------------------------------------------------------------------------- /doc/style.css: -------------------------------------------------------------------------------- 1 | /* Customisation of the standard EDoc style sheet */ 2 | 3 | body { 4 | font-family: Verdana, Arial, Helvetica, sans-serif; 5 | margin-left: .25in; 6 | margin-right: .2in; 7 | margin-top: 0.2in; 8 | margin-bottom: 0.2in; 9 | color: #000000; 10 | background-color: #ffffff; 11 | text-align: justify; 12 | } 13 | h1,h2,h3,h4,h5,h6 { 14 | text-align: left; 15 | } 16 | h1,h2 { 17 | margin-left: -0.2in; 18 | } 19 | div.navbar { 20 | background-color: #add8e6; 21 | padding: 0.2em; 22 | } 23 | h2.indextitle { 24 | padding: 0.4em; 25 | background-color: #add8e6; 26 | } 27 | h3.function,h3.typedecl { 28 | background-color: #add8e6; 29 | padding-left: 1em; 30 | } 31 | div.spec { 32 | margin-left: 2em; 33 | background-color: #eeeeee; 34 | } 35 | a.module,a.package { 36 | text-decoration:none 37 | } 38 | a.module:hover,a.package:hover { 39 | background-color: #eeeeee; 40 | } 41 | ul.definitions { 42 | list-style-type: none; 43 | } 44 | ul.index { 45 | list-style-type: none; 46 | background-color: #eeeeee; 47 | } 48 | 49 | /* 50 | * Minor style tweaks 51 | */ 52 | ul { 53 | list-style-type: none; 54 | } 55 | table { 56 | border-collapse: collapse; 57 | } 58 | td { 59 | padding: 3 60 | } 61 | -------------------------------------------------------------------------------- /predef/bifs: -------------------------------------------------------------------------------- 1 | ## Tab or space separated list of MFAs and their hard-coded purity. 2 | # Empty lines and those starting with # are ignored. 3 | # `se' stands for Side-Effect 4 | # `nd' stands for Non-Determinism 5 | # `ex' stands for Exceptions 6 | # While possible for `ex' to complement `nd', the current implementation 7 | # will always consider 'ex' impure iff 'nd' is also impure. 8 | # When it is not clear whether a value has side-effects, it will 9 | # be simply marked with `false'. 10 | binary,at,2 e 11 | binary,bin_to_list,1 e 12 | binary,bin_to_list,2 e 13 | binary,bin_to_list,3 e 14 | binary,compile_pattern,1 e 15 | binary,copy,1 16 | binary,copy,2 17 | binary,decode_unsigned,1 18 | binary,decode_unsigned,2 19 | binary,encode_unsigned,1 20 | binary,encode_unsigned,2 21 | binary,first,1 22 | binary,last,1 23 | binary,list_to_bin,1 24 | binary,longest_common_prefix,1 25 | binary,longest_common_suffix,1 26 | binary,match,2 27 | binary,match,3 28 | binary,matches,2 29 | binary,matches,3 30 | binary,part,2 31 | binary,part,3 32 | binary,referenced_byte_size,1 33 | 34 | code,get_chunk,2 s 35 | code,is_module_native,1 d 36 | code,make_stub_module,3 s 37 | code,module_md5,1 d 38 | 39 | erlang,'-',1 e 40 | erlang,'+',1 e 41 | erlang,'<',2 p 42 | erlang,'=<',2 p 43 | erlang,'==',2 p 44 | erlang,'=:=',2 p 45 | erlang,'=/=',2 p 46 | erlang,'>=',2 p 47 | erlang,'>',2 p 48 | erlang,'--',2 e 49 | erlang,'-',2 e 50 | erlang,'/=',2 p 51 | erlang,'/',2 e 52 | erlang,'!',2 s 53 | erlang,'*',2 e 54 | erlang,'+',2 e 55 | erlang,'++',2 e 56 | erlang,abs,1 e 57 | erlang,adler32,1 e 58 | erlang,adler32,2 e 59 | erlang,adler32_combine,3 e 60 | erlang,'and',2 e 61 | erlang,append,2 e 62 | erlang,append_element,2 e 63 | ## It's not possible to handle apply/3, since at compile time we cannot 64 | ## resolve the actual function it calls (unknown arity). In all other 65 | ## cases the compiler converts it to a direct call/3 primitive. 66 | erlang,apply,3 >= e 67 | erlang,atom_to_binary,2 e 68 | erlang,atom_to_list,1 e 69 | erlang,'band',2 e 70 | erlang,binary_part,2 e 71 | erlang,binary_part,3 e 72 | erlang,binary_to_atom,2 e 73 | erlang,binary_to_existing_atom,2 e 74 | erlang,binary_to_list,1 e 75 | erlang,binary_to_list,3 e 76 | erlang,binary_to_term,1 e 77 | erlang,binary_to_term,2 e 78 | erlang,bit_size,1 e 79 | erlang,bitstring_to_list,1 e 80 | erlang,blocking_read_file,1 d 81 | erlang,'bnot',1 e 82 | erlang,'bor',2 e 83 | erlang,'bsl',2 e 84 | erlang,'bsr',2 e 85 | erlang,bump_reductions,1 s 86 | erlang,'bxor',2 e 87 | erlang,byte_size,1 e 88 | # XXX unsure. 89 | erlang,call_on_load_function,1 s 90 | erlang,cancel_timer,1 s 91 | erlang,check_process_code,2 d 92 | erlang,crc32,1 e 93 | erlang,crc32,2 e 94 | erlang,crc32_combine,3 e 95 | erlang,date,0 d 96 | erlang,decode_packet,3 e 97 | erlang,delete_module,1 s 98 | erlang,demonitor,1 s 99 | erlang,demonitor,2 s 100 | erlang,display,1 s 101 | erlang,display_nl,0 s 102 | erlang,display_string,1 s 103 | erlang,dist_exit,3 s 104 | erlang,'div',2 e 105 | erlang,element,2 e 106 | erlang,erase,0 s 107 | erlang,erase,1 s 108 | # error and exit are special, they represent exceptions. 109 | erlang,error,1 e 110 | erlang,error,2 e 111 | # nif_error is identical to error, its only use is to trick dialyzer. 112 | erlang,nif_error,1 e 113 | erlang,nif_error,2 e 114 | erlang,exit,1 e 115 | erlang,exit,2 s 116 | erlang,external_size,1 p 117 | # I think this is called after an attemp to load some new code 118 | # and may remove that code if loading failed. 119 | erlang,finish_after_on_load,2 s 120 | erlang,float,1 e 121 | erlang,float_to_list,1 e 122 | # XXX: Not sure about these two. I guess since a module can be reloaded, 123 | # their results can vary across calls. 124 | erlang,function_exported,3 d 125 | erlang,fun_info,2 d 126 | erlang,fun_to_list,1 e 127 | erlang,garbage_collect,0 s 128 | erlang,garbage_collect,1 s 129 | erlang,garbage_collect_message_area,0 s 130 | erlang,get,0 d 131 | erlang,get,1 d 132 | erlang,get_keys,1 d 133 | erlang,get_module_info,1 d 134 | erlang,get_module_info,2 d 135 | erlang,get_stacktrace,0 d 136 | erlang,group_leader,0 d 137 | erlang,group_leader,2 s 138 | erlang,halt,0 s 139 | erlang,halt,1 s 140 | erlang,hash,2 e 141 | erlang,hd,1 e 142 | erlang,hibernate,3 s 143 | erlang,integer_to_list,1 e 144 | erlang,iolist_size,1 e 145 | erlang,iolist_to_binary,1 e 146 | erlang,is_alive,0 d 147 | erlang,is_atom,1 p 148 | erlang,is_binary,1 p 149 | erlang,is_bitstring,1 p 150 | erlang,is_boolean,1 p 151 | erlang,is_builtin,3 e 152 | erlang,is_float,1 p 153 | erlang,is_function,1 p 154 | erlang,is_function,2 e 155 | erlang,is_integer,1 p 156 | erlang,is_list,1 p 157 | erlang,is_number,1 p 158 | erlang,is_pid,1 p 159 | erlang,is_port,1 p 160 | erlang,is_process_alive,1 d 161 | erlang,is_record,2 p 162 | erlang,is_record,3 p 163 | erlang,is_reference,1 p 164 | erlang,is_tuple,1 p 165 | erlang,length,1 e 166 | erlang,link,1 s 167 | erlang,list_to_atom,1 e 168 | erlang,list_to_binary,1 e 169 | erlang,list_to_bitstring,1 e 170 | erlang,list_to_existing_atom,1 e 171 | erlang,list_to_float,1 e 172 | erlang,list_to_integer,1 e 173 | erlang,list_to_pid,1 e 174 | erlang,list_to_tuple,1 e 175 | erlang,loaded,0 d 176 | erlang,load_module,2 s 177 | erlang,load_nif,2 s 178 | erlang,localtime,0 d 179 | erlang,localtime_to_universaltime,2 d 180 | erlang,make_fun,3 e 181 | # The reason this is a side-effect is because the hidden VM 182 | # state is altered with each call to make_ref/0. 183 | erlang,make_ref,0 s 184 | erlang,make_tuple,2 e 185 | erlang,make_tuple,3 e 186 | # No idea what this does. XXX unsure 187 | erlang,match_spec_test,3 s 188 | erlang,md5,1 e 189 | erlang,md5_final,1 e 190 | erlang,md5_init,0 e 191 | erlang,md5_update,2 e 192 | erlang,memory,0 d 193 | erlang,memory,1 d 194 | erlang,module_loaded,1 d 195 | erlang,monitor,2 s 196 | erlang,monitor_node,2 s 197 | erlang,monitor_node,3 s 198 | erlang,node,0 d 199 | erlang,node,1 d 200 | erlang,nodes,1 d 201 | erlang,'not',1 e 202 | erlang,now,0 d 203 | erlang,open_port,2 s 204 | erlang,'or',2 e 205 | erlang,phash,2 e 206 | erlang,phash2,1 e 207 | erlang,phash2,2 e 208 | erlang,pid_to_list,1 e 209 | # Not sure how this port commands should be characterised. 210 | erlang,port_call,2 s 211 | erlang,port_call,3 s 212 | erlang,port_close,1 s 213 | erlang,port_command,2 s 214 | erlang,port_command,3 s 215 | erlang,port_connect,2 s 216 | erlang,port_control,3 s 217 | erlang,port_get_data,1 s 218 | erlang,port_info,1 d 219 | erlang,port_info,2 d 220 | erlang,ports,0 d 221 | erlang,port_set_data,2 s 222 | erlang,port_to_list,1 e 223 | erlang,pre_loaded,0 d 224 | erlang,process_display,2 s 225 | erlang,processes,0 d 226 | erlang,process_flag,2 s 227 | erlang,process_flag,3 s 228 | erlang,process_info,1 d 229 | erlang,process_info,2 d 230 | erlang,purge_module,1 s 231 | erlang,put,2 s 232 | erlang,raise,3 e 233 | erlang,read_timer,1 d 234 | erlang,ref_to_list,1 e 235 | erlang,register,2 s 236 | erlang,registered,0 d 237 | erlang,'rem',2 e 238 | erlang,resume_process,1 s 239 | erlang,round,1 e 240 | erlang,self,0 d 241 | erlang,send,2 s 242 | erlang,send,3 s 243 | erlang,send_after,3 s 244 | erlang,seq_trace,2 s 245 | # The fact that this is rt is merely an assumption... 246 | erlang,seq_trace_info,1 d 247 | # THe following two pass a message to the system_tracer 248 | erlang,seq_trace_print,1 s 249 | erlang,seq_trace_print,2 s 250 | erlang,setelement,3 e 251 | erlang,setnode,2 s 252 | erlang,setnode,3 s 253 | erlang,size,1 e 254 | erlang,spawn,3 s 255 | erlang,spawn_link,3 s 256 | erlang,spawn_opt,1 s 257 | erlang,split_binary,2 e 258 | erlang,start_timer,3 s 259 | # Statistics has side-effects since it may return 260 | # the time passed from a previous call, hence it marks 261 | # the time when its called. Or does time since last call 262 | # stand for something else? XXX 263 | erlang,statistics,1 s 264 | erlang,subtract,2 e 265 | erlang,suspend_process,2 s 266 | erlang,system_flag,2 s 267 | erlang,system_info,1 d 268 | erlang,system_monitor,0 d 269 | erlang,system_monitor,1 s 270 | erlang,system_monitor,2 s 271 | erlang,system_profile,0 d 272 | erlang,system_profile,2 s 273 | erlang,term_to_binary,1 e 274 | erlang,term_to_binary,2 e 275 | erlang,throw,1 e 276 | erlang,time,0 d 277 | erlang,tl,1 e 278 | erlang,trace,3 s 279 | erlang,trace_delivered,1 s 280 | erlang,trace_info,2 d 281 | erlang,trace_pattern,2 s 282 | erlang,trace_pattern,3 s 283 | erlang,trunc,1 e 284 | erlang,tuple_size,1 e 285 | erlang,tuple_to_list,1 e 286 | erlang,universaltime,0 d 287 | erlang,universaltime_to_localtime,1 d 288 | erlang,unlink,1 s 289 | erlang,unregister,1 s 290 | erlang,whereis,1 d 291 | erlang,'xor',2 e 292 | erl_ddll,demonitor,1 s 293 | # hmm, this is at least rt because of some peculiarities, but not sure in general. XXX unsure 294 | erl_ddll,format_error_int,1 s 295 | erl_ddll,info,2 d 296 | erl_ddll,loaded_drivers,0 d 297 | erl_ddll,monitor,2 s 298 | erl_ddll,try_load,3 s 299 | erl_ddll,try_unload,2 s 300 | error_logger,warning_map,0 d 301 | erts_debug,breakpoint,2 s 302 | # XXX unsure 303 | erts_debug,disassemble,1 s 304 | erts_debug,display,1 s 305 | # XXX unsure for the following 3 306 | erts_debug,dist_ext_to_term,2 s 307 | erts_debug,dump_links,1 s 308 | erts_debug,dump_monitors,1 s 309 | erts_debug,flat_size,1 p 310 | ## Not really sure about this. 311 | erts_debug,get_internal_state,1 d 312 | erts_debug,lock_counters,1 s 313 | erts_debug,same,2 p 314 | erts_debug,set_internal_state,2 s 315 | # XXX Refine, not so sure about the rt values. 316 | ets,all,0 d 317 | ets,delete,1 s 318 | ets,delete,2 s 319 | ets,delete_all_objects,1 s 320 | ets,delete_object,2 s 321 | ets,first,1 d 322 | ets,give_away,3 s 323 | ets,info,1 d 324 | ets,info,2 d 325 | ets,insert,2 s 326 | ets,insert_new,2 s 327 | ets,is_compiled_ms,1 p 328 | ets,last,1 d 329 | ets,lookup,2 d 330 | ets,lookup_element,3 d 331 | ets,match,1 d 332 | ets,match,2 d 333 | ets,match,3 d 334 | ets,match_object,1 d 335 | ets,match_object,2 d 336 | ets,match_object,3 d 337 | ets,match_spec_compile,1 e 338 | ets,match_spec_run_r,3 e 339 | ets,member,2 d 340 | ets,new,2 s 341 | ets,next,2 d 342 | ets,prev,2 d 343 | ets,rename,2 s 344 | ets,safe_fixtable,2 s 345 | ets,select,1 d 346 | ets,select,2 d 347 | ets,select,3 d 348 | ets,select_count,2 d 349 | ets,select_delete,2 s 350 | ets,select_reverse,1 d 351 | ets,select_reverse,2 d 352 | ets,select_reverse,3 d 353 | ets,setopts,2 s 354 | ets,slot,2 d 355 | ets,update_counter,3 s 356 | ets,update_element,3 s 357 | ## Lists 358 | lists,keyfind,3 e 359 | lists,keymember,3 e 360 | lists,keysearch,3 e 361 | lists,member,2 e 362 | lists,reverse,2 e 363 | ## Math 364 | math,acos,1 e 365 | math,acosh,1 e 366 | math,asin,1 e 367 | math,asinh,1 e 368 | math,atan,1 e 369 | math,atan2,2 e 370 | math,atanh,1 e 371 | math,cos,1 e 372 | math,cosh,1 e 373 | math,erf,1 e 374 | math,erfc,1 e 375 | math,exp,1 e 376 | math,log,1 e 377 | math,log10,1 e 378 | math,pow,2 e 379 | math,sin,1 e 380 | math,sinh,1 e 381 | math,sqrt,1 e 382 | math,tan,1 e 383 | math,tanh,1 e 384 | 385 | # I presume this returns whether a process has the unicode 386 | # IO flag defined or not. 387 | net_kernel,dflag_unicode_io,1 d 388 | 389 | os,getenv,0 d 390 | os,getenv,1 d 391 | os,getpid,0 d 392 | os,putenv,2 s 393 | os,timestamp,0 d 394 | 395 | re,compile,1 e 396 | re,compile,2 e 397 | re,run,2 e 398 | re,run,3 e 399 | 400 | string,to_float,1 p 401 | string,to_integer,1 p 402 | 403 | unicode,bin_is_7bit,1 p 404 | unicode,characters_to_binary,2 e 405 | unicode,characters_to_list,2 e 406 | -------------------------------------------------------------------------------- /predef/cheats: -------------------------------------------------------------------------------- 1 | ## Tab or space separated list of MFAs and their hard-coded purity. 2 | ## This file has functions which, while not BIFs, are useful to have hard-coded. 3 | ## Refer to the `bifs' for a more thorough explanation of the format. 4 | # vim: set noet ts=8: 5 | ## erlang 6 | erlang,apply,2 e [{arg,1}] 7 | erlang,spawn,1 s 8 | erlang,spawn,4 s 9 | erlang,integer_to_list,2 e [{remote,{erlang,integer_to_list,1},[]}] 10 | erlang,list_to_integer,2 e [{remote,{erlang,list_to_integer,1},[]}] 11 | erlang,localtime_to_universaltime,1 d [{remote,{erlang,localtime_to_universaltime,2},[]}] 12 | erlang,max,2 p 13 | erlang,min,2 p 14 | ## Many functions depend on this but we can't analyse it fully atm. 15 | io_lib,format,2 e 16 | #lists,duplicate,2 e 17 | -------------------------------------------------------------------------------- /predef/primops: -------------------------------------------------------------------------------- 1 | ## Tab or space separated list of Primops and their hard-coded purity. 2 | ## Refer to `bifs' for a more thorough explanation. 3 | bs_context_to_binary,1 p 4 | bs_init_writable,1 p 5 | match_fail,1 e 6 | raise,2 e 7 | -------------------------------------------------------------------------------- /purity: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # Wrapper script for easier invocation of purity. 3 | 4 | source scripts/common 5 | 6 | erl_exec purity_cli main -extra $@ 7 | 8 | -------------------------------------------------------------------------------- /scripts/common: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # vim: set et ts=4 sw=4: 3 | 4 | erl_exec() { 5 | erl -pa ebin -noshell -run $@ 6 | } 7 | 8 | die() { 9 | echo >&2 "Fatal: $@" 10 | exit 1 11 | } 12 | 13 | make_tempfile() { 14 | mktemp $@ || die "Could not create temporary file." 15 | } 16 | 17 | # Strip .erl suffix. 18 | strip_suffix() { 19 | echo ${@/.erl/} 20 | } 21 | 22 | # Generate usage function, without all the boilerplate. 23 | make_usage() { 24 | name=$(basename $0) 25 | short=$1 26 | description=() 27 | shift 28 | for line in "$@"; do 29 | description+=("echo -e \" $line\";") 30 | done 31 | 32 | eval "`cat < 7 | lists:foreach(fun(F) -> dump(F) end, Filenames). 8 | 9 | dump(Filename) -> 10 | try coredump(Filename) catch _:Error -> 11 | io:format(standard_error, "Dumping of file '~s' failed (~p)~n", 12 | [Filename, Error]) 13 | end. 14 | 15 | %% Dump core erlang source and concrete representation to corresponding files. 16 | -spec coredump(string()) -> ok. 17 | 18 | coredump(Filename) -> 19 | Options = [binary, copt, to_core, report_errors, report_warnings], 20 | {ok, Module, Core} = case suffix(Filename) of 21 | ".erl" -> 22 | compile:file(Filename, Options); 23 | ".beam" -> 24 | {ok, Abs} = dialyzer_utils:get_abstract_code_from_beam(Filename), 25 | compile:forms(Abs, Options) 26 | end, 27 | {Labeled, _} = cerl_trees:label(cerl:from_records(Core)), 28 | Basename = atom_to_list(Module), 29 | ok = write(Basename ++ ".core", core_pp:format(Core)), 30 | ok = write(Basename ++ ".dump", Core), 31 | ok = write(Basename ++ ".labl", Labeled). 32 | 33 | 34 | -spec write(string(), any()) -> ok. 35 | 36 | write(Filename, Data) -> 37 | io:format("Writing to file ~p.~n", [Filename]), 38 | Bytes = if is_list(Data) -> Data; true -> io_lib:format("~p~n", [Data]) end, 39 | file:write_file(Filename, Bytes). 40 | 41 | 42 | -spec suffix(string()) -> string(). 43 | 44 | suffix(Filename) -> 45 | string:to_lower(filename:extension(Filename)). 46 | 47 | -------------------------------------------------------------------------------- /scripts/empty_plt: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %% -*- erlang -*- 3 | %%! -pa ebin -sname empty_plt 4 | %% vim: set ft=erlang ts=4 sw=4 et: 5 | 6 | main([Out]) -> 7 | case purity_plt:save(purity_plt:new(), Out) of 8 | ok -> ok; 9 | {error, Rsn} -> 10 | io:format("ERROR: ~s", [Rsn]), 11 | halt(1) 12 | end. 13 | 14 | -------------------------------------------------------------------------------- /scripts/export_plt: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %% -*- erlang -*- 3 | %%! -pa ebin -sname export_plt 4 | %% vim: set ft=erlang ts=4 sw=4 et: 5 | 6 | main([PltFile, ExportFile]) -> 7 | {ok, Plt} = purity_plt:load(PltFile), 8 | ok = file:write_file(ExportFile, purity_plt:export_text(Plt)). 9 | 10 | -------------------------------------------------------------------------------- /scripts/extract: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | """ 4 | Extract expected test results from Erlang source files and write to 5 | separate files, grouped by option sets. 6 | 7 | The format of test results is: 8 | %< global OPTIONS 9 | %< OPTIONS? FUN RESULT 10 | 11 | where: 12 | * OPTIONS is an erlang list of option tuples. 13 | * FUN identifies a function either as a {module,function,arity} 14 | tuple or function/arity specification. 15 | * RESULT is an erlang term representing the expected result. 16 | 17 | """ 18 | 19 | import os.path, re, sys 20 | from collections import defaultdict 21 | 22 | module = None 23 | 24 | def main(argv): 25 | global module 26 | if len(argv) != 3: 27 | print>>sys.stderr, "usage: %s " % argv[0] 28 | return 1 29 | filename, outdir = argv[1:] 30 | module = os.path.basename(os.path.splitext(filename)[0]) 31 | with open(filename, 'rb') as fd: 32 | opts, data = extract(fd) 33 | for i, (k, v) in enumerate(data): 34 | print write_tests(outfile(outdir, module, i), opts, k, v) 35 | return 0 36 | 37 | def outfile(dir, mod, n): 38 | return os.path.join(dir, "%s.%s" % (mod, n)) 39 | 40 | def write_tests(filename, gopts, opts, data): 41 | assert not os.path.exists(filename), "file exists %r" % filename 42 | with open(filename, 'w') as fd: 43 | fd.write("{%s,\n" % merge_opts(gopts, opts)) 44 | data = ["{%s,%s}" % (f, v) for (f,v) in data.iteritems()] 45 | fd.write(" [" + "\n ,".join(data) + "]}.\n") 46 | return filename 47 | 48 | def extract(lines): 49 | opts = None 50 | tests = defaultdict(dict) 51 | for line in lines: 52 | line = line.strip() 53 | if is_test(line): 54 | if is_global(line): 55 | assert not opts, "multiple global statements" 56 | opts = parse_global(line) 57 | else: 58 | opt, fun, result = parse_test(line) 59 | fun = parse_fun(fun) 60 | assert fun not in tests[opt], "duplicate test %r" % fun 61 | tests[opt][fun] = structure(result) 62 | return opts, merge_tests(tests) 63 | 64 | def structure(result): 65 | rgx = re.compile('(>= )?([peds])(.+)?') 66 | match = rgx.match(result) 67 | if not match: 68 | return result # Old style matching 69 | ge, p, deps = match.groups() 70 | if ge is not None: 71 | p = '{at_least, %s}' % p 72 | deps = '[]' if deps is None else deps.strip() 73 | return '{%s, %s}' % (p, deps) 74 | 75 | def merge_tests(tests): 76 | """Fill incomplete tests with the corresponding default test.""" 77 | common = tests[None] 78 | keys = set(k for v in tests.values() for k in v.keys()) 79 | for k, v in tests.iteritems(): 80 | for k in keys: 81 | if k not in v and common: # Can't do anything if no common case exists. 82 | v[k] = common[k] 83 | if not common: 84 | # Remove it, it was just created by the defaultdict. 85 | del tests[None] 86 | return tuple(tests.iteritems()) 87 | 88 | def merge_opts(*opts): 89 | """Merge a list of option lists into a single option list.""" 90 | # Filter out None/empty lists. 91 | return "[%s]" % (','.join(opt[1:-1] for opt in opts if opt)) 92 | 93 | def is_test(text): 94 | return "%<" in text 95 | 96 | def is_global(text): 97 | assert is_test(text) 98 | return text.lstrip(" %<").startswith("global") 99 | 100 | def parse_global(text): 101 | return text.replace("global", "").lstrip(" %<") 102 | 103 | def parse_test(text): 104 | rgx = re.compile("(?:(\[[^]]*\])\s+)?([^ ]+)\s+(.+)\s*$") 105 | return rgx.match(text.lstrip(' %<')).groups() 106 | 107 | def parse_fun(fun): 108 | """Convert fun/arity specifications to {module,fun,arity}.""" 109 | rgx = re.compile("(\w+|'[a-zA-Z0-9_-]+')/(\d)") 110 | m = rgx.match(fun) 111 | if m is not None: 112 | f, a = m.groups() 113 | return "{%s,%s,%s}" % (module,f, a) 114 | return fun 115 | 116 | 117 | if __name__ == '__main__': 118 | sys.exit(main(sys.argv)) 119 | -------------------------------------------------------------------------------- /scripts/findsrc: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %% -*- erlang -*- 3 | %% vim: set ft=erlang ts=4 sw=4 et: 4 | %%! -sname findsrc 5 | %%% Print the full path to the source code of the module specified. 6 | 7 | main([Module]) -> 8 | case filename:find_src(list_to_atom(Module)) of 9 | {error, {Rsn, Mod}} -> 10 | io:format(standard_error, 11 | "Could not locate source for module '~s' (~p).~n", [Mod, Rsn]), 12 | halt(1); 13 | {Path, _Options} -> 14 | io:format("~s.erl~n", [Path]) 15 | end; 16 | main(_) -> 17 | io:format("usage: ~s module~n", [filename:basename(escript:script_name())]), 18 | halt(1). 19 | 20 | -------------------------------------------------------------------------------- /scripts/purity_bifs: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ## Strip comments and lines with undefined functions. 4 | strip_bare() { 5 | sed '/^#/ d; 6 | /^.\+[ \t]\+.\+$/ p; 7 | d' $@ 8 | } 9 | 10 | ## Expand aliases for pureness values. 11 | expand_purity() { 12 | sed -r ' 13 | s/[ \t]+>= ([peds])$/ {{at_least,\1},[]}/; 14 | s/[ \t]+([peds])$/ {\1,[]}/; 15 | s/[ \t]+([peds])( +\[.+\])$/ {\1,\2}/; 16 | ' $@ 17 | } 18 | 19 | convert() { 20 | sed ' 21 | s/^/is_pure(/; 22 | s/[ \t]\+/) -> \n /; 23 | s/$/;/ 24 | ' $@ 25 | } 26 | 27 | select_funs() { 28 | sed '/^[^,]\+,[^,]\+,[0-9]\+[ \t]\+/p; d' $@ 29 | } 30 | 31 | select_primops() { 32 | sed '/^[^,]\+,[0-9]\+[ \t]\+/p; d' $@ 33 | } 34 | 35 | header() { 36 | cat < purity:pure() | unknown. 44 | 45 | EOF 46 | } 47 | 48 | footer1() { 49 | cat <= 0, A =< 255 -> 51 | unknown. 52 | 53 | -spec is_known(atom(), atom(), arity()) -> boolean(). 54 | 55 | is_known(M, F, A) -> 56 | is_pure(M, F, A) =/= unknown. 57 | 58 | -spec is_pure(atom(), arity()) -> purity:pure() | unknown. 59 | 60 | EOF 61 | } 62 | 63 | footer2() { 64 | cat <= 0, A =< 255 -> 66 | unknown. 67 | 68 | -spec is_known(atom(), arity()) -> boolean(). 69 | 70 | is_known(P, A) -> 71 | is_pure(P, A) =/= unknown. 72 | 73 | 74 | %% Combine the two functions into one for convenience. 75 | 76 | -spec is_pure(term()) -> purity:pure() | unknown. 77 | 78 | is_pure({M,F,A}) -> 79 | is_pure(M, F, A); 80 | is_pure({P, A}) -> 81 | is_pure(P, A); 82 | is_pure(_) -> 83 | unknown. 84 | 85 | -spec is_known(term()) -> boolean(). 86 | 87 | is_known(BIF) -> 88 | is_pure(BIF) =/= unknown. 89 | 90 | EOF 91 | } 92 | 93 | 94 | if [[ -n $@ ]]; then 95 | header 96 | strip_bare $@ | select_funs | expand_purity | convert 97 | footer1 98 | strip_bare $@ | select_primops | expand_purity | convert 99 | footer2 100 | fi 101 | -------------------------------------------------------------------------------- /scripts/runtests: -------------------------------------------------------------------------------- 1 | #!/bin/zsh 2 | 3 | scripts=$(dirname $0) 4 | source $scripts/common 5 | tests=test 6 | 7 | main() { 8 | dir=$(make_tempfile -dt ptests.XXXXXXX) 9 | P=0 10 | F=0 11 | for test in $@; do 12 | for exp in $($scripts/extract ${test:r}.erl $dir); do 13 | runtest $test $exp $dir && passed $exp || failed 14 | done 15 | done 16 | rmdir $dir 17 | report 18 | 19 | extra_tests 20 | } 21 | 22 | runtest() { erl_exec runtest main $@ } 23 | passed() { ((P++)); rm $1 } 24 | failed() { ((F++)) } 25 | report() { 26 | if ((F>0)); then echo "$F/$((P+F)) TESTS FAILED" 27 | else echo "ALL $P TESTS PASSED"; fi 28 | } 29 | 30 | extra_tests() { 31 | $tests/duplicates $tests/d1/a.erl $tests/d2/a.erl 32 | #$tests/combined_analysis $tests/*.erl 33 | $tests/plt ebin/*.beam $tests/*.beam 34 | } 35 | 36 | main $@ 37 | -------------------------------------------------------------------------------- /scripts/utests: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %% -*- erlang -*- 3 | %% vim: set ft=erlang: 4 | %% Execute any unit tests for the specified modules. 5 | 6 | main([]) -> 7 | io:format("usage: ~s module(s)~n", 8 | [filename:basename(escript:script_name())]), 9 | halt(1); 10 | main(Tests) -> 11 | case lists:member(error, [test(T) || T <- Tests]) of 12 | true -> 13 | halt(1); 14 | false -> 15 | ok 16 | end. 17 | 18 | test(Filename) -> 19 | Module = list_to_atom(filename:rootname(filename:basename(Filename))), 20 | io:format("~s~n", [Module]), 21 | eunit:test({inparallel, Module}). 22 | 23 | -------------------------------------------------------------------------------- /src/cl_parser.erl: -------------------------------------------------------------------------------- 1 | %% ==================================================================== 2 | %% This library is free software; you can redistribute it and/or 3 | %% modify it under the terms of the GNU Lesser General Public 4 | %% License as published by the Free Software Foundation; either 5 | %% version 2.1 of the License, or (at your option) any later version. 6 | %% 7 | %% This library is distributed in the hope that it will be useful, 8 | %% but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | %% Lesser General Public License for more details. 11 | %% 12 | %% You should have received a copy of the GNU Lesser General Public 13 | %% License along with this library; if not, write to the Free Software 14 | %% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 15 | %% 02110-1301 USA 16 | %% 17 | %% @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 18 | %% @author Michael Pitidis 19 | %% @end 20 | %% ===================================================================== 21 | 22 | %%% 23 | %%% @doc Configurable command line argument parser. 24 | %%% 25 | %%% This module is loosely modeled after the `optparse' Python module, 26 | %%% but is significantly more limited. 27 | %%% 28 | 29 | -module(cl_parser). 30 | 31 | -export([parse_args/2, parse_args/3]). 32 | 33 | -ifdef(TEST). 34 | -include("cl_parser_tests.hrl"). 35 | -endif. 36 | 37 | -type desc() :: [{atom(), [any()]}]. 38 | -type options() :: [atom() | {atom(), any()}]. 39 | -type arguments() :: [string()]. 40 | 41 | %% A reference to the finalized description in it's original form 42 | %% is preserved in `desc', for use with pretty_print/2. 43 | -record(spec, {names = dict:new() :: dict(), 44 | types = dict:new() :: dict(), 45 | help = dict:new() :: dict(), 46 | defaults = dict:new() :: dict(), 47 | desc = [] :: desc()}). 48 | 49 | 50 | %% @doc Parse the command line and return a 2-tuple of options 51 | %% and plain arguments. 52 | %% 53 | %% Desc is a list of tuples, describing the command line arguments, e.g. 54 | %% ``` 55 | %% [{help, 56 | %% ["-h", "--help", {type, bool}, {help, "Produce this help message"}], 57 | %% {conf, 58 | %% ["-c", "--conf", {type, string}, {help, "Path to configuration file"}]}] 59 | %% ''' 60 | %% The help option is added by default. The default type is `string', 61 | %% which expects one argument, and can be omitted from the description. 62 | %% It's not necessary to specify both short and long options. 63 | %% 64 | %% Options is a list of atoms or tuples of atoms and values, depending 65 | %% on the type. In our example, if `-h' and `-c test.cnf' was specified it 66 | %% would be `[help,{conf,"test.cnf"}]'. 67 | %% 68 | %% @see parse_args/3 69 | 70 | -spec parse_args(desc(), string()) -> {options(), arguments()}. 71 | 72 | parse_args(Desc, Usage) -> 73 | parse_args(Desc, Usage, []). 74 | 75 | 76 | %% @doc The `Extra' argument is a list of post-processing instructions 77 | %% to be applied in the parsed option list. Currently two operations are 78 | %% supported: 79 | %%
80 | %%
`only_keep_last'
81 | %%
Only keep the last occurrence for options specified multiple 82 | %% times.
83 | %%
`{override, [ {opt1, opt2} | ... ] }'
84 | %%
Remove any occurrence of `opt2' when `opt1' is present in the 85 | %% option list.
86 | %%
87 | %% 88 | %% @see parse_args/2 89 | 90 | -spec parse_args(desc(), string(), [any()]) -> {options(), arguments()}. 91 | 92 | parse_args(Desc, Usage, Extra) -> 93 | Specs = build_specs(Desc), 94 | Args = init:get_plain_arguments(), 95 | try parse(Args, Specs) of 96 | {Opts, Rest} -> 97 | case lists:member(help, Opts) of 98 | true -> 99 | pretty_print(Usage, Specs), 100 | init:stop(); 101 | false -> 102 | {lists:foldl(fun postprocess/2, Opts, Extra), Rest} 103 | end 104 | catch 105 | throw:{parser_error, Msg} -> 106 | io:format("Parser error: ~s.~n", [Msg]), 107 | init:stop(1) 108 | end. 109 | 110 | 111 | build_specs(Descriptions) -> 112 | PrepDesc = add_if_missing( 113 | {help, ["-h", "--help", {type,bool}, {help,"Print this help message"}]}, 114 | [prepare(D) || D <- Descriptions]), 115 | lists:foldl( 116 | fun({Name, Desc}, Spec) -> 117 | lists:foldl(fun(D, S) -> build_spec(Name, D, S) end, Spec, Desc) 118 | end, 119 | #spec{desc = PrepDesc}, 120 | PrepDesc). 121 | 122 | prepare({Name, Desc}) -> 123 | Desc1 = add_if_missing({type, string}, Desc), 124 | Desc2 = add_if_missing({help, "Undocumented"}, Desc1), 125 | {Name, Desc2}. 126 | 127 | add_if_missing({Key, _} = Value, Desc) -> 128 | case lists:keysearch(Key, 1, Desc) of 129 | {value, _} -> 130 | Desc; 131 | false -> 132 | [Value|Desc] 133 | end. 134 | 135 | 136 | build_spec(Name, "--" ++ Long, #spec{names = Names} = Spec) -> 137 | Spec#spec{names = dict:store(Long, Name, Names)}; 138 | build_spec(Name, "-" ++ Short, #spec{names = Names} = Spec) -> 139 | Spec#spec{names = dict:store(Short, Name, Names)}; 140 | build_spec(Name, {type, Type}, #spec{types = Types} = Spec) -> 141 | Spec#spec{types = dict:store(Name, Type, Types)}; 142 | build_spec(Name, {help, Msg}, #spec{help = Help} = Spec) -> 143 | Spec#spec{help = dict:store(Name, Msg, Help)}; 144 | build_spec(Name, {default, Value}, #spec{defaults = Defaults} = Spec) -> 145 | Spec#spec{defaults = dict:store(Name, Value, Defaults)}. 146 | 147 | 148 | parse(Arguments, #spec{defaults = D} = Spec) -> 149 | {Options0, Rest} = parse(Arguments, Spec, [], []), 150 | Options1 = dict:fold(fun add_default/3, Options0, D), 151 | {Options1, lists:reverse(Rest)}. 152 | 153 | add_default(Opt, Value, Opts) -> 154 | case proplists:get_value(Opt, Opts) of 155 | undefined -> 156 | opt_add(Opts, Opt, Value); 157 | _ -> 158 | Opts 159 | end. 160 | 161 | parse([], _, Options, Rest) -> 162 | {Options, Rest}; 163 | parse(["--"|T], _Spec, Options, Rest) -> 164 | %% Stop interpreting options. 165 | {Options, lists:reverse(T, Rest)}; 166 | parse(["-" ++ _ = Option|T], Spec, Options, Rest) -> 167 | OptName = strip_dashes(Option), 168 | assert_valid_option(Option, Spec), 169 | Name = opt_name(OptName, Spec), 170 | {Remaining, NewOptions} = case opt_type(Name, Spec) of 171 | bool -> 172 | {T, opt_add(Options, Name)}; 173 | int -> 174 | {Rem, [Value]} = opt_take(T, 1, OptName), 175 | {Rem, opt_add(Options, Name, list_to_integer(Value))}; 176 | {intchoice, Choices} -> 177 | {Rem, [SValue]} = opt_take(T, 1, OptName), 178 | IValue = list_to_integer(SValue), 179 | case lists:member(IValue, Choices) of 180 | true -> 181 | {Rem, opt_add(Options, Name, IValue)}; 182 | false -> 183 | opt_error("Invalid choice, pick one between ~p", [Choices]) 184 | end; 185 | multiple -> 186 | case T of 187 | [] -> 188 | opt_error("Option ~p expects at least one argument", [OptName]); 189 | _ -> 190 | {Rem, Values} = opt_take_all(T, []), 191 | {Rem, opt_add(Options, Name, Values)} 192 | end; 193 | string -> 194 | {Rem, [Value]} = opt_take(T, 1, OptName), 195 | {Rem, opt_add(Options, Name, Value)} 196 | end, 197 | parse(Remaining, Spec, NewOptions, Rest); 198 | parse([Arg|T], Spec, Options, Rest) -> 199 | parse(T, Spec, Options, [Arg|Rest]). 200 | 201 | 202 | opt_add(Options, Opt) -> 203 | [Opt|Options]. 204 | 205 | opt_add(Options, Opt, Value) -> 206 | [{Opt, Value}|Options]. 207 | 208 | opt_name(Opt, #spec{names = Names}) -> 209 | dict:fetch(Opt, Names). 210 | 211 | opt_type(Opt, #spec{types = Types}) -> 212 | dict:fetch(Opt, Types). 213 | 214 | opt_take([], N, Name) when N > 0 -> 215 | opt_error("Option ~p expects ~p more argument(s)", [Name, N]); 216 | opt_take([Val|Options], N, Name) when N > 0 -> 217 | {Remaining, Values} = opt_take(Options, N-1, Name), 218 | {Remaining, [Val | Values]}; 219 | opt_take(Options, 0, _) -> 220 | {Options, []}. 221 | 222 | %% @doc Collect any non-option argument until none is left, or 223 | %% an option is encountered. 224 | opt_take_all([], Acc) -> 225 | {[], Acc}; 226 | opt_take_all(["-"++_|_]=Remaining, Acc) -> 227 | {Remaining, lists:reverse(Acc)}; 228 | opt_take_all([Val|Opts], Acc) -> 229 | opt_take_all(Opts, [Val|Acc]). 230 | 231 | 232 | opt_error(Msg, Args) -> 233 | erlang:throw({parser_error, io_lib:format(Msg, Args)}). 234 | 235 | assert_valid_option(Opt, #spec{names = Names}) -> 236 | case dict:find(strip_dashes(Opt), Names) of 237 | {ok, _} -> 238 | ok; 239 | error -> 240 | opt_error("Unrecognised option ~p", [Opt]) 241 | end. 242 | 243 | strip_dashes("-" ++ Rest) -> 244 | strip_dashes(Rest); 245 | strip_dashes(Rest) -> 246 | Rest. 247 | 248 | 249 | pretty_print(Usage, #spec{desc = Desc}) -> 250 | io:format("~s~n~n", [Usage]), 251 | lists:foreach(fun pretty_print/1, Desc). 252 | 253 | pretty_print({_, Desc}) -> 254 | Flag1 = string:join([Opt || [$-|_] = Opt <- Desc], "|"), 255 | Flag2 = string:join([Flag1 | ["VALUE" || {type, string} <- Desc]], "="), 256 | {help, Msg} = lists:keyfind(help, 1, Desc), 257 | io:format(" ~s~n\t\t~s~n", [Flag2, Msg]). 258 | 259 | 260 | postprocess({override, Rules}, Opts0) -> 261 | Funs = compile_overrides(Rules), 262 | lists:foldl(fun(F, OptsN) -> F(OptsN) end, Opts0, Funs); 263 | postprocess(only_keep_last, Opts) -> 264 | lists:usort(fun opts_cmp/2, lists:reverse(Opts)). 265 | 266 | compile_overrides(Rules) -> 267 | lists:map( 268 | fun({O1, O2}) -> fun(Opts) -> override(O1, O2, Opts) end end, Rules). 269 | 270 | override(O1, O2, Opts) -> 271 | case lists:any(fun(O) -> matching_opt(O1, O) end, Opts) of 272 | true -> 273 | [Opt || Opt <- Opts, not matching_opt(O2, Opt)]; 274 | false -> 275 | Opts 276 | end. 277 | 278 | %% @doc Match boolean as well as value currying options ({key, value}). 279 | matching_opt(Opt, Opt) -> 280 | true; 281 | matching_opt(Opt, {Opt, _}) -> 282 | true; 283 | matching_opt(_, _) -> 284 | false. 285 | 286 | %% @doc Compare two options in such a way so that {key, value} options 287 | %% are considered equal no matter the value. 288 | opts_cmp({Opt, _}, {Opt, _}) -> 289 | true; 290 | opts_cmp(A, B) -> 291 | A =< B. 292 | 293 | -------------------------------------------------------------------------------- /src/cl_parser_tests.hrl: -------------------------------------------------------------------------------- 1 | 2 | -include_lib("eunit/include/eunit.hrl"). 3 | 4 | opts_cmp_test_() -> 5 | [?_assert(opts_cmp({key, 1}, {key, 1})) 6 | ,?_assert(opts_cmp({key, 1}, {key, 2})) 7 | ,?_assert(opts_cmp({k1, 1}, {k2, 2})) 8 | ,?_assertNot(opts_cmp({k3, 3}, {k2, 3})) 9 | ,?_assertNot(opts_cmp(b, a)) 10 | ,?_assertMatch([b,{a,1}], lists:usort(fun opts_cmp/2, [{a,1},b,{a,3}])) 11 | ]. 12 | 13 | matching_opt_test_() -> 14 | [?_assert(matching_opt(key, key)) 15 | ,?_assert(matching_opt(key, {key, val})) 16 | ,?_assertNot(matching_opt(key, val)) 17 | ,?_assertNot(matching_opt(key, {val, key})) 18 | ]. 19 | 20 | override_test_() -> 21 | [?_assertMatch([b,a], override(a, c, [c,b,c,a])) 22 | ,?_assertMatch([c,b,c], override(a, c, [c,b,c])) 23 | ,?_assertMatch([a,b], override(a, c, [a,{c,1},b,{c,2},c])) 24 | ,?_assertMatch([a,b,c,c], override(a, d, [a,b,c,c])) 25 | ,?_assertMatch([b,{a,1}], override(a, c, [b,{a,1},{c,2}])) 26 | ]. 27 | 28 | postprocess_test_() -> 29 | [?_assertMatch([b,a], postprocess({override, [{a,c},{b,d}]}, [c,b,{d,42},a])) 30 | ,?_assertMatch([b,{a,3}], postprocess(only_keep_last, [{a,1},b,{a,3}])) 31 | %% Postprocessing order should not be important for these operations: 32 | ,?_assertMatch([q,t,{c,2}], postprocess(only_keep_last, 33 | postprocess({override, [{t,p}, {t,b}]}, 34 | [{c,1},{p,1},q,t,{p,2},{c,2}]))) 35 | ,?_assertMatch([q,t,{c,2}], postprocess({override, [{t,p}, {t,b}]}, 36 | postprocess(only_keep_last, 37 | [{c,1},{p,1},q,t,{p,2},{c,2}]))) 38 | ]. 39 | 40 | -------------------------------------------------------------------------------- /src/core_aliases.erl: -------------------------------------------------------------------------------- 1 | %% ==================================================================== 2 | %% This library is free software; you can redistribute it and/or 3 | %% modify it under the terms of the GNU Lesser General Public 4 | %% License as published by the Free Software Foundation; either 5 | %% version 2.1 of the License, or (at your option) any later version. 6 | %% 7 | %% This library is distributed in the hope that it will be useful, 8 | %% but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | %% Lesser General Public License for more details. 11 | %% 12 | %% You should have received a copy of the GNU Lesser General Public 13 | %% License along with this library; if not, write to the Free Software 14 | %% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 15 | %% 02110-1301 USA 16 | %% 17 | %% @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 18 | %% @author Michael Pitidis 19 | %% @end 20 | %% ===================================================================== 21 | 22 | %%% 23 | %%% @doc Locate aliases to variables in core erlang expressions. 24 | %%% 25 | 26 | -module(core_aliases). 27 | 28 | -export([scan/1]). 29 | 30 | -type name() :: cerl:var_name(). 31 | 32 | %% @doc Scan a core erlang function and return a mapping of alias names to 33 | %% the corresponding variables names. 34 | %% 35 | %% We are only interested in the reverse mapping of variable aliases, 36 | %% which should also be unique, so the expression 37 | %% `case of 38 | %% -> ... 39 | %% -> ... 40 | %% when true -> match_fail' 41 | %% will produce a mapping of `{Pred, cor1}', `{List, cor2}' and `{cor3, cor2}'. 42 | 43 | -spec scan(cerl:c_fun()) -> dict(). 44 | 45 | scan(Fun) -> 46 | true = cerl:is_c_fun(Fun), 47 | Map = cerl_trees:fold(fun collect_aliases/2, [], cerl:fun_body(Fun)), 48 | reverse_map(lists:flatten(Map)). 49 | 50 | 51 | %% @doc Collect viariable aliases from case expressions. 52 | %% 53 | %% XXX: Relies on current implementation of the core erlang generator, 54 | %% where each function has unique variable names. 55 | 56 | -spec collect_aliases(cerl:cerl(), [{name(), name()}]) -> [{name(), name()}]. 57 | 58 | collect_aliases(Tree, VarMap) -> 59 | case cerl:type(Tree) of 60 | 'case' -> 61 | %% We are only interested in arguments that are variables, 62 | %% lists, or tuples. 63 | %% TODO: Binaries could be supported as well. 64 | Arg = cerl:case_arg(Tree), 65 | Clauses = cerl:case_clauses(Tree), 66 | New = case cerl:type(Arg) of 67 | var -> 68 | {ok, Name} = var_name(Arg), 69 | threefold(fun get_var_aliases/3, Name, Clauses); 70 | values -> 71 | Nodes = cerl:values_es(Arg), 72 | threefold(fun get_tuple_aliases/3, Nodes, Clauses); 73 | cons -> 74 | Values = flatten_cons(Arg), 75 | threefold(fun get_list_aliases/3, Values, Clauses); 76 | _ -> 77 | [] 78 | end, 79 | [New | VarMap]; 80 | _ -> 81 | VarMap 82 | end. 83 | 84 | 85 | %% @doc Return a reverse mapping of the associative list KeyVals. 86 | %% Any elements which have multiple associations, are omitted. 87 | 88 | -spec reverse_map([{name(), name()}]) -> dict(). 89 | 90 | reverse_map(KeyVals) -> 91 | Acc = {dict:new(), []}, 92 | {Dict, ToPurge} = lists:foldl(fun add_rev_unique/2, Acc, KeyVals), 93 | lists:foldl(fun(K, D) -> dict:erase(K, D) end, Dict, ToPurge). 94 | 95 | 96 | -spec add_rev_unique({name(), name()}, {dict(), [name()]}) -> {dict(), [name()]}. 97 | 98 | add_rev_unique({Key, Key}, Acc) -> 99 | Acc; 100 | add_rev_unique({Value, Key}, {Dict, ToPurge} = Acc) -> 101 | case dict:find(Key, Dict) of 102 | {ok, Value} -> 103 | Acc; 104 | {ok, _} -> 105 | %% Same name aliased to different variable across clauses. 106 | %% Can't handle it in a meaningful way, so schedule it for 107 | %% removal. 108 | {Dict, [Key|ToPurge]}; 109 | error -> 110 | {dict:store(Key, Value, Dict), ToPurge} 111 | end. 112 | 113 | 114 | threefold(Fun, Extra, List) -> 115 | lists:foldl(fun(Elem, Acc) -> Fun(Extra, Elem, Acc) end, [], List). 116 | 117 | 118 | get_var_aliases(Name1, Clause, Map) -> 119 | case cerl:clause_pats(Clause) of 120 | [Pattern] -> 121 | case var_name(Pattern) of 122 | {ok, Name2} -> 123 | [{Name1, Name2} | Map]; 124 | _ -> 125 | Map 126 | end; 127 | _ -> 128 | Map 129 | end. 130 | 131 | 132 | get_tuple_aliases(Values, Clause, Map) -> 133 | Patterns = cerl:clause_pats(Clause), 134 | [all_or_nothing(Values, Patterns) | Map]. 135 | 136 | 137 | get_list_aliases(Values, Clause, Map) -> 138 | [Pattern] = cerl:clause_pats(Clause), 139 | [all_or_nothing(Values, flatten_cons(Pattern)) | Map]. 140 | 141 | 142 | %% @doc Return any subtrees in a cons tree as a flat list. Works 143 | %% for improper lists as well. 144 | flatten_cons(Node) -> 145 | case cerl:type(Node) of 146 | cons -> 147 | [cerl:cons_hd(Node) | flatten_cons(cerl:cons_tl(Node))]; 148 | _ -> 149 | [Node] 150 | end. 151 | 152 | 153 | %% @doc Map names in `L1' to names in `L2', only if all elements 154 | %% of both lists represent variables or aliases. 155 | 156 | -spec all_or_nothing([cerl:cerl()], [cerl:cerl()]) -> [{name(), name()}]. 157 | 158 | all_or_nothing(L1, L2) -> 159 | all_or_nothing(L1, L2, []). 160 | 161 | all_or_nothing([V1|T1], [V2|T2], Acc0) -> 162 | Acc1 = case {var_name(V1), var_name(V2)} of 163 | %% Only return variable/aliases, literals etc are not interesting. 164 | {{ok, N1}, {ok, N2}} -> 165 | [{N1, N2} | Acc0]; 166 | _ -> 167 | Acc0 168 | end, 169 | all_or_nothing(T1, T2, Acc1); 170 | all_or_nothing([], [], Acc) -> 171 | Acc; 172 | %% Lists lengths don't match, ignore anything found so far, and return nothing. 173 | all_or_nothing(_, _, _) -> 174 | []. 175 | 176 | 177 | %% @doc Return the name of a term if it represents a variable or alias. 178 | 179 | -spec var_name(cerl:cerl()) -> error | {ok, cerl:var_name()}. 180 | 181 | var_name(Tree) -> 182 | case cerl:type(Tree) of 183 | var -> 184 | {ok, cerl:var_name(Tree)}; 185 | alias -> 186 | {ok, cerl:var_name(cerl:alias_var(Tree))}; 187 | _ -> 188 | error 189 | end. 190 | 191 | -------------------------------------------------------------------------------- /src/purity.app.src: -------------------------------------------------------------------------------- 1 | % vim: set ft=erlang: 2 | 3 | {application, purity, 4 | [{description, "Purity Analyzer for Erlang programs, version %VSN%"}, 5 | {vsn, "%VSN%"}, 6 | {modules, [purity, 7 | purity_plt, 8 | purity_cli, 9 | purity_hofs, 10 | purity_stats, 11 | purity_utils, 12 | core_aliases, 13 | cl_parser]}, 14 | {registered, []}, 15 | {applications, [compiler, stdlib]}, 16 | {env, []}]}. 17 | 18 | -------------------------------------------------------------------------------- /src/purity.erl: -------------------------------------------------------------------------------- 1 | %% ==================================================================== 2 | %% This library is free software; you can redistribute it and/or 3 | %% modify it under the terms of the GNU Lesser General Public 4 | %% License as published by the Free Software Foundation; either 5 | %% version 2.1 of the License, or (at your option) any later version. 6 | %% 7 | %% This library is distributed in the hope that it will be useful, 8 | %% but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | %% Lesser General Public License for more details. 11 | %% 12 | %% You should have received a copy of the GNU Lesser General Public 13 | %% License along with this library; if not, write to the Free Software 14 | %% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 15 | %% 02110-1301 USA 16 | %% 17 | %% @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 18 | %% @author Michael Pitidis 19 | %% @end 20 | %% ===================================================================== 21 | 22 | %%% 23 | %%% @doc Pureness analysis of Erlang functions. 24 | %%% 25 | 26 | % FIXME: 27 | % - Add separate predefined values for termination. 28 | % - Characterise higher order function arguments as remote/local. 29 | 30 | % TODO 31 | 32 | 33 | -module(purity). 34 | 35 | -define(collect, purity_collect). 36 | -define(analyse, purity_analyse). 37 | -define(utils, purity_utils). 38 | -define(plt, purity_plt). 39 | 40 | 41 | -export([module/1, files/1, pfiles/1]). 42 | 43 | -export([propagate/2, propagate/3]). 44 | 45 | -export([module/2, is_pure/2, find_missing/1, analyse_changed/3]). 46 | 47 | -export_type([pure/0]). 48 | 49 | 50 | -type plt() :: purity_plt:plt(). 51 | -type pure() :: purity_analyse:pure(). 52 | -type options() :: purity_utils:options(). 53 | 54 | 55 | -spec module(cerl:c_module()) -> dict(). 56 | 57 | module(Core) -> 58 | ?collect:module(Core). 59 | 60 | -spec files([string()]) -> dict(). 61 | 62 | files(Filenames) -> 63 | ?collect:files(Filenames). 64 | 65 | -spec pfiles([string()]) -> dict(). 66 | 67 | pfiles(Filenames) -> 68 | ?collect:pfiles(Filenames). 69 | 70 | 71 | -spec propagate(dict(), options()) -> dict(). 72 | 73 | propagate(Tab, Opts) -> 74 | ?analyse:propagate(Tab, Opts). 75 | 76 | 77 | -spec propagate(dict(), purity_plt:plt(), options()) -> dict(). 78 | 79 | propagate(Tab, Plt, Opts) -> 80 | ?analyse:analyse(Tab, Plt, Opts). 81 | 82 | 83 | %% @doc Simple purity test, only distinguishes between pure and impure. 84 | %% Any function missing from the lookup table is also considered impure. 85 | -spec is_pure(mfa(), dict()) -> boolean(). 86 | 87 | is_pure({_,_,_} = MFA, Table) -> 88 | case dict:find(MFA, Table) of 89 | {ok, {p, []}} -> 90 | true; 91 | _ -> 92 | false 93 | end. 94 | 95 | %% @doc Analyse a module and return a lookup table of concrete results, 96 | %% indexed by `{Module, Function, Arity}'. 97 | %% 98 | %% Analysis starts from parsed core erlang terms. 99 | %% 100 | %% @see is_pure/2 101 | %% @see module/1 102 | %% @see propagate/3 103 | -spec module(cerl:c_module(), options()) -> dict(). 104 | 105 | module(Core, Options) -> 106 | Tab = module(Core), 107 | Plt = load_plt_no_errors(Options), 108 | % TODO: Maybe update and save PLT as well. 109 | propagate(Tab, Plt, Options). 110 | 111 | 112 | %% @doc Load a PLT from the provided options. If no PLT is found, or 113 | %% there are errors, return a new PLT. 114 | load_plt_no_errors(Opts) -> 115 | File = ?utils:option(plt, Opts, ?plt:default_path()), 116 | Check = not ?utils:option(no_check, Opts, false), 117 | case ?plt:load(File) of 118 | {error, _Type} -> 119 | ?plt:new(); 120 | {ok, Plt} when Check -> 121 | case ?plt:verify(Plt) of 122 | ok -> Plt; 123 | _F -> ?plt:new() 124 | end; 125 | {ok, Plt} -> % No checks, unwise. 126 | Plt 127 | end. 128 | 129 | 130 | %% @doc Return a list of MFAs and a list of primops for which we have no 131 | %% pureness information. 132 | 133 | -spec find_missing(dict()) -> {[mfa()], [purity_utils:primop()]}. 134 | 135 | find_missing(Table) -> 136 | Set1 = sets:from_list(?utils:dependencies(Table, fun ?utils:is_mfa/1)), 137 | Set2 = sets:from_list(dict:fetch_keys(Table)), 138 | Funs = sets:subtract(Set1, Set2), 139 | Set3 = sets:from_list(?utils:dependencies(Table, fun ?utils:is_primop/1)), 140 | Prim = sets:subtract(Set3, Set2), 141 | {sets:to_list(Funs), sets:to_list(Prim)}. 142 | 143 | 144 | 145 | %% @doc Remove any files with errors from the PLT, and re-analyse 146 | %% changed files, as well as any dependencies thereof. 147 | 148 | -spec analyse_changed({[file:filename()], [file:filename()]}, 149 | options(), plt()) -> plt(). 150 | 151 | analyse_changed({Changed, Errors}, _Options, Plt) -> 152 | Combined = Changed ++ Errors, 153 | %% First strip the table of both changed and removed files, so that 154 | %% there are no left-over MFAs, e.g. when removing a function from a module. 155 | T1 = ?utils:delete_modules(?plt:info_table(Plt), to_modules(Combined)), 156 | %% Determine which modules should be re-analysed: Dependent -- Missing. 157 | DM = ?plt:dependent_modules(Plt, Combined) -- to_modules(Errors), 158 | %% We need the filenames of these modules. Since we cannot map a module to 159 | %% a specific filename, figure this out by the list of filenames stored in 160 | %% the PLT. It's a given that true == subset(DM, to_modules(Files)). 161 | Files = ?plt:filenames(Plt) -- Errors, 162 | Map = dict:from_list([{?utils:filename_to_module(F), F} || F <- Files]), 163 | DF = [dict:fetch(M, Map) || M <- DM], 164 | %% Collect information on these modules, and create a new PLT. Naturally 165 | %% any cached result tables are dismissed. 166 | ?plt:new(?utils:dict_update(T1, pfiles(DF)), Files). 167 | 168 | to_modules(Filenames) -> 169 | [?utils:filename_to_module(F) || F <- Filenames]. 170 | 171 | -------------------------------------------------------------------------------- /src/purity_cli.erl: -------------------------------------------------------------------------------- 1 | %% ==================================================================== 2 | %% This library is free software; you can redistribute it and/or 3 | %% modify it under the terms of the GNU Lesser General Public 4 | %% License as published by the Free Software Foundation; either 5 | %% version 2.1 of the License, or (at your option) any later version. 6 | %% 7 | %% This library is distributed in the hope that it will be useful, 8 | %% but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | %% Lesser General Public License for more details. 11 | %% 12 | %% You should have received a copy of the GNU Lesser General Public 13 | %% License along with this library; if not, write to the Free Software 14 | %% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 15 | %% 02110-1301 USA 16 | %% 17 | %% @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 18 | %% @author Michael Pitidis 19 | %% @end 20 | %% ===================================================================== 21 | 22 | %%% 23 | %%% @doc Command line interface to `purity'. 24 | %%% 25 | 26 | -module(purity_cli). 27 | 28 | -export([main/0]). 29 | 30 | 31 | -define(plt, purity_plt). 32 | -define(utils, purity_utils). 33 | 34 | -import(?utils, [fmt_mfa/1, str/2, option/2, option/3]). 35 | -import(?utils, [timeit/3, format_time/1, get_time/0]). 36 | 37 | %% @doc Parse any command line arguments, analyse all supplied files 38 | %% and print the results of the analysis to standard output. 39 | 40 | -spec main() -> no_return(). 41 | 42 | main() -> 43 | T0 = get_time(), 44 | {Options, Files0} = parse_args(), 45 | 46 | with_option(version, Options, fun(true) -> 47 | io:format("Purity Analyzer for Erlang, version ~s~n", [?VSN]), 48 | halt(0) end), 49 | Files = 50 | case option(apps, Options) of 51 | false -> 52 | Files0; 53 | Libs -> 54 | Files0 ++ expand_libs(Libs) 55 | end, 56 | 57 | case {Files, option(no_check, Options)} of 58 | {[], true} -> 59 | io:format("You have to specify at least one file to analyse.~n"), 60 | halt(1); 61 | _ -> 62 | ok 63 | end, 64 | 65 | with_option(verbose, Options, fun(true) -> 66 | io:format("Analyzing the following files:~n"), 67 | lists:foreach(fun(F) -> io:format("\t~s~n", [F]) end, Files) end), 68 | 69 | Plt = case option(build_plt, Options) of 70 | true -> 71 | ?plt:new(); 72 | false -> 73 | timeit("Loading PLT", fun load_plt/1, [Options]) 74 | end, 75 | {Table, Final} = do_analysis(Files, Options, Plt), 76 | 77 | %% An obvious problem with this approach is that we cannot close 78 | %% the opened file, but this is not important since the application 79 | %% exits soon after. 80 | Print = case option(output, Options) of 81 | false -> 82 | fun io:format/2; 83 | Filename -> 84 | case file:open(Filename, [write]) of 85 | {ok, Io} -> 86 | fun(Fmt, Args) -> io:format(Io, Fmt, Args) end; 87 | {error, Reason} -> 88 | io:format("Could not open file ~p for writing (~p)~n", [ 89 | Filename, Reason]), 90 | fun io:format/2 91 | end 92 | end, 93 | 94 | Modules = [?utils:filename_to_module(M) || M <- Files], 95 | case option(quiet, Options) of 96 | false -> % Print results. 97 | Requested = sets:from_list(Modules), 98 | Print("Results:~n", []), 99 | lists:foreach(fun(A) -> pretty_print(Print, A) end, lists:sort( 100 | [V || {{M,_,_}=MFA, _} = V <- dict:to_list(Final), 101 | sets:is_element(M, Requested), 102 | not ?utils:internal_function(MFA)])); 103 | true -> 104 | ok 105 | end, 106 | 107 | %% Optionally: 108 | %% Print functions for which we lack purity information. 109 | with_option(print_missing, Options, fun(true) -> 110 | print_missing(Print, Final) end), 111 | %% Write statistics to file. 112 | with_option(stats, Options, fun(Filename) -> 113 | do_stats(Filename, Modules, Final) end), 114 | 115 | case option(build_plt, Options) orelse option(add_to_plt, Options) of 116 | true -> 117 | %% Look for output file or fall back to input file. 118 | PI = option(plt, Options, ?plt:default_path()), 119 | PO = option(output_plt, Options, PI), 120 | %% Update and save PLT. 121 | ok = timeit("Updating PLT", fun update_plt/6, 122 | [PO, Plt, Options, Files, Table, Final]); 123 | false -> ok 124 | end, 125 | io:format("Analysis completed in ~s~n", [format_time(get_time() - T0)]), 126 | init:stop(). 127 | 128 | update_plt(Output, Plt0, Options, Files, T, R) -> 129 | %% Table inconsistencies should not be possible when using 130 | %% the command line interface, thus success is guaranteed. 131 | {ok, Plt1} = ?plt:update(Plt0, Options, {Files, T, R}), 132 | ?plt:save(Plt1, Output). 133 | 134 | 135 | do_stats(Filename, Modules, Table) -> 136 | ok = timeit("Generating statistics", fun purity_stats:write/2, 137 | [Filename, purity_stats:gather(Modules, Table)]). 138 | 139 | do_analysis(Files, Options, Plt) -> 140 | T = timeit("Traversing AST", fun purity:pfiles/1, [Files]), 141 | R = timeit("Propagating values", fun purity:propagate/3, [T, Plt, Options]), 142 | {T, R}. 143 | 144 | 145 | with_option(Opt, Options, Action) -> 146 | case option(Opt, Options) of 147 | false -> 148 | ok; 149 | Value -> 150 | Action(Value) 151 | end. 152 | 153 | load_plt(Opts) -> 154 | Fn = option(plt, Opts, ?plt:default_path()), 155 | DoCheck = not option(no_check, Opts), 156 | case ?plt:load(Fn) of 157 | {error, Type} -> 158 | ?utils:emsg("Could not load PLT file '~s': ~p", [Fn, Type]), 159 | ?plt:new(); 160 | {ok, Plt} when DoCheck -> 161 | case ?plt:verify(Plt) of 162 | incompatible_version -> 163 | ?utils:emsg("PLT is out of date, create a new one"), 164 | halt(1); 165 | {changed_files, Failing} -> 166 | io:format("PLT will be updated because the following " 167 | "modules have changed:~n~s", 168 | [string:join(format_changed(Failing),"\n")]), 169 | New = purity:analyse_changed(Failing, Opts, Plt), 170 | ok = ?plt:save(New, Fn), 171 | New; 172 | ok -> 173 | Plt 174 | end; 175 | {ok, Plt} -> 176 | Plt 177 | end. 178 | 179 | format_changed({Mismatch, Errors}) -> 180 | [str(" M ~s", [F]) || F <- Mismatch] ++ 181 | [str(" E ~s", [F]) || F <- Errors]. 182 | 183 | 184 | parse_args() -> 185 | Spec = [ 186 | {purelevel, [ 187 | "-l", "--level", 188 | {type, {intchoice, [1,2,3]}}, 189 | {help, "Select one of three progressively stricter purity levels"}]}, 190 | {with_reasons, [ 191 | "--with-reasons", 192 | {type, bool}, 193 | {help, "Print why each function is impure"}]}, 194 | {both, [ 195 | "--both", 196 | {type, bool}, 197 | {help, "Perform both purity and termination analysis"}]}, 198 | {termination, [ 199 | "-t", "--termination", 200 | {type, bool}, 201 | {help, "Perform termination analysis instead"}]}, 202 | {output, [ 203 | "-o", "--output", 204 | {help, "Write output to specified filename"}]}, 205 | {build_plt, [ 206 | "-b", "--build-plt", 207 | {type, bool}, 208 | {help, "Create new PLT from the results of the analysis"}]}, 209 | {no_check, [ 210 | "-n", "--no-check", 211 | {type, bool}, 212 | {help, "Don't check PLT"}]}, 213 | {add_to_plt, [ 214 | "--add-to-plt", 215 | {type, bool}, 216 | {help, "Update PLT with any results from this analysis"}]}, 217 | {plt, [ 218 | "-p", "--plt", 219 | {help, "Use specified file as PLT instead of the default"}]}, 220 | {output_plt, [ 221 | "--output-plt", 222 | {help, "Store the PLT at the specified location"}]}, 223 | {apps, [ 224 | "--apps", 225 | {type, multiple}, 226 | {help, "Analyse library applications"}]}, 227 | {print_missing, [ 228 | "-m", "--missing", 229 | {type, bool}, 230 | {help, "Print functions with no purity information"}]}, 231 | {stats, [ 232 | "-s", "--stats", 233 | {help, "Write statistical information to file"}]}, 234 | {quiet, [ 235 | "-q", "--quiet", 236 | {type, bool}, 237 | {help, "Don't print analysis results"}]}, 238 | {verbose, [ 239 | "-v", "--verbose", 240 | {type, bool}, 241 | {help, "Generate more messages"}]}, 242 | {version, [ 243 | "--version", 244 | {type, bool}, 245 | {help, "Print version information and exit"}]} 246 | ], 247 | Extra = [only_keep_last, {override, [{termination, purelevel}]}], 248 | cl_parser:parse_args(Spec, "usage: purity [options] file(s)", Extra). 249 | 250 | 251 | pretty_print(Print, {MFA, Result}) -> 252 | Print("~s ~s.~n", [fmt_mfa(MFA), fmt(Result)]). 253 | 254 | 255 | -spec print_missing(fun((_,_) -> ok), dict()) -> ok. 256 | 257 | print_missing(Print, Table) -> 258 | {Funs, Primops} = purity:find_missing(Table), 259 | Print("Try analysing the following modules:~n", []), 260 | lists:foreach(fun(M) -> Print(" ~s~n", [M]) end, 261 | lists:usort([M || {M,_,_} <- Funs])), 262 | Print("Missing ~p functions:~n", [length(Funs)]), 263 | lists:foreach(fun(F) -> Print(" ~s~n", [fmt_mfa(F)]) end, Funs), 264 | Print("Missing ~p primops:~n", [length(Primops)]), 265 | lists:foreach(fun(F) -> Print(" ~s~n", [fmt_mfa(F)]) end, Primops). 266 | 267 | 268 | %% @doc Consistent one-line formatting of purity results. Helps 269 | %% produce cleaner diffs of the output. 270 | 271 | -spec fmt(purity:pure()) -> string(). 272 | 273 | fmt({P, []}) -> 274 | fmt(P); 275 | fmt({P, D}) when is_list(D) -> 276 | str("~s ~w", [fmt(P), simplify_deps(D)]); 277 | fmt({at_least, P}) -> 278 | str(">= ~s", [P]); 279 | fmt(P) when is_atom(P) -> 280 | atom_to_list(P). 281 | 282 | simplify_deps(Ds) -> 283 | [simplify_dep(D) || D <- Ds]. 284 | 285 | simplify_dep({arg, N}) -> 286 | N; 287 | simplify_dep({Type, Fun, Args}) -> 288 | {Type, Fun, unclutter(Args)}; 289 | simplify_dep({free, {F, Args}}) -> 290 | case unclutter(Args) of 291 | [] -> {free, F}; 292 | As -> {free, {F, As}} 293 | end; 294 | simplify_dep(Dep) -> 295 | Dep. 296 | 297 | unclutter(Args) -> [A || A <- Args, not is_clutter(A)]. 298 | 299 | is_clutter({arg, {_, _}}) -> true; 300 | is_clutter({sub, _}) -> true; 301 | is_clutter(_) -> false. 302 | 303 | 304 | %% @doc Given a list of application names, return a list of the corresponding 305 | %% BEAM files. 306 | expand_libs(Libs) -> 307 | flatten1( 308 | [filelib:wildcard(filename:join(L, "*.beam")) || L <- get_lib_dirs(Libs), 309 | filelib:is_dir(L)]). 310 | 311 | get_lib_dirs(Libs) -> 312 | [filename:absname(get_lib_dir(list_to_atom(L))) || L <- Libs]. 313 | 314 | get_lib_dir(erts) -> 315 | filename:join([code:root_dir(), "erts", "preloaded", "ebin"]); 316 | get_lib_dir(Lib) -> 317 | case code:lib_dir(Lib, ebin) of 318 | {error, bad_name} -> 319 | atom_to_list(Lib); 320 | LibDir -> 321 | LibDir 322 | end. 323 | 324 | flatten1(L) -> 325 | lists:foldl(fun lists:append/2, [], L). 326 | 327 | -------------------------------------------------------------------------------- /src/purity_collect.erl: -------------------------------------------------------------------------------- 1 | %% ==================================================================== 2 | %% This library is free software; you can redistribute it and/or 3 | %% modify it under the terms of the GNU Lesser General Public 4 | %% License as published by the Free Software Foundation; either 5 | %% version 2.1 of the License, or (at your option) any later version. 6 | %% 7 | %% This library is distributed in the hope that it will be useful, 8 | %% but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | %% Lesser General Public License for more details. 11 | %% 12 | %% You should have received a copy of the GNU Lesser General Public 13 | %% License along with this library; if not, write to the Free Software 14 | %% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 15 | %% 02110-1301 USA 16 | %% 17 | %% @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 18 | %% @author Michael Pitidis 19 | %% @end 20 | %% ===================================================================== 21 | 22 | 23 | %%% 24 | %%% Traverse Core Erlang Abstract Syntax Trees and collect the necessary 25 | %%% information for the analysis. 26 | %%% 27 | 28 | -module(purity_collect). 29 | 30 | -define(utils, purity_utils). 31 | 32 | -export([module/1, files/1, pfiles/1, file/1]). 33 | 34 | -import(?utils, [str/2]). 35 | 36 | 37 | -type map_key() :: cerl:var_name(). 38 | -type map_val() :: mfa() | pos_integer(). 39 | -type map() :: [{map_key(), map_val()}]. 40 | 41 | -type sub() :: {dict(), dict()}. 42 | 43 | -type deplist() :: purity_utils:deplist(). 44 | -type dependency() :: purity_utils:dependency(). 45 | 46 | 47 | %% Keep track of the following values for the currently analysed function. 48 | %% Some of them persist across functions as well. 49 | %% 50 | %% mfa - Unique identifier of the currently analysed function 51 | %% ctx - List of dependencies (context) of the current function, 52 | %% the result of the analysis 53 | %% vars - Map of higher order variables to MFAs 54 | %% args - Map names of current function's arguments to their position 55 | %% in the argument list 56 | %% subs - Keep track of variables which are subsets of arguments 57 | %% aliases - Keep track of aliases to variables for looking up vars/args 58 | %% more effectively 59 | %% free - An ordered set of free variables for the current function 60 | %% (only relevant to nested functions of course) 61 | %% nested - Keep track of the MFAs of any nested functions defined in 62 | %% the body of the currently analysed one. 63 | %% count - Counter for giving unique names to nested functions 64 | %% names - Ordered set of reserved function names, for excluding them 65 | %% from unique identifiers 66 | %% table - Mapping of MFAs to their pureness result, be that a concrete 67 | %% value or a context. 68 | -record(state, {mfa = undefined :: mfa() | undefined, 69 | ctx = ctx_new() :: deplist(), 70 | vars = map_new() :: map(), 71 | args = map_new() :: map(), 72 | subs = sub_new() :: sub(), 73 | aliases = dict:new() :: dict(), 74 | free = [] :: [cerl:var_name()], 75 | nested = [] :: [mfa()], 76 | count = 1 :: pos_integer(), 77 | names = [] :: [atom()], 78 | table = dict:new() :: dict()}). 79 | 80 | -type state() :: #state{}. 81 | 82 | 83 | %% @doc Analyse a module and return a lookup table of functions 84 | %% and dependencies, indexed by `{Module, Function, Arity}'. 85 | %% 86 | %% Analysis starts from parsed core erlang terms. 87 | %% 88 | %% @see files/2 89 | -spec module(cerl:c_module()) -> dict(). 90 | 91 | module(Core) -> 92 | module(Core, dict:new()). 93 | 94 | 95 | module(Core, Table) -> 96 | M = cerl:concrete(cerl:module_name(Core)), 97 | Defs = [{cerl:var_name(Var), Fun} || {Var, Fun} <- cerl:module_defs(Core)], 98 | Names = ordsets:from_list([atom_to_list(F) || {{F, _}, _} <- Defs]), 99 | Fun = fun({{F,A}, Fun}, St) -> 100 | analyse(Fun, St#state{mfa = {M,F,A}, 101 | nested = [], 102 | vars = map_new(), 103 | subs = sub_new(), 104 | aliases = core_aliases:scan(Fun)}) end, 105 | T1 = ?utils:delete_modules(Table, [M]), 106 | S1 = lists:foldl(Fun, #state{names = Names, table = T1}, Defs), 107 | S1#state.table. 108 | 109 | 110 | %% @doc Analyse a list of Erlang modules. 111 | %% 112 | %% Each module is analysed separately, and the lookup table is incrementally 113 | %% updated. The modules can be Erlang source code or already compiled BEAM 114 | %% files with debug information. 115 | %% 116 | %% @see module/2 117 | 118 | -spec files([file:filename()]) -> dict(). 119 | 120 | files(Filenames) -> 121 | files(Filenames, dict:new()). 122 | 123 | files(Filenames, Table) when is_list(Filenames) -> 124 | lists:foldl(fun file/2, Table, Filenames). 125 | 126 | %% @doc Analyse a single file. 127 | %% In case of error a message is printed and an empty lookup table is 128 | %% returned. 129 | 130 | -spec file(file:filename()) -> dict(). 131 | 132 | file(Filename) -> 133 | file(Filename, dict:new()). 134 | 135 | 136 | file(Filename, Table) -> 137 | case ?utils:get_core(Filename) of 138 | {ok, Core} -> 139 | module(Core, Table); 140 | {error, Reason} -> 141 | ?utils:emsg(Reason), 142 | Table 143 | end. 144 | 145 | 146 | %% @doc Analyse a list of modules in parallel. 147 | %% 148 | %% The number of parallel operations is limited to the number of 149 | %% cpu processors/cores in order to minimise memory use. 150 | %% 151 | %% @see module/2 152 | %% @see files/1 153 | 154 | -spec pfiles([file:filename()]) -> dict(). 155 | 156 | pfiles(Filenames) when is_list(Filenames) -> 157 | Tabs = ?utils:pmap({?MODULE, file}, [], Filenames), 158 | merge_dicts(lists:zip(to_modules(Filenames), Tabs)). 159 | 160 | %% @doc If the same module is provided more than once, keep the last occurence. 161 | merge_dicts(Dicts) -> 162 | ?utils:dict_fold( 163 | fun (_, D, Ds) -> ?utils:dict_update(D, Ds) end, 164 | dict:from_list(Dicts)). 165 | 166 | to_modules(Filenames) -> 167 | [?utils:filename_to_module(F) || F <- Filenames]. 168 | 169 | 170 | 171 | analyse(Function, St0) -> 172 | St1 = St0#state{ctx = ctx_new(), 173 | args = fetch_arg_vars(Function), 174 | free = cerl_trees:free_variables(Function), 175 | count = 1}, 176 | St2 = traverse(cerl:fun_body(Function), St1), 177 | St3 = promote_nested(St2#state{ctx = postprocess_locals(St2)}), 178 | St3#state{table = dict:store(St3#state.mfa, St3#state.ctx, St3#state.table)}. 179 | 180 | 181 | fetch_arg_vars(Fun) -> 182 | Args = cerl:fun_vars(Fun), 183 | %% XXX: Breaks the map contract. 184 | [{cerl:var_name(V), N} || {N, V} <- enumerate(Args), cerl:is_c_var(V)]. 185 | 186 | 187 | %% @doc Traverse a Core Erlang AST and collect necessary information 188 | %% in the form of a dependency list. 189 | traverse(Tree, #state{ctx = Ctx} = St0) -> 190 | case cerl:type(Tree) of 191 | seq -> 192 | Arg = cerl:seq_arg(Tree), 193 | Body = cerl:seq_body(Tree), 194 | traverse_list([Arg, Body], St0); 195 | 'case' -> 196 | handle_case(Tree, St0); 197 | clause -> 198 | Patterns = cerl:clause_pats(Tree), 199 | Guard = cerl:clause_guard(Tree), 200 | Body = cerl:clause_body(Tree), 201 | traverse_list([Body,Guard|Patterns], St0); 202 | 'receive' -> 203 | %% When not specified explicitly, timeout is the infinity literal, 204 | %% while action is the true literal. Both may contain arbitrary 205 | %% expressions however. 206 | Clauses = cerl:receive_clauses(Tree), 207 | Timeout = cerl:receive_timeout(Tree), 208 | Action = cerl:receive_action(Tree), 209 | Type = receive_type(Timeout), 210 | St1 = St0#state{ctx = ctx_add({erl, {'receive', Type}}, Ctx)}, 211 | traverse_list(Clauses ++ [Timeout, Action], St1); 212 | 'apply' -> 213 | Op = cerl:apply_op(Tree), 214 | OpName = cerl:var_name(Op), 215 | Fun = resolve_fun_binding(OpName, St0), 216 | Args = handle_args(Fun, cerl:apply_args(Tree), St0), 217 | St0#state{ctx = ctx_add({local, Fun, Args}, Ctx)}; 218 | 'call' -> 219 | Args = handle_args(call_mfa(Tree), cerl:call_args(Tree), St0), 220 | St0#state{ctx = ctx_add({remote, call_mfa(Tree), Args}, Ctx)}; 221 | 'fun' -> 222 | %% This mostly comes from nested funs as return values, etc. 223 | %% There's not much use for these the way analysis is structured, 224 | %% but analyse them anyway, for maximum coverage. 225 | {FunMFA, St1} = gen_fun_uid(Tree, St0), 226 | #state{table = Tab, nested = Nst} = 227 | analyse(Tree, St1#state{mfa = FunMFA}), 228 | St0#state{table = Tab, nested = nst_add(FunMFA, Nst)}; 229 | 'let' -> 230 | handle_let(Tree, St0); 231 | primop -> 232 | handle_primop(Tree, St0); 233 | letrec -> 234 | handle_letrec(Tree, St0); 235 | values -> 236 | traverse_list(cerl:values_es(Tree), St0); 237 | binary -> 238 | traverse_list(cerl:binary_segments(Tree), St0); 239 | bitstr -> 240 | %% Traversal of this node could be omitted altogether, I don't 241 | %% see how any of these subtrees can be impure in some way. 242 | traverse_list([cerl:bitstr_val(Tree), cerl:bitstr_size(Tree), 243 | cerl:bitstr_unit(Tree), cerl:bitstr_type(Tree), 244 | cerl:bitstr_flags(Tree)], St0); 245 | tuple -> 246 | traverse_list(cerl:tuple_es(Tree), St0); 247 | 'catch' -> 248 | %% TODO: Would be nice if use of catch on functions that 249 | %% could never raise exceptions was detected and this 250 | %% dependency omitted. 251 | St1 = St0#state{ctx = ctx_add({erl, 'catch'}, Ctx)}, 252 | traverse(cerl:catch_body(Tree), St1); 253 | cons -> 254 | traverse_list([cerl:cons_hd(Tree), cerl:cons_tl(Tree)], St0); 255 | 'try' -> 256 | %% try_{vars,evars}/ should only contain variable names. 257 | Arg = cerl:try_arg(Tree), 258 | %Vars = cerl:try_vars(Tree), 259 | Body = cerl:try_body(Tree), 260 | %Evars = cerl:try_evars(Tree), 261 | Handler = cerl:try_handler(Tree), 262 | traverse_list([Arg, Body, Handler], St0); 263 | alias -> 264 | Var = cerl:alias_var(Tree), 265 | Pat = cerl:alias_pat(Tree), 266 | traverse_list([Var, Pat], St0); 267 | literal -> 268 | St0; 269 | var -> 270 | St0 271 | end. 272 | 273 | traverse_list(Trees, St0) -> 274 | lists:foldl(fun traverse/2, St0, Trees). 275 | 276 | resolve_fun_binding(Var, #state{mfa = {M,_,_}} = St) -> 277 | case lookup_var(Var, St) of 278 | {ok, {_,_,_}=FunMFA} -> 279 | FunMFA; 280 | error -> 281 | case Var of 282 | {F,A} -> 283 | %% {Function, Arity} tuples represent module-level 284 | %% function variables, but can also be functions 285 | %% bound in letrec statements, which are resolved 286 | %% to unique MFAs here. 287 | {M,F,A}; 288 | _ -> 289 | Var 290 | end 291 | end. 292 | 293 | %% @doc A receive statement is considered finite only if it has a 294 | %% constant literal as a timeout value. Missing `after' clauses 295 | %% are translated to a timeout of `infinity' in Core Erlang. 296 | receive_type(Tree) -> 297 | case cerl:is_literal(Tree) of 298 | true -> 299 | case cerl:concrete(Tree) of 300 | infinity -> 301 | infinite; 302 | _Val -> 303 | finite 304 | end; 305 | false -> % var, call or apply 306 | infinite 307 | end. 308 | 309 | %% @doc Flatten dependencies to nested functions. 310 | %% 311 | %% Consider the following example: ``` a(F, L) -> [F(E) || E <- L]. ''' 312 | %% The `a' function depends on the nested `a_2-1/1' function, which in 313 | %% turn depends on the free variable `F'. Since that variable is bound 314 | %% in the scope of `a', flattening the dependencies will resolve it to 315 | %% `{arg, 1}'. All other dependencies are propagated unchanged, with 316 | %% the exception of self calls which are transformed to self calls of 317 | %% the parent function in order to preserve the semantics of the analysis 318 | %% (in the case of HOFs, but also with regard to termination analysis). 319 | promote_nested(#state{mfa = Fun, ctx = Ctx} = St) -> 320 | {Nested, Rest} = lists:partition(fun(D) -> is_nested(D, St) end, Ctx), 321 | Promoted = lists:flatten([map_nested(Fun, N, St) || N <- Nested]), 322 | St#state{ctx = ctx_rem(remove, ctx_add_many(Promoted, Rest))}. 323 | 324 | is_nested({_, Fun, _}, #state{nested = Nst, mfa = MFA}) -> 325 | Fun =/= MFA andalso nst_mem(Fun, Nst); 326 | is_nested(_, _) -> 327 | false. 328 | 329 | map_nested(Fun, {_, Dep, _} = Orig, #state{table = Tab} = St) -> 330 | Vals = [map_nested(Fun, Dep, C, St) || C <- dict:fetch(Dep, Tab)], 331 | case lists:member(unmappable, Vals) of 332 | true -> 333 | %% Some of the values failed to map, restore the original dep. 334 | [Orig]; 335 | false -> 336 | Vals 337 | end. 338 | 339 | map_nested(_, _, {free, {Var, _Args}} = Dep, St) -> 340 | case is_free(Var, St) of 341 | true -> %% Still a free variable, let the parents handle it. 342 | Dep; 343 | false -> %% Bind to argument or fail. 344 | case lookup_free(Var, St) of 345 | {ok, {arg, _} = NewDep} -> 346 | NewDep; 347 | error -> 348 | unmappable 349 | end 350 | end; 351 | map_nested(Fun, _, {Type, Fun, Args} = Dep, St) -> 352 | %% Dependency on the parent: this should be converted to recursion. 353 | %% The arguments may contain free variables however, which could be 354 | %% mapped to concrete arguments of the caller and make the recursive 355 | %% dependency safe to remove later on. 356 | case check_passed_args(Fun, Args, St) of 357 | still_free -> 358 | Dep; 359 | unmappable -> 360 | unmappable; 361 | NewArgs -> 362 | {Type, Fun, NewArgs} 363 | end; 364 | map_nested(_Fun, Dep, {_, Dep, _}, _) -> 365 | %% Recursion in the nested function. This can only happen with 366 | %% `letrec', which is generated by Erlang for list comprehensions. 367 | %% It may be considered terminating since it is over a finite list, 368 | %% so we don't care about this dependency in any way. 369 | remove; 370 | map_nested(_, _, {arg, _}, _) -> 371 | %% Not much we can do if the nested function is a HOF. 372 | unmappable; 373 | %% Everything else passes through unchanged, just being explicit. 374 | map_nested(_, _, {_, _, _} = Dep, _) -> 375 | Dep; 376 | map_nested(_, _, {primop, _} = P, _) -> 377 | P; 378 | map_nested(_, _, {erl, _} = E, _) -> 379 | E. 380 | 381 | check_passed_args(_F, [], _St) -> 382 | []; 383 | check_passed_args(_, [{arg,{_,_}}|_], _) -> 384 | %% Converting the argument mapping could be tricky so play it safe. 385 | unmappable; 386 | check_passed_args(Fun, [{N, {free, Var}}|T], St) -> 387 | case is_free(Var, St) of 388 | true -> 389 | still_free; 390 | false -> 391 | case lookup_free(Var, St) of 392 | error -> 393 | unmappable; 394 | {ok, {arg, K}} -> 395 | case check_passed_args(Fun, T, St) of 396 | Args when is_list(Args) -> 397 | %% All arguments bound, epic win! 398 | [{arg, {K, N}}|Args]; 399 | Fail when is_atom(Fail) -> 400 | Fail 401 | end 402 | end 403 | end. 404 | 405 | lookup_free(Var, #state{} = St) -> 406 | case lookup_arg(Var, St) of 407 | {ok, N} -> 408 | {ok, {arg, N}}; 409 | error -> 410 | error 411 | end. 412 | 413 | %% @doc Convert unresolved local dependencies to positions in the 414 | %% in the argument list or mark as free variables, whenever possible. 415 | postprocess_locals(#state{ctx = Ctx} = St) -> 416 | lists:usort([postprocess_locals(C, St) || C <- Ctx]). 417 | 418 | postprocess_locals({local, Var, Args} = Value, St) 419 | when (is_atom(Var) orelse is_integer(Var)) -> 420 | case is_free(Var, St) of 421 | true -> 422 | {free, {Var, Args}}; 423 | false -> 424 | case lookup_arg(Var, St) of 425 | {ok, N} -> 426 | {arg, N}; 427 | error -> 428 | Value 429 | end 430 | end; 431 | postprocess_locals(Other, _St) -> 432 | Other. 433 | 434 | is_free(Var, #state{free = Free}) -> 435 | ordsets:is_element(Var, Free). 436 | 437 | enumerate(List) -> 438 | enumerate(List, 1, []). 439 | 440 | enumerate([], _, Acc) -> 441 | lists:reverse(Acc); 442 | enumerate([H|T], N, Acc) -> 443 | enumerate(T, N+1, [{N, H}|Acc]). 444 | 445 | 446 | %% Link variable names to the corresponding MFA, whenever possible. 447 | %% If a name is bound to a different fun, the link will be replaced. 448 | handle_let(Tree, #state{vars = Vs} = St0) -> 449 | Arg = cerl:let_arg(Tree), 450 | Body = cerl:let_body(Tree), 451 | %% It would be nice if 'case' nodes were analysed deeper. This would 452 | %% require keeping track of a `union' of values for the bound variable, 453 | %% which complicates matters, so it's skipped for the time being. 454 | S = case cerl:let_arity(Tree) of 455 | 1 -> 456 | [Name] = [cerl:var_name(V) || V <- cerl:let_vars(Tree)], 457 | case cerl:type(Arg) of 458 | 'fun' -> 459 | {FunMFA, St1} = gen_fun_uid(Arg, St0), 460 | #state{table = Tab, nested = Nst} = 461 | analyse(Arg, St1#state{mfa = FunMFA}), 462 | %% Build on St1 because we need the updated count field. 463 | St1#state{table = Tab, vars = map_add(Name, FunMFA, Vs), 464 | nested = nst_add(FunMFA, Nst)}; 465 | 'call' -> 466 | case call_mfa(Arg) of 467 | {erlang, make_fun, 3} -> 468 | Args = cerl:call_args(Arg), 469 | case lists:all(fun cerl:is_literal/1, Args) of 470 | true -> 471 | [M, F, A] = [cerl:concrete(L) || L <- Args], 472 | St0#state{vars = map_add(Name, {M,F,A}, Vs)}; 473 | false -> 474 | St0 475 | end; 476 | _ -> 477 | St0 478 | end; 479 | _T -> 480 | St0 481 | end; 482 | _N -> 483 | %% e.g. test/values.erl when compiled with copt. 484 | St0 485 | end, 486 | if S =/= St0 -> 487 | traverse(Body, S); 488 | true -> 489 | traverse_list([Arg, Body], S) 490 | end. 491 | 492 | 493 | call_mfa(Tree) -> 494 | true = cerl:is_c_call(Tree), 495 | M = cerl:call_module(Tree), 496 | F = cerl:call_name(Tree), 497 | A = cerl:call_arity(Tree), 498 | %% get_name/1 marks variable in calls to easily distinguish them 499 | %% from regular calls. Maybe there should be a special context type 500 | %% for this as well. 501 | {get_name(M), get_name(F), A}. 502 | 503 | -spec get_name(cerl:c_var() | cerl:c_literal()) -> {var, atom()} | atom(). 504 | get_name(Tree) -> 505 | case cerl:type(Tree) of 506 | var -> 507 | {var, cerl:var_name(Tree)}; 508 | literal -> 509 | cerl:concrete(Tree) 510 | end. 511 | 512 | handle_letrec(Tree, #state{} = St0) -> 513 | Defs = cerl:letrec_defs(Tree), 514 | Body = cerl:letrec_body(Tree), 515 | {FunDefs, St1} = lists:foldl(fun letrec_names/2, {[], St0}, Defs), 516 | #state{table = Tab, nested = Nst} = 517 | lists:foldl(fun letrec_analyse/2, St1, FunDefs), 518 | %% Analysis is continued with the old state. 519 | traverse(Body, St1#state{table = Tab, 520 | nested = nst_add_many(unzip1(FunDefs), Nst)}). 521 | 522 | letrec_names({Var, Fun}, {Acc, #state{vars = Vs} = St0}) -> 523 | VarName = cerl:var_name(Var), 524 | {MFA, St1} = gen_fun_uid(Fun, St0), 525 | St2 = St1#state{vars = map_add(VarName, MFA, Vs)}, 526 | {[{MFA, Fun}|Acc], St2}. 527 | 528 | letrec_analyse({MFA, Fun}, St0) -> 529 | analyse(Fun, St0#state{mfa = MFA}). 530 | 531 | 532 | %% @doc Generate a unique function name, making sure it doesn't clash 533 | %% with any of the names in the module's namespace. 534 | 535 | -spec gen_fun_uid(cerl:c_fun(), state()) -> {mfa(), state()}. 536 | 537 | gen_fun_uid(Tree, #state{mfa = {M,F,A}, count = C0, names = Names} = St) -> 538 | true = cerl:is_c_fun(Tree), 539 | {Name, C1} = gen_fun_uid(str("~s_~B", [F, A]), C0, Names), 540 | Uid = {M, Name, cerl:fun_arity(Tree)}, 541 | {Uid, St#state{count = C1}}. 542 | 543 | gen_fun_uid(Fun, Count, Names) -> 544 | N = str("~s-~B", [Fun, Count]), 545 | case ordsets:is_element(N, Names) of 546 | true -> 547 | gen_fun_uid(Fun, Count + 1, Names); 548 | false -> 549 | {list_to_atom(N), Count + 1} 550 | end. 551 | 552 | 553 | %% XXX: Context arguments are probably meaningless for primops, however 554 | %% they make handling consistent with that of remote/local dependencies. 555 | handle_primop(Tree, #state{ctx = Ctx} = St0) -> 556 | true = cerl:is_c_primop(Tree), 557 | Name = cerl:concrete(cerl:primop_name(Tree)), 558 | Arity = cerl:primop_arity(Tree), 559 | St0#state{ctx = ctx_add({primop, {Name, Arity}, []}, Ctx)}. 560 | 561 | %% @doc Detect simple cases of variables which represent a strict subset of 562 | %% one of the arguments. This is useful for detecting recursive functions 563 | %% which consume one of their arguments, and are therefore guaranteed 564 | %% to terminate (or crash). Currently this works for some cases of lists 565 | %% and binaries. 566 | handle_case(Tree, St0) -> 567 | true = cerl:is_c_case(Tree), 568 | Arg = cerl:case_arg(Tree), 569 | Cls = cerl:case_clauses(Tree), 570 | %% Since pattern variable names may repeat themselves, use a 571 | %% distinct subset map for each clause. 572 | #state{subs = Sm0, args = Args} = St1 = traverse(Arg, St0), 573 | St2 = lists:foldl( 574 | fun(Cl, St) -> 575 | traverse(Cl, 576 | St#state{subs = submerge(Args, Sm0, submap(Arg, Cl))}) end, 577 | St1, Cls), 578 | %% Restore the original map before return. 579 | %% Assert that the map of St0 is equal to that of St1. 580 | #state{subs = Sm0} = St0, 581 | St2#state{subs = Sm0}. 582 | 583 | %% @doc Keep track of two distinct mappings: 584 | %% - From each variable to the one it is a subset of 585 | %% - From each variable to the position of the argument it is a subset of. 586 | %% While only the second mapping is useful, the first is necessary 587 | %% in order to recreate it at each new case clause. 588 | submerge(Args, {Map0, Sub0}, Map1) -> 589 | Map2 = merge(Map0, Map1), 590 | {Map2, merge(Sub0, to_argument_map(Args, Map2))}. 591 | 592 | %% @doc Generate the mapping of variables to the position of 593 | %% the argument they are a subset of. 594 | to_argument_map(Args, Map) -> 595 | G = dict:fold(fun make_edge/3, digraph:new(), Map), 596 | M = lists:foldl( 597 | fun({A,N}, D) -> update(D, reaching(G, A), N) end, 598 | dict:new(), Args), 599 | digraph:delete(G), 600 | M. 601 | 602 | make_edge(V1, V2, G) -> 603 | digraph:add_edge(G, digraph:add_vertex(G, V1), 604 | digraph:add_vertex(G, V2)), G. 605 | 606 | reaching(G, A) -> 607 | digraph_utils:reaching_neighbours([A], G). 608 | 609 | submap(Tree, Clause) -> 610 | Items = 611 | case cerl:type(Tree) of 612 | var -> %% single variable match 613 | find_matching_patterns([Tree], Clause); 614 | values -> %% tuple match, e.g. function args 615 | find_matching_patterns(cerl:values_es(Tree), Clause); 616 | _o -> 617 | [] 618 | end, 619 | mapof(Items). 620 | 621 | find_matching_patterns(Vals, Clause) -> 622 | Pats = cerl:clause_pats(Clause), 623 | case length(Vals) =:= length(Pats) of 624 | true -> 625 | [subpattern(V, P) 626 | || {V, P} <- lists:zip(Vals, [unalias(P) || P <- Pats])]; 627 | false -> 628 | [] 629 | end. 630 | 631 | subpattern(Val, Pat) -> 632 | case {cerl:type(Val), cerl:type(Pat)} of 633 | {var, cons} -> %% List pattern match 634 | mapto(Val, Pat, fun cons_vars/1); 635 | {var, binary} -> %% Binary pattern match 636 | mapto(Val, Pat, fun bin_vars/1); 637 | _o -> 638 | [] 639 | end. 640 | 641 | mapto(Var, Pat, Extract) -> 642 | Vn = cerl:var_name(Var), 643 | [{cerl:var_name(V), Vn} || V <- Extract(Pat), cerl:is_c_var(V)]. 644 | 645 | cons_vars(Tree) -> 646 | case cerl:type(Tree) of 647 | cons -> 648 | [cerl:cons_hd(Tree) | cons_vars(cerl:cons_tl(Tree))]; 649 | _ -> 650 | [Tree] 651 | end. 652 | 653 | bin_vars(Tree) -> 654 | [cerl:bitstr_val(B) || B <- cerl:binary_segments(Tree)]. 655 | 656 | %% @doc Extract the pattern from a variable alias. 657 | unalias(Tree) -> 658 | case cerl:type(Tree) of 659 | alias -> 660 | cerl:alias_pat(Tree); 661 | _ -> 662 | Tree 663 | end. 664 | 665 | mapof(Items) -> dict:from_list(lists:flatten(Items)). 666 | 667 | 668 | %% @doc Add subset information on recursive calls. 669 | %% @see handle_case/2 670 | handle_args(MFA, Args, #state{mfa = MFA} = St) -> %% Recursion 671 | ordsets:union(harvest_args(Args, St), get_subsets(Args, St)); 672 | handle_args(_Call, Args, #state{} = St) -> 673 | harvest_args(Args, St). 674 | 675 | get_subsets(Args, #state{}=St) -> 676 | ordsets:from_list(oklist([get_subset(V, St) || V <- enum_args(Args)])). 677 | 678 | get_subset({N, V}, #state{subs = {_, S}}) -> 679 | case dict:find(V, S) of 680 | {ok, N} -> {ok, {sub,N}}; 681 | {ok, _} -> error; 682 | error -> error end. 683 | 684 | oklist(L) -> 685 | [E || {ok, E} <- L]. 686 | 687 | enum_args(Args) -> 688 | [{N, cerl:var_name(A)} || {N, A} <- enumerate(Args), cerl:is_c_var(A)]. 689 | 690 | %% @doc Find any arguments in the list which represents a function. 691 | %% Return a list of {Position, MFA} tuples. 692 | %-spec harvest_args(cerl:cerl(), state()) -> [argument()]. %% dialyzer chokes on cerl(). 693 | harvest_args(Args, #state{} = St) -> 694 | lists:usort(lists:foldl( 695 | fun(NV, Acc) -> find_arg(NV, St, Acc) end, [], enum_args(Args))). 696 | 697 | find_arg({N, {F, A} = Var}, #state{mfa = {M,_,_}, vars = Vs}, Acc) -> 698 | %% No need to lookup Var here, since it represents `letrec' generated 699 | %% funs, which will not be passed around as arguments. 700 | error = map_lookup(Var, Vs), 701 | [{N, {M,F,A}}|Acc]; 702 | %% It appears newer versions of the compiler use variable names like _4540, 703 | %% which are then stored as integers. 704 | find_arg({N, Var}, #state{} = St, Acc) 705 | when (is_atom(Var) orelse is_integer(Var)) -> 706 | case lookup_var(Var, St) of 707 | {ok, {_,_,_}=ArgMFA} -> 708 | [{N, ArgMFA}|Acc]; 709 | error -> 710 | case lookup_arg(Var, St) of 711 | {ok, From} -> 712 | [{arg, {From, N}}|Acc]; 713 | error -> 714 | case is_free(Var, St) of 715 | true -> %% Keep track of free vars passed as args 716 | [{N, {free, Var}}|Acc]; 717 | false -> %% Give up... 718 | Acc 719 | end 720 | end 721 | end. 722 | 723 | 724 | -spec ctx_new() -> []. 725 | ctx_new() -> 726 | ordsets:new(). 727 | 728 | -spec ctx_add(dependency(), D) -> D when D :: deplist(). 729 | ctx_add(Value, Ctx) -> 730 | ordsets:add_element(Value, Ctx). 731 | 732 | ctx_add_many(Values, Ctx) -> 733 | lists:foldl(fun ctx_add/2, Ctx, Values). 734 | 735 | ctx_rem(Value, Ctx) -> 736 | ordsets:del_element(Value, Ctx). 737 | 738 | nst_add(Val, Nst) -> 739 | ordsets:add_element(Val, Nst). 740 | 741 | nst_add_many(Vals, Nst) -> 742 | lists:foldl(fun nst_add/2, Nst, Vals). 743 | 744 | nst_mem(Val, Nst) -> 745 | ordsets:is_element(Val, Nst). 746 | 747 | lookup_var(Name, #state{vars = VarMap} = St) -> 748 | Search = fun(N) -> map_lookup(N, VarMap) end, 749 | name_or_alias(Name, St, Search). 750 | 751 | 752 | lookup_arg(Name, #state{args = ArgMap} = St) -> 753 | Search = fun(N) -> map_lookup(N, ArgMap) end, 754 | name_or_alias(Name, St, Search). 755 | 756 | 757 | -spec map_new() -> []. 758 | map_new() -> 759 | []. 760 | 761 | -spec map_add(map_key(), map_val(), map()) -> map(). 762 | map_add(Key, Val, Map) -> 763 | [{Key, Val}|Map]. 764 | 765 | -spec map_lookup(map_key(), map()) -> error | {ok, map_val()}. 766 | map_lookup(Key, Map) -> 767 | case lists:keyfind(Key, 1, Map) of 768 | false -> 769 | error; 770 | {Key, Value} -> 771 | {ok, Value} 772 | end. 773 | 774 | 775 | -spec name_or_alias(cerl:var_name(), state(), 776 | fun((cerl:var_name()) -> error | {ok, any()})) -> error | {ok, any()}. 777 | 778 | name_or_alias(Name, St, Fun) -> 779 | case Fun(Name) of 780 | error -> 781 | case lookup_alias(Name, St) of 782 | {ok, Alias} -> 783 | Fun(Alias); 784 | error -> 785 | error 786 | end; 787 | Result -> 788 | Result 789 | end. 790 | 791 | 792 | lookup_alias(Name, #state{aliases = Aliases}) -> 793 | dict:find(Name, Aliases). 794 | 795 | 796 | sub_new() -> {dict:new(), dict:new()}. 797 | 798 | 799 | %%% Various helpers. %%% 800 | 801 | update(Table, KeyVals) -> 802 | lists:foldl(fun({K, V}, D) -> dict:store(K, V, D) end, Table, KeyVals). 803 | 804 | update(Table, Funs, Value) -> 805 | update(Table, [{F, Value} || F <- Funs]). 806 | 807 | %% @doc Merge two dictionarys keeping values from the second one when 808 | %% conflicts arise. 809 | merge(D1, D2) -> 810 | dict:merge(fun(_K, _V1, V2) -> V2 end, D1, D2). 811 | 812 | %% @doc Extract the first elements from a list of tuples. 813 | unzip1(Items) -> 814 | unzipN(1, Items). 815 | 816 | %% @doc Extract the Nth elements from a list of tuples. 817 | unzipN(N, Items) -> 818 | [element(N, Tuple) || Tuple <- Items]. 819 | 820 | -------------------------------------------------------------------------------- /src/purity_plt.erl: -------------------------------------------------------------------------------- 1 | %% ==================================================================== 2 | %% This library is free software; you can redistribute it and/or 3 | %% modify it under the terms of the GNU Lesser General Public 4 | %% License as published by the Free Software Foundation; either 5 | %% version 2.1 of the License, or (at your option) any later version. 6 | %% 7 | %% This library is distributed in the hope that it will be useful, 8 | %% but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | %% Lesser General Public License for more details. 11 | %% 12 | %% You should have received a copy of the GNU Lesser General Public 13 | %% License along with this library; if not, write to the Free Software 14 | %% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 15 | %% 02110-1301 USA 16 | %% 17 | %% @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 18 | %% @author Michael Pitidis 19 | %% @end 20 | %% ===================================================================== 21 | 22 | %%% 23 | %%% @doc Persistent Lookup Tables for `purity'. 24 | %%% 25 | 26 | -module(purity_plt). 27 | 28 | -define(utils, purity_utils). 29 | 30 | -import(?utils, [dict_fetch/3, dict_update/2]). 31 | -import(?utils, [str/2, uflatten/1]). 32 | 33 | -export([load/1, save/2, default_path/0]). 34 | -export([new/0, new/2, update/3, verify/1, verify_file/1]). 35 | -export([version/1, table/2, info_table/1, result_table/2]). 36 | -export([dependent_modules/2, filenames/1]). 37 | -export([export/1, export_text/1]). 38 | 39 | -export_type([plt/0]). 40 | 41 | -define(VERSION, "0.5"). 42 | 43 | -ifdef(TEST). 44 | -include("purity_plt_tests.hrl"). 45 | -endif. 46 | 47 | %% Record and type definitions. 48 | 49 | -record(plt, {version = ?VERSION :: string(), 50 | checksums = [] :: [file_checksum()], 51 | table = dict:new() :: dict(), 52 | cache = [] :: [{term(), dict()}]}). 53 | 54 | -opaque plt() :: #plt{}. 55 | 56 | %% Some type shortcuts. 57 | -type files() :: [file:filename()]. 58 | -type options() :: purity_utils:options(). 59 | -type file_checksum() :: {file:filename(), binary()}. 60 | 61 | 62 | %%% Creation and access functions %%% 63 | 64 | -spec new() -> plt(). 65 | new() -> 66 | #plt{}. 67 | 68 | -spec new(dict(), files()) -> plt(). 69 | new(Table, Filenames) -> 70 | #plt{table = Table, 71 | checksums = compute_checksums(absolute(Filenames))}. 72 | 73 | -spec table(plt(), options()) -> dict(). 74 | table(#plt{} = Plt, Options) -> 75 | case result_table(Plt, Options) of 76 | {ok, Table} -> Table; 77 | error -> info_table(Plt) 78 | end. 79 | 80 | -spec result_table(plt(), options()) -> error | {ok, dict()}. 81 | result_table(#plt{cache = C}, Options) -> 82 | assoc_find(cache_key(Options), C). 83 | 84 | -spec info_table(plt()) -> dict(). 85 | info_table(#plt{table = Table}) -> 86 | Table. 87 | 88 | 89 | -spec version(plt()) -> string(). 90 | version(#plt{version = V}) -> V. 91 | 92 | 93 | -spec filenames(plt()) -> files(). 94 | filenames(#plt{checksums = Sums}) -> 95 | [F || {F, _C} <- Sums]. 96 | 97 | 98 | %%% Persistence related functions %%% 99 | 100 | -type load_errors() :: not_plt | no_such_file | read_error. 101 | 102 | -spec load(file:filename()) -> {ok, plt()} | {error, load_errors()}. 103 | 104 | load(Filename) -> 105 | case file:read_file(Filename) of 106 | {ok, Bin} -> 107 | try binary_to_term(Bin) of 108 | #plt{} = Plt -> 109 | {ok, Plt} 110 | catch 111 | _:_ -> 112 | {error, not_plt} 113 | end; 114 | {error, enoent} -> 115 | {error, no_such_file}; 116 | {error, _} -> 117 | {error, read_error} 118 | end. 119 | 120 | 121 | -spec save(plt(), file:filename()) -> ok | {error, string()}. 122 | 123 | save(Plt, Filename) -> 124 | Bin = term_to_binary(Plt, [compressed]), 125 | case file:write_file(Filename, Bin) of 126 | ok -> 127 | ok; 128 | {error, Rsn} -> 129 | {error, str("Could not save PLT file ~s: ~p", [Filename, Rsn])} 130 | end. 131 | 132 | 133 | -spec default_path() -> file:filename(). 134 | 135 | default_path() -> 136 | case os:getenv("PURITY_PLT") of 137 | false -> 138 | case os:getenv("HOME") of 139 | false -> 140 | {error, "You need to set the HOME environment variable " 141 | "in order to load the default PLT"}; 142 | Home -> 143 | filename:join(Home, ".purity.plt") 144 | end; 145 | PltPath -> 146 | PltPath 147 | end. 148 | 149 | 150 | %%% PLT Verification %%% 151 | 152 | -spec verify(plt()) -> ok 153 | | incompatible_version 154 | | {changed_files, {files(), files()}}. 155 | 156 | verify(#plt{version = ?VERSION, checksums = Sums}) -> 157 | case verify_file_checksums(Sums) of 158 | {[], []} -> 159 | ok; 160 | Failing -> 161 | {changed_files, Failing} 162 | end; 163 | verify(#plt{}) -> 164 | incompatible_version. 165 | 166 | verify_file_checksums(Sums) -> 167 | S = ?utils:pmap({?MODULE, verify_file}, [], Sums), 168 | lists:foldl( 169 | fun (ok, Acc) -> Acc; 170 | ({m, F}, {Ms, Es}) -> {[F|Ms], Es}; 171 | ({e, F}, {Ms, Es}) -> {Ms, [F|Es]} end, 172 | {[], []}, S). 173 | 174 | -spec verify_file(file_checksum()) -> ok | {m|e, file:filename()}. 175 | 176 | verify_file({F, C}) -> 177 | case compute_checksum(F) of 178 | {ok, C} -> ok; 179 | {ok, _Different} -> {m, F}; 180 | {error, _Reason} -> {e, F} 181 | end. 182 | 183 | 184 | %%% Checksum helpers %%% 185 | 186 | %% @doc Assumes the files have already been examined and the checksum 187 | %% can be computed without error. 188 | compute_checksums(Filenames) -> 189 | Combine = fun (F, {ok, Sum}) -> {F, Sum} end, 190 | lists:zipwith(Combine, Filenames, [compute_checksum(F) || F <- Filenames]). 191 | 192 | 193 | compute_checksum(Filename) -> 194 | case filelib:is_regular(Filename) of 195 | false -> 196 | {error, "Not a regular file: " ++ Filename}; 197 | true -> 198 | case purity_utils:get_abstract_code_from_beam(Filename) of 199 | error -> 200 | {error, "Could not extract abstract code from " ++ Filename}; 201 | {ok, Abstract} -> 202 | {ok, erlang:md5(term_to_binary(Abstract))} 203 | end 204 | end. 205 | 206 | 207 | %% @doc Provided a list of files, return a list of modules which depend 208 | %% on them and should be re-analysed. 209 | -spec dependent_modules(plt(), files()) -> [module()]. 210 | 211 | dependent_modules(#plt{table = T}, Filenames) -> 212 | Ms = ?utils:module_rmap(T), 213 | uflatten([reachable(module(F), Ms) || F <- Filenames]). 214 | 215 | 216 | %% @doc Update the PLT with a new table and files. 217 | -spec update(plt(), options(), {files(), dict(), dict()}) -> 218 | {ok, plt()} | {error, inconsistent_tables}. 219 | 220 | update(Plt, Options, {Filenames, T, R}) -> 221 | #plt{cache = C0, checksums = CS0, table = T0} = Plt, 222 | case consistent(T, R) of 223 | false -> 224 | {error, inconsistent_tables}; 225 | true -> 226 | AbsFiles = absolute(Filenames), 227 | %% Keep track of any modules which should be removed from 228 | %% the tables because they cannot be checksumed. 229 | {CS1, CSErrors} = separate([{F, compute_checksum(F)} || F <- AbsFiles]), 230 | Broken = [module(B) || B <- CSErrors], 231 | Analysed = [module(F) || F <- Filenames], 232 | 233 | %% Update any previous checksums with the current ones, 234 | %% in case parts of the table are being re-analysed. 235 | %% The analysis itself should make sure the table is 236 | %% consistent with regard to such files. 237 | CS = update_checksums(CS0, CS1), 238 | 239 | Tn = update_table(T0, T, Analysed, Broken), 240 | 241 | R0 = fetch_results(Options, C0), 242 | Rn = update_table(R0, R, Analysed, Broken), 243 | 244 | %% Keep only cached results which are still consistent, and 245 | %% remove broken modules from all of them. 246 | C1 = [{K, delete_modules(C, Broken)} || 247 | {K, C} <- keep_consistent(C0, Tn)], 248 | Cn = assoc_store(cache_key(Options), Rn, C1), 249 | 250 | {ok, Plt#plt{table = Tn, cache = Cn, checksums = CS}} 251 | end. 252 | 253 | update_checksums(CS1, CS2) -> 254 | dict:to_list(dict_update( 255 | dict:from_list(CS1), dict:from_list(CS2))). 256 | 257 | fetch_results(O, C) -> 258 | case assoc_find(cache_key(O), C) of 259 | {ok, R} -> 260 | R; 261 | error -> 262 | dict:new() 263 | end. 264 | 265 | %% @doc Updating a PLT table consists of the following steps: 266 | %% - Remove any re-analysed modules from the old table. 267 | %% This is necessary in order to account for the removal of functions 268 | %% in the re-analysed modules. Providing an explicit list of modules 269 | %% based on the file list is important too, in order to work seamlessly 270 | %% with result tables, which may contain arbitrary functions from the 271 | %% old result table. 272 | %% - Update the resulting table with the new table. 273 | %% - Remove any broken modules from the result. 274 | update_table(Old, New, Modules, Broken) -> 275 | T1 = delete_modules(Old, Modules), 276 | T2 = dict_update(T1, New), 277 | delete_modules(T2, Broken). 278 | 279 | keep_consistent(Cache, Info) -> 280 | lists:filter(fun ({_K, Result}) -> consistent(Info, Result) end, Cache). 281 | 282 | %% @doc Since the analysis may add BIFs to the lookup table, just 283 | %% verify that Results is a superset of it. 284 | consistent(Info, Results) -> 285 | %% set(keys(Info)) <= set(keys(Results)) 286 | lists:all(fun (K) -> dict:is_key(K, Results) end, 287 | dict:fetch_keys(Info)). 288 | 289 | separate(Sums) -> 290 | lists:foldl(fun separate/2, {[], []}, Sums). 291 | 292 | separate({F, {ok, C}}, {Good, Bad}) -> 293 | {[{F, C}|Good], Bad}; 294 | separate({F, {error, _}}, {Good, Bad}) -> 295 | {Good, [F|Bad]}. 296 | 297 | %%% Helpers %%% 298 | 299 | module(Filename) -> 300 | ?utils:filename_to_module(Filename). 301 | 302 | delete_modules(Table, Modules) -> 303 | ?utils:delete_modules(Table, Modules). 304 | 305 | %% @doc Produce a key from any relevant options. 306 | cache_key(Options) -> 307 | lists:usort(lists:filter(fun relevant/1, Options)). 308 | 309 | relevant({purelevel, _}) -> 310 | true; 311 | relevant(termination) -> 312 | true; 313 | relevant(both) -> 314 | true; 315 | relevant(_) -> 316 | false. 317 | 318 | 319 | reachable(Module, Map) -> 320 | case dict_fetch(Module, Map, []) of 321 | [] -> [Module]; 322 | Ms -> sets:to_list(reachable(Ms, Map, sets:from_list([Module|Ms]))) 323 | end. 324 | 325 | reachable([], _Map, S) -> S; 326 | reachable([K|Ks], Map, S) -> 327 | case [D || D <- dict_fetch(K, Map, []), not sets:is_element(D, S)] of 328 | [] -> reachable(Ks, Map, S); 329 | Ds -> reachable(Ks, Map, reachable(Ds, Map, add_elements(Ds, S))) 330 | end. 331 | 332 | add_elements(Es, S) -> 333 | lists:foldl(fun sets:add_element/2, S, Es). 334 | 335 | 336 | %% @doc Refer to filename:absname/1 for limitations of this approach. 337 | absolute(Filenames) -> 338 | [filename:absname(F) || F <- Filenames]. 339 | 340 | 341 | %% @doc Consistent dict-like interface for handling association lists. 342 | assoc_find(Key, List) -> 343 | case lists:keyfind(Key, 1, List) of 344 | false -> 345 | error; 346 | {Key, Value} -> 347 | {ok, Value} 348 | end. 349 | 350 | assoc_store(Key, Value, []) -> 351 | [{Key, Value}]; 352 | assoc_store(Key, Value, [{Key, _Old}|T]) -> 353 | [{Key, Value}|T]; 354 | assoc_store(Key, Value, [H|T]) -> 355 | [H|assoc_store(Key, Value, T)]. 356 | 357 | 358 | -spec export(plt()) -> {string(), [{_,_}], [{_,_}], [{_,_}]}. 359 | 360 | %% @doc Export a PLT into a simple deterministic structure, useful 361 | %% for debugging. 362 | export(#plt{table = T, cache = C, checksums = CS, version = V}) -> 363 | {V, lists:keysort(2, [{md5hex(MD5), F} || {F, MD5} <- CS]), 364 | lists:sort(dict:to_list(T)), 365 | lists:sort([{K, lists:sort(dict:to_list(R))} || {K, R} <- C])}. 366 | 367 | 368 | %% @doc Export a PLT as plain text. 369 | -spec export_text(plt()) -> [iolist()]. 370 | 371 | export_text(Plt) -> 372 | {Vsn, CS, T, R} = export(Plt), 373 | P1 = fun (F) -> io_lib:format(F ++ "~n", []) end, 374 | %% Converting to binary is necessary for large PLTs as character 375 | %% lists are very wasteful with regard to memory. 376 | P2 = fun (F, A) -> list_to_binary(io_lib:format(F ++ "~n", A)) end, 377 | PL = fun (L) -> print(P2, "~s: ~w", L, fun ?utils:fmt_mfa/1) end, 378 | [ P2("PLT ~s", [Vsn]), 379 | P1("FILES"), print(P2, "~s: ~s", CS), 380 | P1("TABLE"), PL(T), 381 | [[P2("RESULTS ~p", [K]), PL(V)] || {K, V} <- R] ]. 382 | 383 | 384 | print(Print, Fmt, Items) -> 385 | print(Print, Fmt, Items, fun (X) -> X end). 386 | 387 | print(Print, Fmt, Items, MapKey) -> 388 | [Print(Fmt, [MapKey(K), V]) || {K, V} <- Items]. 389 | 390 | 391 | %md5hex(<>) -> ?utils:str("~32.16.0b", [MD5]). 392 | md5hex(<>) -> 396 | ?utils:str("~8.16.0b~8.16.0b~8.16.0b~8.16.0b", [A, B, C, D]). 397 | 398 | -------------------------------------------------------------------------------- /src/purity_plt_tests.hrl: -------------------------------------------------------------------------------- 1 | 2 | -include_lib("eunit/include/eunit.hrl"). 3 | 4 | %-spec reachlist([{any(),any()}]|dict()) -> [{any(),any()}]. 5 | reachlist(M) when is_list(M) -> 6 | reachlist(dict:from_list(M)); 7 | reachlist(M) -> % assume dict... 8 | lists:sort(dict:to_list(dict_map(fun sort/1, reachable(M)))). 9 | 10 | sort(S) -> 11 | lists:sort(sets:to_list(S)). 12 | 13 | 14 | reachable_test_() -> 15 | [?_assertMatch([ {a, [a,b,c,d]}, {b, [a,b,c,d]} ], 16 | reachlist([ {a, [b,c]}, {b, [d,a]} ])) 17 | ,?_assertMatch([ {a, [b,c,d]}, {b, [c,d]}, {c, [d]} ], 18 | reachlist([ {a, [b]}, {b, [c]}, {c, [d]} ])) 19 | ]. 20 | 21 | -------------------------------------------------------------------------------- /src/purity_stats.erl: -------------------------------------------------------------------------------- 1 | %% ==================================================================== 2 | %% This library is free software; you can redistribute it and/or 3 | %% modify it under the terms of the GNU Lesser General Public 4 | %% License as published by the Free Software Foundation; either 5 | %% version 2.1 of the License, or (at your option) any later version. 6 | %% 7 | %% This library is distributed in the hope that it will be useful, 8 | %% but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | %% Lesser General Public License for more details. 11 | %% 12 | %% You should have received a copy of the GNU Lesser General Public 13 | %% License along with this library; if not, write to the Free Software 14 | %% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 15 | %% 02110-1301 USA 16 | %% 17 | %% @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 18 | %% @author Michael Pitidis 19 | %% @end 20 | %% ===================================================================== 21 | 22 | %%% 23 | %%% @doc Generate statistics from purity results of analysed modules. 24 | %%% 25 | 26 | -module(purity_stats). 27 | 28 | -define(utils, purity_utils). 29 | 30 | -export([gather/2, write/2]). 31 | 32 | -export_type([stats/0]). 33 | 34 | -record(stats, {p = 0, e = 0, d = 0, s = 0, 35 | h = 0, 36 | l = 0, 37 | u = 0}). 38 | 39 | -define(FIELDS, [#stats.p, #stats.e, #stats.d, #stats.s, 40 | #stats.h, #stats.l, #stats.u]). 41 | 42 | -define(HEADERS, ["pure", "exceptions", "depedent", "effects", 43 | "hofs", "limited", "undefined"]). 44 | 45 | -define(FLEN, "~10"). 46 | 47 | -type stats() :: #stats{}. 48 | -type mod_stats() :: {module(), stats()}. 49 | 50 | %% @doc Generate an assoc list of modules and their statistics. 51 | -spec gather([module()], dict()) -> [mod_stats()]. 52 | 53 | gather(Modules, Table) -> 54 | Ms = sets:from_list(Modules), 55 | Vs = [Val || {{M,_,_}, _} = Val <- dict:to_list(Table), 56 | sets:is_element(M, Ms)], 57 | sort(dict:to_list( 58 | lists:foldl(fun update_stats/2, dict:new(), Vs) )). 59 | 60 | 61 | %% @doc Write an assoc list of modules and statistics to file. 62 | -spec write(file:filename(), [mod_stats()]) -> ok. 63 | 64 | write(Filename, Stats) -> 65 | case file:open(Filename, [write]) of 66 | {ok, Io} -> 67 | write_stats(Io, Stats), 68 | file:close(Io); 69 | {error, Reason} -> 70 | io:format("ERROR opening stats file ~p: ~p~n", [Filename, Reason]) 71 | end. 72 | 73 | write_stats(Io, Stats) -> 74 | io:format(Io, join(" ", [?FLEN++"s" || _ <- ?HEADERS]) ++ "~n", ?HEADERS), 75 | lists:foreach(fun(S) -> format(Io, S) end, Stats), 76 | {_Ms, Ss} = lists:unzip(Stats), 77 | Sum = sum(Ss), 78 | Fmt = join(" ", [?utils:str("~s ~~.1f", [H]) || H <- ?HEADERS]), 79 | Vals = [percent(F, Sum) || F <- ?FIELDS], 80 | io:format(Io, 81 | "# Aggregate: " ++ Fmt ++ " modules ~b functions ~b~n", 82 | Vals ++ [length(Stats), total(Sum)]). 83 | 84 | format(IoDev, {M, #stats{} = S}) -> 85 | Fmt = join(" ", [?FLEN++"b" || _ <- ?FIELDS]), 86 | Vals = [element(F, S) || F <- ?FIELDS], 87 | io:format(IoDev, Fmt ++ " ~5.1f ~p~n", Vals ++ [percent(S), M]). 88 | 89 | sum(StatList) -> 90 | lists:foldl(fun add_stats/2, #stats{}, StatList). 91 | 92 | add_stats(#stats{}=S1, #stats{}=S2) -> 93 | lists:foldl( 94 | fun(Field, S) -> 95 | setelement(Field, S, element(Field, S1) + element(Field, S2)) end, 96 | #stats{}, ?FIELDS). 97 | 98 | 99 | update_stats({{M,_,_} = MFA, Val}, Dict) -> 100 | case ?utils:internal_function(MFA) of 101 | true -> % Ignore internal functions. 102 | Dict; 103 | false -> 104 | F = fun(#stats{} = S) -> match(Val, S) end, 105 | I = match(Val, #stats{}), 106 | dict:update(M, F, I, Dict) 107 | end. 108 | 109 | 110 | match({{at_least, _}, []}, S) -> 111 | incr(#stats.l, S); 112 | 113 | match({P, []}, S) -> 114 | match_aux(P, S); 115 | 116 | match({_, D}, S) -> 117 | case is_hof(D) of 118 | true -> 119 | incr(#stats.h, S); 120 | false -> 121 | incr(#stats.u, S) 122 | end. 123 | 124 | match_aux(p, S) -> incr(#stats.p, S); 125 | match_aux(e, S) -> incr(#stats.e, S); 126 | match_aux(d, S) -> incr(#stats.d, S); 127 | match_aux(s, S) -> incr(#stats.s, S). 128 | 129 | incr(Field, #stats{} = S) -> 130 | setelement(Field, S, 1 + element(Field, S)). 131 | 132 | is_hof(D) -> 133 | [] =/= [A || {arg,A} <- D]. 134 | 135 | 136 | -spec sort([mod_stats()]) -> [mod_stats()]. 137 | 138 | sort(Stats) -> 139 | lists:sort(fun compare/2, Stats). 140 | 141 | compare({_, S1}, {_, S2}) -> 142 | percent(S1) =< percent(S2). 143 | 144 | percent(#stats{} = S) -> 145 | percent(#stats.p, S). 146 | 147 | percent(Field, S) -> 148 | case total(S) of 149 | 0 -> 0.0; 150 | T -> (100 * element(Field, S)) / T 151 | end. 152 | 153 | total(#stats{} = S) -> 154 | lists:foldl( 155 | fun(Field, Sum) -> Sum + element(Field, S) end, 156 | 0, ?FIELDS). 157 | 158 | join(Sep, Strings) -> 159 | string:join(Strings, Sep). 160 | 161 | -------------------------------------------------------------------------------- /src/purity_utils.erl: -------------------------------------------------------------------------------- 1 | %% ==================================================================== 2 | %% This library is free software; you can redistribute it and/or 3 | %% modify it under the terms of the GNU Lesser General Public 4 | %% License as published by the Free Software Foundation; either 5 | %% version 2.1 of the License, or (at your option) any later version. 6 | %% 7 | %% This library is distributed in the hope that it will be useful, 8 | %% but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | %% Lesser General Public License for more details. 11 | %% 12 | %% You should have received a copy of the GNU Lesser General Public 13 | %% License along with this library; if not, write to the Free Software 14 | %% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 15 | %% 02110-1301 USA 16 | %% 17 | %% @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 18 | %% @author Michael Pitidis 19 | %% @end 20 | %% ===================================================================== 21 | 22 | %%% 23 | %%% @doc Various utility functions for `purity'. 24 | %%% 25 | 26 | -module(purity_utils). 27 | 28 | -export([dependencies/2, dependencies/3, module_rmap/1, function_rmap/1]). 29 | 30 | -export([is_mfa/1, is_primop/1, is_expr/1, is_bif/1]). 31 | 32 | -export([delete_modules/2]). 33 | 34 | -export([dict_map/2, dict_fold/2, dict_mapfold/3, dict_cons/3]). 35 | -export([dict_store/2, dict_store/3, dict_fetch/3, dict_update/2]). 36 | 37 | -export([uflatten/1, str/2, fmt_mfa/1, filename_to_module/1]). 38 | 39 | -export([internal_function/1]). 40 | 41 | -export([emsg/1, emsg/2]). 42 | 43 | -export([pmap/4, pmap/3]). 44 | 45 | -export([get_core/1, get_core/2, get_abstract_code_from_beam/1]). 46 | 47 | -export([option/2, option/3]). 48 | 49 | -export([timeit/2, timeit/3, format_time/1, timed/2, get_time/0]). 50 | 51 | 52 | -export_type([options/0, purity/0, purity_level/0, primop/0, emfa/0]). 53 | -export_type([dependency/0, deplist/0, argument/0]). 54 | 55 | 56 | -ifdef(TEST). 57 | -include("purity_utils_tests.hrl"). 58 | -endif. 59 | 60 | 61 | %% The type for options relevant to the analysis. 62 | 63 | -type options() :: [atom() | {atom(), any()}]. 64 | 65 | %% The level of purity a function can have. 66 | %% - p Referrentialy transparent. 67 | %% - e May raise exceptions. 68 | %% - d Dependent on the execution environment. 69 | %% - s Has side-effects. 70 | %% In the case of termination analysis, only two of the levels are used: 71 | %% - p Terminating 72 | %% - s Non-terminating 73 | -type purity_level() :: p | e | d | s. 74 | 75 | -type purity() :: purity_level() | {at_least, purity_level()}. 76 | 77 | %% The value of the lookup table. 78 | -type tab_value() :: deplist() %% Info table. 79 | | {purity(), deplist()}. %% Result table. 80 | 81 | -type deplist() :: [dependency()]. 82 | 83 | -type dependency() :: {arg, pos_integer()} %% Higher order dependency on argument. 84 | | {remote, emfa(), [argument()]} 85 | | {local, mfa() | atom(), [argument()]} 86 | | {free, atom(), [argument()]} %% Free variable. 87 | | {primop, primop(), [argument()]} 88 | | expr(). 89 | 90 | -type argument() :: {pos_integer(), mfa()} %% Concrete argument passed as argument. 91 | %% The positions of an argument passed on to another call. 92 | %% Used for tracking indirect higher order functions. 93 | | {arg, {pos_integer(), pos_integer()}} 94 | %% Track arguments which were passed "reduced" in a recursive call. 95 | %% Used in termination analysis to detect terminating recursive functions. 96 | | {sub, pos_integer()}. 97 | 98 | %% Extended MFAs which may include variables in place of modules/functions. 99 | -type emfa() :: {module()|{var, atom()}, atom()|{var, atom()}, arity()}. 100 | 101 | %% Primitive operations: These are implementation dependent and 102 | %% their purity is hard-coded. 103 | -type primop() :: {atom(), arity()}. 104 | 105 | %% Erlang expressions influential to the analysis. 106 | %% The `catch' expression depends on the execution environment since it 107 | %% may contain part of the expression's stack trace. 108 | %% The distinction between finite and infinite receive expressions is 109 | %% included for the sake of termination analysis only. 110 | -type expr() :: {erl, 'catch' | {'receive', finite | infinite}}. 111 | 112 | 113 | -spec module_rmap(dict()) -> dict(). 114 | module_rmap(Tab) -> 115 | dict:map(fun remove_self/2, dict_fold(fun module_rmap/3, Tab)). 116 | 117 | module_rmap({M,_,_}, DL, Ms) -> 118 | lists:foldl( 119 | fun ({K,_,_}, Mn) -> dict_cons(K, M, Mn) end, 120 | Ms, dependencies(DL, fun is_mfa/1, true)); 121 | module_rmap(_, _, Ms) -> Ms. 122 | 123 | remove_self(M, Rs) -> 124 | ordsets:del_element(M, ordsets:from_list(Rs)). 125 | 126 | 127 | -spec function_rmap(dict()) -> dict(). 128 | function_rmap(Tab) -> 129 | dict_map(fun lists:usort/1, dict_fold(fun function_rmap/3, Tab)). 130 | 131 | function_rmap(F, {_P, DL}, Rs) -> 132 | lists:foldl( 133 | fun (D, Rn) -> dict_cons(D, F, Rn) end, 134 | Rs, dependencies(DL, fun common_dependencies/1, false)). 135 | 136 | 137 | -spec dependencies(tab_value(), fun((term()) -> boolean()), boolean()) -> [term()]. 138 | dependencies({_P, DepList}, Filter, Higher) when is_list(DepList) -> 139 | %% Handle the two different lookup tables transparently. 140 | dependencies(DepList, Filter, Higher); 141 | dependencies(DepList, Filter, Higher) when is_list(DepList) -> 142 | L1 = [F || {_type, F, _As} <- DepList, Filter(F)] ++ 143 | [E || E <- DepList, is_expr(E), Filter(E)], 144 | case Higher of 145 | true -> 146 | L2 = [F || {_type, _f, As} <- DepList, 147 | {N, F} <- As, is_integer(N), Filter(F)], 148 | lists:reverse(L2, L1); % rev append 149 | false -> L1 150 | end. 151 | 152 | 153 | common_dependencies(D) -> 154 | is_mfa(D) orelse is_primop(D) orelse is_expr(D). 155 | 156 | 157 | %% @doc Higher level dependency collectors which work on an entire lookup table. 158 | -spec dependencies(dict(), fun((term()) -> boolean())) -> [term()]. 159 | 160 | dependencies(Table, Filter) -> 161 | uflatten(dict:fold(dep_collector(Filter), [], Table)). 162 | 163 | %% @doc Create a function to collect any dependencies passing the filter. 164 | dep_collector(Filter) -> 165 | fun (_, V, Ds) -> [dependencies(V, Filter, true)|Ds] end. 166 | 167 | 168 | %% Dependency filters. 169 | 170 | -spec is_mfa(term()) -> boolean(). 171 | is_mfa({M,F,A}) when is_atom(M), is_atom(F), A >= 0, A =< 255 -> 172 | true; 173 | is_mfa(_) -> 174 | false. 175 | 176 | -spec is_primop(term()) -> boolean(). 177 | is_primop({P, A}) when is_atom(P), A >= 0, A =< 255 -> 178 | true; 179 | is_primop(_) -> 180 | false. 181 | 182 | -spec is_expr(term()) -> boolean(). 183 | is_expr({erl, _}) -> 184 | true; 185 | is_expr(_) -> 186 | false. 187 | 188 | -spec is_bif(term()) -> boolean(). 189 | is_bif(Fun) -> 190 | (is_mfa(Fun) orelse is_primop(Fun)) andalso purity_bifs:is_known(Fun). 191 | 192 | %% @doc Remove any functions belonging to Modules from the Table. 193 | 194 | -spec delete_modules(D, [module()]) -> D when D :: dict(). 195 | 196 | delete_modules(Table, []) -> 197 | Table; 198 | delete_modules(Table, Modules) -> 199 | S = sets:from_list(Modules), 200 | dict:filter( 201 | fun({M,_,_}, _V) -> not sets:is_element(M, S); (_K, _V) -> true end, 202 | Table). 203 | 204 | 205 | %%% Dict related helpers. %%% 206 | 207 | -spec dict_map(fun((Value) -> Value), D) -> D when D :: dict(). 208 | dict_map(Fun, Dict) -> dict:map(fun (_K, V) -> Fun(V) end, Dict). 209 | 210 | -spec dict_fold(fun((term(), term(), Acc) -> Acc), dict()) -> Acc when Acc :: dict(). 211 | dict_fold(Fun, Dict) -> dict:fold(Fun, dict:new(), Dict). 212 | 213 | -spec dict_cons(term(), term(), D) -> D when D :: dict(). 214 | dict_cons(Key, Value, Dict) -> 215 | dict:update(Key, fun (Previous) -> [Value|Previous] end, [Value], Dict). 216 | 217 | -spec dict_fetch(term(), dict(), term()) -> term(). 218 | dict_fetch(Key, Dict, Default) -> 219 | case dict:find(Key, Dict) of 220 | {ok, Value} -> Value; 221 | error -> Default 222 | end. 223 | 224 | -spec dict_update(dict(), dict()) -> dict(). 225 | dict_update(Dict1, Dict2) -> 226 | dict:merge(fun (_K, _V1, V2) -> V2 end, Dict1, Dict2). 227 | 228 | 229 | %% @doc Not as efficient as a native implementation would be, 230 | %% but usefull all the same. 231 | -spec dict_mapfold(fun((term(), Value, Acc) -> {Value, Acc}), Acc, dict()) -> {dict(), Acc}. 232 | dict_mapfold(Fun, Acc0, Dict) -> 233 | dict:fold( 234 | fun(K, V1, {Map, Acc1}) -> 235 | {V2, Acc2} = Fun(K, V1, Acc1), 236 | {dict:store(K, V2, Map), Acc2} end, 237 | {dict:new(), Acc0}, Dict). 238 | 239 | 240 | %% @doc Update a dict with a list of key-value pairs. 241 | -spec dict_store([{term(),term()}], dict()) -> dict(). 242 | dict_store(KeyVals, Dict) -> 243 | lists:foldl(fun ({K, V}, D) -> dict:store(K, V, D) end, Dict, KeyVals). 244 | 245 | %% @doc Update a list of keys with the same value in a dictionary. 246 | -spec dict_store([term()], term(), dict()) -> dict(). 247 | dict_store(Keys, Value, Dict) -> 248 | lists:foldl(fun (K, D) -> dict:store(K, Value, D) end, Dict, Keys). 249 | 250 | 251 | %%% Miscellaneous functions %%% 252 | 253 | -spec uflatten([term()]) -> [term()]. 254 | uflatten(List) -> 255 | lists:usort(lists:flatten(List)). 256 | 257 | 258 | -spec str(string(), [term()]) -> string(). 259 | str(Fmt, Args) -> 260 | lists:flatten(io_lib:format(Fmt, Args)). 261 | 262 | 263 | -spec fmt_mfa(emfa() | primop() | expr()) -> string(). 264 | fmt_mfa({M, F, A}) -> % emfa 265 | str("~p:~p/~b", [M, F, A]); 266 | fmt_mfa({erl,_} = E) -> % expr 267 | str("~p", [E]); 268 | fmt_mfa({P, A}) -> % primop 269 | str("~p:/~b", [P, A]). 270 | 271 | %% @doc Return what should correspond to the Erlang module for the 272 | %% specified filename. 273 | -spec filename_to_module(file:filename()) -> atom(). 274 | 275 | filename_to_module(Filename) -> 276 | list_to_atom(filename:basename(filename:rootname(Filename))). 277 | 278 | 279 | %% @doc Detect common functions generated by the compiler for each module. 280 | -spec internal_function(term()) -> boolean(). 281 | 282 | internal_function({_, module_info, 0}) -> true; 283 | internal_function({_, module_info, 1}) -> true; 284 | internal_function({_, record_info, 2}) -> true; 285 | internal_function(_) -> false. 286 | 287 | 288 | -spec emsg(string()) -> ok. 289 | emsg(Msg) -> 290 | io:format(standard_error, "ERROR: ~p~n", [Msg]). 291 | 292 | -spec emsg(string(), [any()]) -> ok. 293 | emsg(Msg, Args) -> 294 | io:format(Msg ++ "~n", Args). 295 | 296 | 297 | %% @doc Variation of the rpc:pmap/3 function which limits the number of 298 | %% active processes. This can prove useful when each process requires 299 | %% lots of memory. 300 | 301 | -spec pmap({module(), atom()}, [any()], [any()], pos_integer()) -> [any()]. 302 | 303 | pmap({M, F}, Extra, List, N) -> 304 | Funs = [fun() -> apply(M, F, [Arg|Extra]) end || Arg <- List], 305 | pmap_init(Funs, N). 306 | 307 | %% @doc Convenience wrapper around pmap/4 which uses one process per 308 | %% logical processor. 309 | 310 | -spec pmap({module(), atom()}, [any()], [any()]) -> [any()]. 311 | 312 | pmap(MF, Extra, List) -> 313 | pmap(MF, Extra, List, erlang:system_info(logical_processors)). 314 | 315 | -record(pst, {num = 0, 316 | queue = [], 317 | results = [], 318 | active = 0}). 319 | 320 | %% @doc Start by running Size processes in parallel, then add 321 | %% one process for each process that terminates. 322 | pmap_init(Funs, Size) -> 323 | {First, Next} = take(Size, Funs), 324 | St1 = lists:foldl( 325 | fun(_F, S) -> spawn_next(S) end, #pst{queue = First}, First), 326 | pool(St1#pst{queue = Next}). 327 | 328 | take(N, List) when N > 0 -> 329 | take(N, List, []). 330 | 331 | take(N, Rest, Acc) when N =:= 0 orelse Rest =:= [] -> 332 | {lists:reverse(Acc), Rest}; 333 | take(N, [H|T], Acc) -> 334 | take(N-1, T, [H|Acc]). 335 | 336 | pool(#pst{active = 0, results = R}) -> 337 | [V || {_, V} <- lists:keysort(1, R)]; 338 | pool(#pst{results = R, active = A} = St0) -> 339 | receive 340 | {ok, Key, Val} -> 341 | St1 = St0#pst{results = [{Key, Val}|R], active = A-1}, 342 | pool(spawn_next(St1)) 343 | end. 344 | 345 | spawn_next(#pst{num = N0, queue = [Fun|Qt], active = A} = St0) -> 346 | N1 = N0 + 1, 347 | Self = self(), 348 | spawn(fun() -> Res = Fun(), Self ! {ok, N1, Res} end), 349 | St0#pst{num = N1, queue = Qt, active = A + 1}; 350 | spawn_next(#pst{queue = []} = St0) -> 351 | St0. 352 | 353 | 354 | %%% Core Erlang manipulation utilities: 355 | %%% ___________________________________ 356 | 357 | 358 | %% @doc Compile to Core Erlang and return the parsed core tree. 359 | 360 | -type get_core_ret() :: {ok, cerl:c_module()} | {error, string()}. 361 | -spec get_core(file:filename()) -> get_core_ret(). 362 | 363 | get_core(Filename) -> 364 | get_core(Filename, []). 365 | 366 | %% @doc Compile to Core Erlang and return the parsed core tree. 367 | 368 | -spec get_core(file:filename(), [atom()]) -> get_core_ret(). 369 | 370 | get_core(Filename, Options) -> 371 | Compile = case string:to_lower(filename:extension(Filename)) of 372 | ".erl" -> 373 | fun compile_src/2; 374 | _ -> % Assumes .beam or no extension. 375 | fun compile_bin/2 376 | end, 377 | try Compile(Filename, [binary, copt, to_core, return_errors | Options]) of 378 | {ok, _Module, Core} -> 379 | {ok, Core}; 380 | {error, beam} -> 381 | {error, "Could not extract abstract code from " ++ Filename}; 382 | {error, Errors, _Warnings} -> 383 | {error, str("Compilation failed with errors: ~s (~p)", [Filename, Errors])} 384 | catch error:_ -> 385 | {error, "Compilation raised exception"} 386 | end. 387 | 388 | 389 | compile_src(Filename, Options) -> 390 | compile:file(Filename, Options). 391 | 392 | 393 | compile_bin(Filename, Options) -> 394 | case get_abstract_code_from_beam(Filename) of 395 | {ok, Abstract} -> 396 | compile:forms(Abstract, Options); 397 | error -> 398 | {error, beam} 399 | end. 400 | 401 | %% Copied from dialyzer_utils. 402 | %% term() should be beam_lib:forms() (not exported). 403 | -spec get_abstract_code_from_beam(file:filename()) -> {ok, term()} | error. 404 | 405 | get_abstract_code_from_beam(Filename) -> 406 | case beam_lib:chunks(Filename, [abstract_code]) of 407 | {ok, {_, List}} -> 408 | case lists:keyfind(abstract_code, 1, List) of 409 | {abstract_code, {raw_abstract_v1, Abstr}} -> 410 | {ok, Abstr}; 411 | _ -> 412 | error 413 | end; 414 | _ -> 415 | %% No or unsuitable abstract code. 416 | error 417 | end. 418 | 419 | 420 | -spec option(atom(), options()) -> term(). 421 | 422 | option(Name, Options) -> option(Name, Options, false). 423 | 424 | -spec option(atom(), options(), term()) -> term(). 425 | 426 | option(Name, Options, Default) -> 427 | proplists:get_value(Name, Options, Default). 428 | 429 | 430 | -type time() :: non_neg_integer(). 431 | 432 | %% @doc Report the execution time of a function. 433 | %% @see timeit/2 434 | %% @see timed/2 435 | 436 | -spec timeit(string(), fun(), [term()]) -> term(). 437 | 438 | timeit(Msg, Fun, Args) -> 439 | io:format("~-22s... ", [Msg]), 440 | {T, R} = timed(Fun, Args), 441 | io:format("done in ~s~n", [format_time(T)]), 442 | R. 443 | 444 | %% @doc Convenience shortcut to `timeit/3' for a function without arguments. 445 | -spec timeit(string(), fun(() -> T)) -> T. 446 | 447 | timeit(Msg, Fun) -> 448 | timeit(Msg, Fun, []). 449 | 450 | 451 | %% @doc Format time in miliseconds to Minutes Seconds.Miliseconds. 452 | 453 | -spec format_time(time()) -> string(). 454 | 455 | format_time(T) -> 456 | str("~bm~5.2.0fs", [T div 60000, (T rem 60000) / 1000]). 457 | 458 | 459 | %% @doc Time the execution of a specified function, relying on 460 | %% erlang:statistics/1 calls instead of erlang:now/0. 461 | 462 | -spec timed(fun(), [term()]) -> {time(), term()}. 463 | 464 | timed(Fun, Args) -> 465 | T1 = get_time(), 466 | Rt = apply(Fun, Args), 467 | T2 = get_time(), 468 | {T2 - T1, Rt}. 469 | 470 | 471 | -spec get_time() -> time(). 472 | 473 | get_time() -> 474 | {T0, _} = 475 | case get(statistics) of 476 | undefined -> statistics(wall_clock); 477 | StatsType -> statistics(StatsType) 478 | end, T0. 479 | 480 | -------------------------------------------------------------------------------- /src/purity_utils_tests.hrl: -------------------------------------------------------------------------------- 1 | 2 | -include_lib("eunit/include/eunit.hrl"). 3 | 4 | dl(D) -> 5 | lists:sort(dict:to_list(D)). 6 | 7 | ld(L) -> 8 | dict:from_list(make_mfas(L)). 9 | 10 | make_mfas(L) -> 11 | [{mock_mfa(M), mock_deps(Ds)} || {M, Ds} <- L]. 12 | 13 | mock_mfa(M) -> {M,f,1}. 14 | 15 | mock_deps(Ds) -> {p, [{remote, mock_mfa(D), []} || D <- Ds]}. 16 | 17 | module_rmap_test_() -> 18 | [?_assertMatch([ {a, [b, c]}, {b, [a]}, {c, [a]}, {d, [b]}, {e, [b]} ], 19 | dl(module_rmap(ld( [ {a, [b,c]}, {b, [a, d, e]}, {c, [a]} ] )))) 20 | ]. 21 | 22 | -------------------------------------------------------------------------------- /src/runtest.erl: -------------------------------------------------------------------------------- 1 | %% ==================================================================== 2 | %% This library is free software; you can redistribute it and/or 3 | %% modify it under the terms of the GNU Lesser General Public 4 | %% License as published by the Free Software Foundation; either 5 | %% version 2.1 of the License, or (at your option) any later version. 6 | %% 7 | %% This library is distributed in the hope that it will be useful, 8 | %% but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 10 | %% Lesser General Public License for more details. 11 | %% 12 | %% You should have received a copy of the GNU Lesser General Public 13 | %% License along with this library; if not, write to the Free Software 14 | %% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 15 | %% 02110-1301 USA 16 | %% 17 | %% @copyright 2009-2011 Michael Pitidis, Kostis Sagonas 18 | %% @author Michael Pitidis 19 | %% @end 20 | %% ===================================================================== 21 | 22 | -module(runtest). 23 | 24 | -export([main/1]). 25 | 26 | -export([build_filters/2, apply_filters/2]). 27 | -export([dump_term/2]). 28 | 29 | -export([filter_module/1, filter_reasons/1, filter_nested/1, 30 | filter_args/1, filter_binaries/1, filter_pretty/1, 31 | filter_simplify_args/1]). 32 | 33 | -import(purity_utils, [str/2, internal_function/1]). 34 | 35 | 36 | -spec 37 | main([file:filename()]) -> no_return(). 38 | main([File1, File2]) -> 39 | main([File1, File2, "."]); 40 | main([File1, File2, DumpDir]) -> 41 | {Opts, Exp1} = parse_test_file(File2), 42 | {Topts, Popts} = parse_test_opts(Opts), 43 | Tab1 = run_analysis(File1, Popts, Topts), 44 | put(module, purity_utils:filename_to_module(File1)), 45 | Filters = build_filters(standard_filters(), Topts), 46 | Tab2 = apply_filters(dict:to_list(Tab1), Filters), 47 | Exp2 = apply_filters(Exp1, Filters), 48 | case Tab2 =:= Exp2 of 49 | true -> halt(0); 50 | false -> 51 | io:format("TEST FAILED: ~s ~s~n", [File1, File2]), 52 | F1 = outfile(DumpDir, File2, ".org"), 53 | F2 = outfile(DumpDir, File2, ".exp"), 54 | dump_term(F1, Tab2), 55 | dump_term(F2, Exp2), 56 | %io:format("Diff: ~p~n",[diff(Tab2,Exp2)]), 57 | io:format("vimdiff -R '~s' '~s'~n", [F1, F2]), 58 | halt(1) 59 | end. 60 | 61 | %diff(A, B) -> 62 | % S1 = lists:usort(A), S2 = lists:usort(B), 63 | % ordsets:subtract(ordsets:union(S1, S2), ordsets:intersection(S1, S2)). 64 | 65 | run_analysis(File, Popts, Topts) -> 66 | Tab = purity:files([File]), 67 | case option(traverse_only, Topts) of 68 | true -> Tab; 69 | false -> purity:propagate(Tab, Popts) end. 70 | 71 | parse_test_file(Filename) -> 72 | {Opts, Vals} = read_term(Filename), 73 | {Opts, Vals}. 74 | 75 | %% @doc Separate test-related options from purity-related ones. 76 | parse_test_opts(Opts) -> 77 | {T, P} = lists:partition(fun is_test_option/1, Opts), 78 | {[element(2,O)||O <- T], P}. 79 | 80 | 81 | is_test_option({test,{_,_}}) -> true; 82 | is_test_option({test,A}) when is_atom(A) -> true; 83 | is_test_option(_) -> false. 84 | 85 | outfile(Dir, File, Ext) -> 86 | filename:absname_join( 87 | filename:absname(Dir), 88 | filename:basename(File) ++ Ext). 89 | 90 | 91 | %%% Filters %%% 92 | 93 | standard_filters() -> 94 | [{unless, everything, filter_module} 95 | ,{unless, with_nested, filter_nested} 96 | ,{unless, with_reasons, filter_reasons} 97 | ,{unless, with_args, filter_args} 98 | ,{unless, with_arg_tuples, filter_simplify_args} 99 | ,filter_binaries 100 | ]. 101 | 102 | build_filters([{unless,Opt,F}|Fs], Opts) -> 103 | case option(Opt, Opts) of 104 | true -> build_filters(Fs, Opts); 105 | false -> [make_filter(F)|build_filters(Fs, Opts)] end; 106 | build_filters([F|Fs], Opts) when is_atom(F) -> 107 | [make_filter(F)|build_filters(Fs, Opts)]; 108 | build_filters([], _) -> []. 109 | 110 | make_filter(F) -> erlang:make_fun(?MODULE, F, 1). 111 | 112 | apply_filters(Tab, Filters) -> 113 | lists:foldl(fun(F, T) -> F(T) end, lists:sort(Tab), Filters). 114 | 115 | 116 | -type 117 | tab() :: [{any(),any()}]. 118 | 119 | -spec 120 | filter_module(tab()) -> tab(). 121 | filter_module(Tab) -> 122 | Mod = get(module), 123 | true = Mod =/= undefined, 124 | [Val || {K,_}=Val <- Tab, in_module(Mod, K), not internal_function(K)]. 125 | 126 | in_module(M, {M,_,_}) -> true; 127 | in_module(_, _) -> false. 128 | 129 | -spec 130 | filter_args(tab()) -> tab(). 131 | filter_args(Tab) -> 132 | [{K, filter_args1(V)} || {K, V} <- Tab]. 133 | 134 | filter_args1(C) when is_list(C) -> [filter_args2(D) || D <- C]; 135 | filter_args1({P, C}) when P =/= false, is_list(C) -> {P, [filter_args2(D) || D <- C]}; 136 | filter_args1(Val) -> Val. 137 | 138 | filter_args2({Type,Fun,Args}) when is_list(Args) -> 139 | {Type,Fun,[A || A <- Args, not unwanted_arg(A)]}; 140 | filter_args2(Arg) -> Arg. 141 | 142 | unwanted_arg({arg,{_,_}}) -> true; 143 | unwanted_arg({sub,_}) -> true; 144 | unwanted_arg(_) -> false. 145 | 146 | -spec 147 | filter_nested(tab()) -> tab(). 148 | filter_nested(Tab) -> 149 | %% This can only be approximate and rough. 150 | {ok, Pat} = re:compile("_[0-9]-[0-9]+$"), 151 | [Val || {K, _}=Val <- Tab, not nested(K, Pat)]. 152 | 153 | nested({_,F,_}, Pat) when is_atom(F) -> 154 | nomatch =/= re:run(atom_to_list(F), Pat); 155 | nested(_, _) -> false. 156 | 157 | %% Convert binaries to lists to make sure the table comparison works. 158 | -spec 159 | filter_binaries(tab()) -> tab(). 160 | filter_binaries(Tab) -> 161 | [{K, b2l(V)} || {K, V} <- Tab]. 162 | 163 | b2l({false, R}) when is_binary(R) -> 164 | {false, binary_to_list(R)}; 165 | b2l(V) -> V. 166 | 167 | -spec 168 | filter_reasons(tab()) -> tab(). 169 | filter_reasons(Tab) -> 170 | [{K, strip_reason(V)} || {K, V} <- Tab]. 171 | 172 | strip_reason({false,_}) -> false; 173 | strip_reason(V) -> V. 174 | 175 | -spec 176 | filter_pretty(tab()) -> string(). 177 | filter_pretty(Tab) -> string:join([format(I) || I <- Tab], "\n"). 178 | 179 | format({K, V}) -> str("~s ~s", [format_key(K), format_val(V)]). 180 | 181 | format_key({M,F,A}) when is_integer(A) -> str("~s:~s/~b", [M,F,A]); 182 | format_key({P,A}) when is_atom(P), is_integer(A) -> str("~s/~b", [P,A]); 183 | format_key(K) -> str("~p",[K]). 184 | 185 | format_val(true) -> "pure"; 186 | format_val(undefined) -> "undefined"; 187 | format_val(false) -> "impure"; 188 | format_val({false,Rsn}) -> str("impure(~s)",[Rsn]); 189 | format_val(C) when is_list(C) -> str("~w",[C]); 190 | format_val(V) -> str("~p",[V]). 191 | 192 | 193 | -spec 194 | filter_simplify_args(tab()) -> tab(). 195 | filter_simplify_args(Tab) -> 196 | % Convert {arg,N} tuples to N for proper comparison with test results. 197 | [{K, simplify_args(V)} || {K, V} <- Tab]. 198 | 199 | simplify_args({P, Ds}) when P =/= false -> 200 | {P, [simplify_arg(D) || D <- Ds]}; 201 | simplify_args(V) -> 202 | V. % Old style results 203 | 204 | simplify_arg({arg,N}) -> 205 | N; 206 | simplify_arg(D) -> 207 | D. 208 | 209 | 210 | %%% Other Helpers %%% 211 | 212 | %% @doc Read an Erlang term from a file. 213 | read_term(Filename) -> 214 | {ok, Fd} = file:open(Filename, [read]), 215 | {ok, Term} = io:read(Fd, ''), 216 | ok = file:close(Fd), 217 | Term. 218 | 219 | dump_term(Filename, Term) -> 220 | case filelib:is_file(Filename) of 221 | true -> throw({file_exists,Filename}); 222 | false -> 223 | {ok, Fd} = file:open(Filename, [write]), 224 | ok = io:format(Fd, "~s~n", [filter_pretty(Term)]), 225 | ok = file:close(Fd) end. 226 | 227 | option(Key, Val) -> 228 | proplists:get_value(Key, Val, false). 229 | 230 | -------------------------------------------------------------------------------- /test/args.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(args). 3 | -compile(export_all). 4 | 5 | %< f1/1 e [1] 6 | f1(Arg) -> 7 | case Arg of 8 | [] -> 9 | Arg; 10 | N when is_integer(N) -> 11 | N; 12 | F when is_function(F) -> 13 | F(0) 14 | end. 15 | 16 | % This is depends instead of pure, since we can't resolve the 17 | % first two calls to f1, because they don't have a callable argument. 18 | %% f2/0 [{local,{args,f1,1},[]}] 19 | %< f2/0 >= e 20 | f2() -> 21 | f1([]), 22 | f1(2), 23 | f1(fun abs/1). 24 | 25 | -------------------------------------------------------------------------------- /test/caseargs.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(caseargs). 3 | 4 | -compile(export_all). 5 | 6 | %< f1/2 e 7 | f1(X, Y) -> 8 | case {X,Y} of 9 | {1,2} -> ok; 10 | {1,3} -> not_ok; 11 | {2,4} -> weird 12 | end. 13 | -------------------------------------------------------------------------------- /test/combined_analysis: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %% vim: set ft=erlang: 3 | 4 | %% Test whether running propagate_both has the same effect as running 5 | %% both analyses separately and combining the results. 6 | 7 | main(Files) -> 8 | Tab = purity:modules(Files, [], dict:new()), 9 | lists:foreach( 10 | fun(L) -> 11 | T1 = purity:propagate_both(Tab, [{purelevel,L}]), 12 | T2 = propagate_both(Tab, [{purelevel,L}]), 13 | compare(L, T1, T2) end, 14 | [1,2,3]), 15 | halt(0). 16 | 17 | propagate_both(Tab, Opts) -> 18 | dict:merge( 19 | fun(_, V, V) -> V; (_, _, _) -> false end, 20 | purity:propagate_purity(Tab, Opts), 21 | purity:propagate_termination(Tab, Opts)). 22 | 23 | compare(L, T1, T2) -> 24 | Fs = runtest:build_filters([filter_reasons, filter_binaries], []), 25 | T11 = runtest:apply_filters(dict:to_list(T1), Fs), 26 | T22 = runtest:apply_filters(dict:to_list(T2), Fs), 27 | case T11 =:= T22 of 28 | true -> ok; 29 | false -> 30 | io:format("TEST FAILED for purelevel ~p~n", [L]), 31 | F1 = purity_utils:str("_f1-~b", [L]), 32 | F2 = purity_utils:str("_f2-~b", [L]), 33 | runtest:dump_term(F1, T11), 34 | runtest:dump_term(F2, T22), 35 | io:format("vimdiff -R ~s ~s~n", [F1, F2]) 36 | end. 37 | 38 | -------------------------------------------------------------------------------- /test/d1/a.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(a). 3 | -compile(export_all). 4 | 5 | f() -> 6 | ok. 7 | 8 | g(N) -> 9 | {ok, N}. 10 | -------------------------------------------------------------------------------- /test/d2/a.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(a). 3 | -compile(export_all). 4 | 5 | f() -> 6 | put(ok, computer). 7 | -------------------------------------------------------------------------------- /test/dest.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(dest). 3 | 4 | -compile([export_all]). 5 | 6 | %% Termination analysis of functions which consume an argument. 7 | %< global [termination,{test,{filter,reasons}}] 8 | 9 | %% Traverse a list. 10 | %< a/1 p 11 | a([]) -> []; 12 | a([H|T]) -> [H|a(T)]. 13 | 14 | %% A bit more useful, apply a function to each element of the list. 15 | %< b/2 p [1] 16 | b(F, []) when is_function(F,1) -> []; 17 | b(F, [H|T]) -> [F(H)|b(F, T)]. 18 | 19 | %% Variation of the above with explicit case. 20 | %< b1/2 p [1] 21 | b1(F, L) -> 22 | case L of 23 | [H|T] = L -> [F(H)|b1(F, T)]; 24 | [] -> [] end. 25 | 26 | %% Make sure variables with the same name are correctly detected. 27 | %< c/2 s 28 | c([a|T], C) -> [a|c(T, C)]; 29 | c([H|C], T) -> [H|c(T, C)]. 30 | 31 | %% Don't really care that another argument gets augmentend, 32 | %% or that we lack a base case. 33 | %< d/3 p 34 | d([_,H2|T], B, C) -> d(T, H2, [H2,B|C]); 35 | d([H|T], B, C) -> d(T, B, [H|C]). 36 | 37 | %% Not all cases reduce. 38 | %< e/3 s 39 | e([_|T], B, C) -> e(T, B, C); 40 | e([], B, C) -> e(B, [], C). 41 | 42 | %< e1/2 s 43 | e1([H|T], B) -> e1([B|T], H). 44 | 45 | %< e2/2 s 46 | e2([_|T], B) -> e2(T, B); 47 | e2([], B) -> e2([], B). 48 | 49 | %< do_flatten/2 p 50 | do_flatten([H|T], Tail) when is_list(H) -> 51 | do_flatten(H, do_flatten(T, Tail)); 52 | do_flatten([H|T], Tail) -> 53 | [H|do_flatten(T, Tail)]; 54 | do_flatten([], Tail) -> 55 | Tail. 56 | 57 | %% Binaries work in a similar fashion. 58 | %< b2l/1 p 59 | b2l(<>) -> [H|b2l(T)]; 60 | b2l(<<>>) -> []. 61 | 62 | %< l2b/1 p 63 | l2b([H|T]) -> Tl = l2b(T), <>; 64 | l2b([]) -> <<>>. 65 | 66 | %< f/1 s 67 | f(<>=_T) -> L = 2 * H, f(<>). 68 | 69 | %% FIXME: Detect aliases. 70 | %< g/1 s 71 | g(<>) -> 72 | case H of 73 | a -> ok; 74 | D -> g(D) 75 | end. 76 | 77 | -------------------------------------------------------------------------------- /test/duplicates: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %% vim: set ft=erlang: 3 | 4 | %% Test whether running the analysis in parallel has the same results 5 | %% as running it sequentially. 6 | 7 | -mode(compile). 8 | 9 | main(Files) -> 10 | T1 = purity:files(Files), 11 | T2 = purity:pfiles(Files), 12 | lists:foreach( 13 | fun(Opts) -> 14 | P1 = purity:propagate(T1, Opts), 15 | P2 = purity:propagate(T2, Opts), 16 | compare(Opts, P1, P2) end, 17 | [[],[termination],[both]]), 18 | halt(0). 19 | 20 | compare(L, T1, T2) -> 21 | T11 = dict:to_list(T1), 22 | T22 = dict:to_list(T2), 23 | case T11 =:= T22 of 24 | true -> ok; 25 | false -> 26 | io:format("TEST FAILED for options ~p~n", [L]), 27 | F1 = purity_utils:str("_d1-~p", [L]), 28 | F2 = purity_utils:str("_d2-~p", [L]), 29 | runtest:dump_term(F1, T11), 30 | runtest:dump_term(F2, T22), 31 | io:format("vimdiff -R '~s' '~s'~n", [F1, F2]) 32 | end. 33 | 34 | -------------------------------------------------------------------------------- /test/exceptions.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(exceptions). 3 | -compile(export_all). 4 | 5 | %< global [{test,{filter,nested}},with_reasons] 6 | 7 | %< genex/1 e 8 | genex(1) -> a; 9 | genex(2) -> throw(a); 10 | genex(3) -> exit(a); 11 | genex(4) -> {'EXIT', a}; 12 | genex(5) -> erlang:error(a). 13 | 14 | %< catcher/1 e 15 | catcher(N) -> 16 | try genex(N) of 17 | {ok, _Val} -> 3; 18 | Val -> {N, normal, Val} 19 | catch 20 | throw:X -> {N, caught, thrown, X}; 21 | exit:X -> {N, caught, exited, X}; 22 | error:X -> {N, caught, error, X} 23 | end. 24 | 25 | %< demo1/0 e 26 | demo1() -> 27 | [catcher(I) || I <- [1,2,3,4,5]]. 28 | 29 | %% `catch' is not referentially transparent! 30 | %< demo2/0 d 31 | demo2() -> 32 | [{I, (catch genex(I))} || I <- [1,2,3,4,5]]. 33 | 34 | %< nogenex/1 p 35 | nogenex(N) -> 36 | N. 37 | 38 | %% `catch' is not referentially transparent! 39 | %< demo3/0 d 40 | demo3() -> 41 | [{I, (catch nogenex(I))} || I <- [1,2,3,4,5]]. 42 | 43 | %< demo4/0 e 44 | demo4() -> 45 | [catcher2(I) || I <- [1,2,3,4,5]]. 46 | 47 | %< catcher2/1 e 48 | catcher2(N) -> 49 | try nogenex(N) of 50 | {ok, _Val} -> 3; 51 | Val -> {N, normal, Val} 52 | catch 53 | throw:X -> {N, caught, thrown, X}; 54 | exit:X -> {N, caught, exited, X}; 55 | error:X -> {N, caught, error, X} 56 | end. 57 | 58 | %% Older versions of the code did not traverse the body of 59 | %% the exception handler (the 'catch' part): 60 | %< coverage/1 s 61 | coverage(N) -> 62 | try N + N of 63 | Sum -> 64 | Sum 65 | catch 66 | Cls:Err -> 67 | put(Cls, Err) 68 | end. 69 | 70 | -------------------------------------------------------------------------------- /test/expr.erl: -------------------------------------------------------------------------------- 1 | -module(expr). 2 | -compile(export_all). 3 | 4 | %< global [{test,with_reasons},with_reasons] 5 | 6 | %< foo/0 s 7 | %< [termination] foo/0 s 8 | foo() -> 9 | receive 10 | Msg -> 11 | {ok, Msg} 12 | end. 13 | 14 | %< bar/0 d 15 | %< [termination] bar/0 p 16 | bar() -> 17 | catch (baz()). 18 | 19 | %< baz/0 p 20 | baz() -> 21 | 42. 22 | 23 | 24 | %% Older versions of the code did not traverse after expressions. 25 | %% This was masked by the impure dependency on receive anyway. 26 | %< coverage/0 s 27 | %< [termination] coverage/0 s 28 | coverage() -> 29 | receive 30 | Msg -> 31 | {ok, Msg} 32 | after erase(timer) -> 33 | put(timer, 42) 34 | end. 35 | 36 | -------------------------------------------------------------------------------- /test/higher.erl: -------------------------------------------------------------------------------- 1 | -module(higher). 2 | -compile(export_all). 3 | 4 | %%% Test various aspects of higher order functions. %%% 5 | 6 | %< global [{test,with_reasons},with_reasons] 7 | 8 | %% Some simple preliminary cases, which should be easily resolvable 9 | %% with call site analysis. The b/c functions should be equivalent. 10 | 11 | %< a/3 p [1] 12 | a(F, A1, A2) -> 13 | F(A1, A2). 14 | 15 | %< b/0 e 16 | %< [termination] b/0 p 17 | b() -> 18 | a(fun erlang:'+'/2, 40, 2). 19 | 20 | %< c/0 e 21 | %< [termination] c/0 p 22 | c() -> 23 | apply(fun erlang:'+'/2, [40, 2]). 24 | 25 | 26 | %% Try a user defined function instead of a built-in. 27 | %< d/2 e 28 | %< [termination] d/2 p 29 | d(X, Y) -> 30 | X + Y. 31 | 32 | %< e/0 e 33 | %< [termination] e/0 p 34 | e() -> 35 | a(fun d/2, 40, 2). 36 | 37 | 38 | %% Some edge cases of call site analysis: 39 | %% Higher order recursive functions may potentially call themselves with 40 | %% concrete arguments at some point. This creates two distinct problems: 41 | %% Pure calls should be correctly detected and removed (requires extra 42 | %% checks at call site), while impure ones should be propagated as usual. 43 | %% Either way, this signifies the importance of tracking *recursive* calls, 44 | %% since we could miss out on these impurities and incorrectly mark 45 | %% certain functions as pure. 46 | 47 | %% This is somewhat contrived, but for a real life example look at 48 | %% `dets_utils:leafs_to_nodes/4'. 49 | %< f/2 e [1] 50 | %< [termination] f/2 s 51 | f(_F, none) -> 52 | f(fun erlang:abs/1, 21); 53 | f(F, N) when is_integer(N) -> 54 | F(N) * 2. 55 | 56 | %< g/2 s 57 | %< [termination] g/2 s 58 | g(_F, none) -> 59 | g(fun erlang:put/2, 21); 60 | g(F, Val) -> 61 | F(key, 2 * Val). 62 | 63 | %< h/0 e 64 | %< [termination] h/0 s 65 | h() -> 66 | f(fun erlang:abs/1, 21). 67 | 68 | %< i/0 s 69 | i() -> 70 | g(fun d/2, 42). 71 | 72 | %% Recursive HOFs present another challenge as it is possible that 73 | %% the recursive call contains some unknown function. Usually however 74 | %% this unknown function is the same one which characterised the function 75 | %% as higher order (e.g. one of its arguments). We try to detect some 76 | %% of these cases. 77 | %< j/2 e [1] 78 | %< [termination] j/2 p [1] 79 | j(F, [H|T]) -> 80 | [F(H)|j(F, T)]; 81 | j(_, []) -> 82 | []. 83 | 84 | %< k/3 e [1,2] 85 | %< [termination] k/3 p [1,2] 86 | k(F, G, [H|T]) -> 87 | [G(F(H))|k(F, G, T)]; 88 | k(_, _, []) -> 89 | []. 90 | 91 | %% Variation of the previous example, with the higher order arguments 92 | %% being transposed. 93 | %< l/3 e [1,2] 94 | %< [termination] l/3 p [1,2] 95 | l(F, G, [H|T]) -> 96 | [G(F(H))|l(G, F, T)]; 97 | l(_, _, []) -> 98 | []. 99 | 100 | %% Example of an unresolvable unknown function (an element of the list). 101 | %< m/2 >= e [1] 102 | %< [termination] m/2 >= p [1] 103 | m(F, [G,E|T]) -> 104 | [F(E)|m(G, T)]; 105 | m(_, []) -> 106 | []. 107 | 108 | -------------------------------------------------------------------------------- /test/indirect.erl: -------------------------------------------------------------------------------- 1 | -module(indirect). 2 | -compile(export_all). 3 | 4 | %< global [{test,with_reasons},with_reasons] 5 | 6 | %%% Test indirect dependencies to higher order functions. 7 | %%% These should work for any level of indirection, but are 8 | %%% limited to functions with a single higher order dependency, 9 | %%% both in the base case and in any indirect level. 10 | 11 | %% This is the basic higher order function, easy to resolve. 12 | %< fold/3 e [1] 13 | fold(_Fun, Acc, []) -> 14 | Acc; 15 | fold(Fun, Acc, [H|T]) -> 16 | fold(Fun, Fun(H, Acc), T). 17 | 18 | %% Its fairly simple to determine that the call-site purity of 19 | %% fold/3 in this case is pure. 20 | %< f11/0 e 21 | f11() -> 22 | fold(fun erlang:'*'/2, 0, [2, 3, 7]). 23 | 24 | %< f12/0 s 25 | f12() -> 26 | fold(fun erlang:put/2, computer, [ok, error]). 27 | 28 | %% One level of indirection. 29 | %< fold_1/3 e [1] 30 | fold_1(Fun, Acc, Lst) -> 31 | fold(Fun, Acc, Lst). 32 | 33 | %< f21/0 e 34 | f21() -> 35 | fold_1(fun erlang:'*'/2, 0, [2, 3, 7]). 36 | 37 | %< f22/0 s 38 | f22() -> 39 | fold_1(fun erlang:put/2, computer, [ok, error]). 40 | 41 | %% Two levels of indirection, plus change in the place of the 42 | %% function argument. 43 | %< fold_2/3 e [3] 44 | fold_2(Lst, Acc, Fun) -> 45 | fold_1(Fun, Acc, Lst). 46 | 47 | %< f31/0 e 48 | f31() -> 49 | fold_2([2, 3, 7], 1, fun erlang:'*'/2). 50 | 51 | %< f32/0 s 52 | f32() -> 53 | fold_2([ok, error], computer, fun erlang:put/2). 54 | 55 | %< fold_3/1 e [1] 56 | fold_3(Fun) -> 57 | fold_2([2, 3, 7], 1, Fun). 58 | 59 | %< f41/0 e 60 | f41() -> 61 | fold_3(fun erlang:'*'/2). 62 | 63 | %< f42/0 s 64 | f42() -> 65 | fold_3(fun erlang:put/2). 66 | 67 | %% Indirect HOFs now work for functions with multiple higher order dependencies. 68 | %< fold_3/2 e [2] 69 | fold_3(Lst, Fun) -> 70 | fold_2(fold_1(Fun, 1, Lst), 1, Fun). 71 | 72 | %< f51/0 e 73 | f51() -> 74 | fold_3([2, 3, 7], fun erlang:'*'/2). 75 | 76 | %< f52/0 s 77 | f52() -> 78 | fold_3([ok, error], fun erlang:put/2). 79 | 80 | -------------------------------------------------------------------------------- /test/letrec.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(letrec). 3 | 4 | -compile(export_all). 5 | 6 | %< f1/2 e 7 | f1(A1, A2) -> 8 | [f2(A) || A <- A1 ++ A2]. 9 | 10 | %< f2/1 e 11 | f2(E) -> 12 | [f1(A,B) || {A,B} <- E]. 13 | 14 | % Nested letrec expressions. 15 | %< f3/2 e 16 | f3(X,Y) -> 17 | L1 = [{A,B} || A <- X, B <- Y], 18 | [A || A <- L1]. 19 | 20 | %% While this is a total function, it is still marked `e' because both 21 | %% length/1 and the generated letrec function may raise match_fail. 22 | %< f4/1 e 23 | f4(L) when length(L) >= 0 -> 24 | [E || E <- L]; 25 | f4(_) -> error. 26 | 27 | %% Function nested in letrec. 28 | %f5(L) -> 29 | % [fun() -> [X || X <- E] end || E <- L]. 30 | -------------------------------------------------------------------------------- /test/mutual.erl: -------------------------------------------------------------------------------- 1 | -module(mutual). 2 | -compile(export_all). 3 | 4 | %< global [{test,with_reasons},with_reasons] 5 | 6 | %%% Provide mutually recursive functions. 7 | 8 | %< d0/0 p 9 | d0() -> 0. 10 | 11 | %< d1/0 e 12 | d1() -> 1 + d2() + d0() + d3(). 13 | 14 | %< d2/0 e 15 | d2() -> 1 + d1() + d0(). 16 | 17 | %< d3/0 e 18 | d3() -> 1 + d2(). 19 | 20 | %< m1/1 s 21 | %< m2/1 s 22 | m1(Pid) -> m2(Pid). 23 | m2(Pid) -> m1(Pid), Pid ! 0. 24 | 25 | %< m3/1 e 26 | %< m4/1 e 27 | m3(N) -> abs(N) + m4(N). 28 | m4(N) -> m3(N). 29 | 30 | %% This is an example of mutually recursive functions which cannot be 31 | %% resolved, showcasing why it is not enough to consider functions pure 32 | %% if all of their dependencies are in the same call graph cycle. 33 | %% While the first one is picked as a mutual candidate, it does not 34 | %% make it through the reduction step, since f2/0 has other unresolved 35 | %% dependencies too. 36 | 37 | %% This example also showcases a modest limitation of the new algorithm, 38 | %% the purity of f2 is not propagated to f1. This is not an actual issue, 39 | %% just a limitation on result precision, which can be mitigated by a 40 | %% post-processing step I suppose. 41 | 42 | %< f1/0 p [{local,{mutual,f2,0},[]}] 43 | f1() -> 44 | f2(). 45 | 46 | %< f2/0 e [{local,{mutual,f1,0},[]},{remote,{unknown,function,0},[]}] 47 | f2() -> 48 | f1() + unknown:function(). 49 | 50 | -------------------------------------------------------------------------------- /test/names.erl: -------------------------------------------------------------------------------- 1 | -module(names). 2 | -compile(export_all). 3 | 4 | %< global [{test,with_nested}] 5 | 6 | %%% Verify that the naming mechanism for nested functions works 7 | %%% correctly. The actual pureness results are not important. 8 | 9 | %% Verify that nested functions are named correctly without clashes 10 | %% to the environment or previously named functions. 11 | %% This should produce a_1-1/1 and a_2-1/1. 12 | %< a/1 d 13 | %< 'a_1-1'/1 d 14 | a(L) -> 15 | [get(E) || E <- L]. 16 | 17 | %< a/2 d 18 | %< 'a_2-1'/1 d 19 | a(L, T) -> 20 | [get({E, T}) || E <- L]. 21 | 22 | %% This one would normally generate b_1-1/1 but since this function 23 | %% is already defined, it will now create b_1-2/1. 24 | %< b/1 p 25 | %< 'b_1-2'/1 p 26 | b(L) -> 27 | fun(E) -> [E|L] end. 28 | 29 | %< 'b_1-1'/1 s 30 | 'b_1-1'(L) -> 31 | put(L,42). 32 | 33 | -------------------------------------------------------------------------------- /test/nested.erl: -------------------------------------------------------------------------------- 1 | -module(nested). 2 | -compile(export_all). 3 | 4 | %% global [{test,{filter,reasons}},{test,{filter,nested}}] 5 | %< global [{test,{filter,nested}},{test,{filter,args}}] 6 | 7 | %% Common pattern of nested functions: The list comprehension creates 8 | %% a nested letrec expression, which will depend on itself and the free 9 | %% variable Pred. The outer function however knows that Pred is its 10 | %% argument, so we should be able to figure out it is a HOF. 11 | %< a/2 e [1] 12 | a(Pred, List) when is_function(Pred, 1), is_list(List) -> 13 | [Elem || Elem <- List, Pred(Elem)]. 14 | 15 | %% A variation of the above with an explicitly nested function. 16 | %< b/2 p [1] 17 | b(F, A) -> 18 | fun(E) -> F(E) end( A ). 19 | 20 | %% Multiple levels of nesting 21 | %< aaa/3 e [1,2] 22 | aaa(P1, P2, L) -> 23 | [[[E || E <- N, P2(E)] || N <- M, P1(N)] || M <- L]. 24 | 25 | %% While fairly uncommon, HOFs with nested functions that map to 26 | %% recursive calls can be handled to some extent. In this case, the 27 | %% call to `c' in the `letrec' expression is mapped to a recursive 28 | %% call in `c', while the free variable `F' passed as argument to the 29 | %% call is successfully matched with the first argument of `c', making 30 | %% it possible to ignore the recursive call altogether. Look at the 31 | %% tests in `higher' for more on that. 32 | %< c/2 e [1] 33 | c(_, []) -> 34 | []; 35 | c(F, [H|T]) when is_list(H) -> 36 | [c(F, E) || E <- H] ++ c(F, T); 37 | c(F, E) -> 38 | F(E). 39 | 40 | %% Same as before, but with a more complex case, where the two higher 41 | %% order arguments are transposed. Again see `higher'. 42 | %< d/3 e [1,2] 43 | d(_, _, []) -> 44 | []; 45 | d(F, G, [H|T]) when is_list(H) -> 46 | [d(G, F, E) || E <- H] ++ d(F, G, T); 47 | d(F, G, E) -> 48 | F(G(E)). 49 | 50 | %% In this case there is no explicit dependency on the second 51 | %% argument and we previously could not safely remove the recursive 52 | %% call. This is now possible with indirect HOF analysis, by marking 53 | %% the e/3 functions as indirectly dependent on 2. See more elaborate 54 | %% l/m examples later on. 55 | %< e/3 e [1,2] 56 | e(_, _, []) -> 57 | []; 58 | e(F, G, [H|T]) when is_list(H) -> 59 | [e(G, F, E) || E <- H] ++ e(F, G, T); 60 | e(F, _, E) -> 61 | F(E). 62 | 63 | %< e1/0 e 64 | e1() -> 65 | e(fun abs/1, fun abs/1, [[1,2]]). 66 | 67 | %< e2/0 s 68 | e2() -> 69 | e(fun abs/1, fun put/2, []). 70 | 71 | 72 | %% In this example the free variable passed as argument cannot be 73 | %% resolved to anything meaningful in the parent, so the nested 74 | %% dependency is left as is. 75 | %% f/3 [{arg,1},{local,{nested,'f_3-1',1},[]}] 76 | %< f/3 >= e [1] 77 | f(_, _, []) -> 78 | []; 79 | f(F, G, [H|T]) when is_list(H) -> 80 | D = hd(H), 81 | [f(D, F, E) || E <- H] ++ f(F, G, T); 82 | f(F, _, E) -> 83 | F(E). 84 | 85 | %% Combination of nested function and indirect HOF: 86 | %% g/2 is recognised as passing its first argument to the nested HOF, 87 | %% and thus becomes an indirect HOF. 88 | %% Improved g/2 [{local,{nested,'g_2-1',1},[]}] 89 | %< g/2 p [1] 90 | g(F, L) -> 91 | G = fun(H) -> H(L) end, 92 | G(F, L). 93 | 94 | %< g1/0 e 95 | g1() -> 96 | g(fun abs/1, -3). 97 | 98 | 99 | %% This is an example of blocking the promotion of a dependency to 100 | %% the parent function, by way of the presense of {arg,{_,_}} in the 101 | %% dependency. Notice how {func,whatever,1} would be in the dep list if 102 | %% it was promoted instead 'k_2-1' (i.e. G). 103 | %< k/2 p [{local,{nested,'k_2-1',1},[]}] 104 | k(A, B) -> 105 | G = fun(C) -> k(C, func:whatever(B)) end, 106 | G(A). 107 | 108 | 109 | %% A few (contrived) examples which showcase the combination of nested 110 | %% promotion with indirect analysis. 111 | 112 | %% Make sure the analysis works for more than 1 indirect argument, where 113 | %% each indirect argument is only discovered after the previous one has. 114 | 115 | %% Note how not removing self-recs prior to indirect analysis is crucial 116 | %% in this example, since otherwise the second call which retains F as its 117 | %% first argument would have been removed, making the analysis impossible. 118 | %< l/4 e [1,2,3] 119 | l(F, G, X, [H|T]) when is_list(H) -> 120 | [{l(G, F, X, E), l(F, X, G, E)} || E <- H] ++ l(F, G, X, T); 121 | l(F, _, _, E) -> 122 | F(E). 123 | 124 | %< m/5 e [1,2,3,4] 125 | m(F, G, X, Y, [H|T]) when is_list(H) -> 126 | [{m(G,F,X,Y,E), m(X,G,F,Y,E), m(Y,F,G,X,E)} || E <- H] ++ m(F, G, X, Y, T); 127 | m(F, _, _, _, E) -> 128 | F(E). 129 | 130 | %% (HOF recursion can be handled the same way as indirect functions). 131 | %% For a real life example look at dets_utils:leafs_to_nodes/4. 132 | %< n/2 e [1] 133 | n(H, [V|_]) -> 134 | n(H, V); 135 | n(H, V) -> 136 | n(fun abs/1, V), 137 | H(V). 138 | 139 | %% Passing another HOF as a concrete argument to a HOF. 140 | %% In general cases like this are marked as unknown, with one exception: 141 | %% when the passed argument is the same as the HOF it is passed to, e.g. 142 | %% to implement recursion in anonymous higher order functions. 143 | %< o/2 >= e 144 | o(L, A) -> 145 | H = fun(F) -> F(A) end, 146 | omap(H, L). 147 | 148 | %< omap/2 e [1] 149 | omap(_, []) -> []; 150 | omap(F, [H|T]) -> [F(H)|omap(F, T)]. 151 | 152 | %% The exception: passing the same HOF. This is inspired from 153 | %% asn1ct_check:constraint_union_vr/2 (can't see why lists:usort/2 154 | %% was not used there instead though). 155 | %< p/1 e 156 | %< 'p_1-1'/2 e [2] 157 | p(L) -> 158 | RemDup = 159 | fun ([], _) -> []; 160 | ([H], _) -> [H]; 161 | ([H,H|T], F) -> F([H|T], F); 162 | ([H|T], F) -> [H|F(T, F)] end, 163 | RemDup(L, RemDup). 164 | 165 | -------------------------------------------------------------------------------- /test/plt: -------------------------------------------------------------------------------- 1 | #!/bin/zsh 2 | # Test certain aspects of the analysis in combination with PLT 3 | # creation and updates. 4 | # 5 | # In particular, these tests verify that incremental analysis with the 6 | # help of a PLT has the exact same results as running the analysis in 7 | # one step. 8 | # 9 | # Furthermore these tests assert that PLT creation, update and export are 10 | # at least crash free. 11 | # 12 | # WARNING: 13 | # Running these tests on a large collection of modules (e.g. OTP) is 14 | # bound to take a *lot* of time, since PLT update operations depend on 15 | # the size of the PLT. 16 | # 17 | # Another caveat one should be aware of is that incremental analysis 18 | # is not guaranteed to provide consistent results as the order in which 19 | # modules are analysed changes. This only affects analysis of different 20 | # modules with the same name however (since only the last one is kept). 21 | # TODO: Add test case showcasing this behaviour. 22 | 23 | #set -e 24 | 25 | export ERL_LIBS=$(pwd) 26 | 27 | root=$(mktemp --tmpdir --directory test_plt.XXXXXXXX) 28 | 29 | target=($@) 30 | 31 | run_purity() { 32 | echo "purity -q $@" >> "$root/test.log" 33 | purity -q $@ &>> "$root/test.log" 34 | } 35 | 36 | export_plt() { 37 | scripts/export_plt $1 ${1:r}.txt 38 | } 39 | 40 | compare() { 41 | plt1=${1:r}.txt 42 | plt2=${2:r}.txt 43 | if ! diff -q $plt1 $plt2; then 44 | echo "PLT TEST FAILED" 45 | echo "vimdiff -R '$plt1' '$plt2'" 46 | return 1 47 | fi 48 | return 0 49 | } 50 | 51 | all=$root/all.plt 52 | run_purity -b --output-plt $all $target 53 | export_plt $all 54 | 55 | failed=0 56 | 57 | ## Verify that re-analysing a single module at a time 58 | ## and updating the PLT yields the original result. 59 | test1() { 60 | for file in $target; do 61 | plt=$root/$(basename ${file:r}).plt 62 | run_purity -p $all --add-to-plt --output-plt $plt $file 63 | export_plt $plt 64 | compare $all $plt 65 | (( failed += $? )) 66 | done 67 | } 68 | 69 | ## Verify that analysing all the modules incrementally while updating 70 | ## the PLT yields the same result as analysing them at once. 71 | test2() { 72 | plt=$root/null.plt 73 | scripts/empty_plt $plt 74 | 75 | #scripts/test_plt $plt $target 76 | for file in $target; do 77 | run_purity -p $plt --add-to-plt $file 78 | done 79 | export_plt $plt 80 | compare $all $plt 81 | (( failed += $? )) 82 | } 83 | 84 | test1 85 | test2 86 | 87 | if [[ $failed -gt 0 ]]; then 88 | echo "$failed PLT TESTS FAILED" 89 | exit 1 90 | else 91 | echo "ALL PLT TESTS PASSED" 92 | rm -r $root 93 | fi 94 | 95 | -------------------------------------------------------------------------------- /test/selfrec.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(selfrec). 3 | -compile(export_all). 4 | 5 | %< fact/1 e 6 | %< [termination] {false,"recursion"} 7 | fact(0) -> 1; 8 | fact(N) -> N * fact(N-1). 9 | -------------------------------------------------------------------------------- /test/simple.erl: -------------------------------------------------------------------------------- 1 | -module(simple). 2 | -compile(export_all). 3 | 4 | %< d0/0 p 5 | d0() -> 0. 6 | 7 | %< d1/0 e 8 | d1() -> 1 + d0(). 9 | 10 | %< d2/0 e 11 | d2() -> 1 + d1() + d0(). 12 | 13 | %< dnone/1 p 14 | dnone(_) -> none. 15 | 16 | %< myfun/0 e 17 | myfun() -> 18 | {X, Y} = {3, 4}, 19 | X + Y. 20 | -------------------------------------------------------------------------------- /test/term.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(term). 3 | 4 | -compile(export_all). 5 | 6 | %% Collection of tests focused on the handling of BIFs by termination analysis. 7 | 8 | %< global [termination] 9 | 10 | %% Such a function cannot be resolved statically. 11 | %< a/3 >= p 12 | a(M, F, As) -> 13 | apply(M, F, As). 14 | 15 | %% Still not sure about the arity of the called function. 16 | %< b/1 >= p 17 | b(As) -> 18 | apply(erlang, abs, As). 19 | 20 | %% This call to apply is translated to a direct call by the compiler, 21 | %% hence the full resolution of the function. 22 | %< c/0 p 23 | c() -> 24 | apply(erlang, abs, [1]). 25 | 26 | -------------------------------------------------------------------------------- /test/values.erl: -------------------------------------------------------------------------------- 1 | 2 | -module(values). 3 | 4 | -compile(export_all). 5 | 6 | % This is actually false, since Y1 may be io:format, 7 | % but no analysis is performed so as to determine the 8 | % possible values of Y1 atm. 9 | %% X1,Y1 are makred unknown since no aliases are found. 10 | %% This is because they are bound by a let statement, while 11 | %% aliases are only found for case clauses: 12 | %% let X1, Y1 = case cor1, cor2 of ... end 13 | %< f/2 p [{local,'X1',[]},{local,'Y1',[]}] 14 | f(X, Y) -> 15 | {X1, Y1} = case {X, Y} of 16 | {1,1} -> 17 | {1, 1}; 18 | {2,2} -> 19 | {fun()->2 end, fun()->3 end}; 20 | {3,3} -> 21 | {fun erlang:abs/1, fun io:format/2}; 22 | _ -> 23 | {2, 2} 24 | end, 25 | X1(), Y1(), X1(). 26 | -------------------------------------------------------------------------------- /vsn.mk: -------------------------------------------------------------------------------- 1 | 2 | PURITY_VSN = 0.2 3 | 4 | --------------------------------------------------------------------------------