Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Initial import

  • Loading branch information...
commit 4cec1d607ff8477599b403c203273196a4d23797 0 parents
@yome yome authored
Showing with 4,054 additions and 0 deletions.
  1. +48 −0 termite/CHANGELOG
  2. +18 −0 termite/INSTALL
  3. +718 −0 termite/LICENSE
  4. +131 −0 termite/README
  5. +1 −0  termite/VERSION
  6. +5 −0 termite/benchmarks/README
  7. +6 −0 termite/benchmarks/bench.scm
  8. +2 −0  termite/benchmarks/config-dinos.scm
  9. +2 −0  termite/benchmarks/config-single-node.scm
  10. +2 −0  termite/benchmarks/config.scm
  11. +14 −0 termite/benchmarks/fib.erl
  12. +14 −0 termite/benchmarks/fib.scm
  13. +34 −0 termite/benchmarks/migrate.scm
  14. +27 −0 termite/benchmarks/nrev.erl
  15. +23 −0 termite/benchmarks/nrev.scm
  16. +43 −0 termite/benchmarks/pingpong.erl
  17. +51 −0 termite/benchmarks/pingpong.scm
  18. +16 −0 termite/benchmarks/pingpong2.scm
  19. +37 −0 termite/benchmarks/pingpong_gambit.scm
  20. +41 −0 termite/benchmarks/qsort.erl
  21. +49 −0 termite/benchmarks/qsort.scm
  22. +32 −0 termite/benchmarks/ring.erl
  23. +35 −0 termite/benchmarks/ring.scm
  24. +34 −0 termite/benchmarks/ring_gambit.scm
  25. +16 −0 termite/benchmarks/self.erl
  26. +19 −0 termite/benchmarks/self.scm
  27. +17 −0 termite/benchmarks/self_gambit.scm
  28. +162 −0 termite/benchmarks/smith.erl
  29. +103 −0 termite/benchmarks/smith.scm
  30. +17 −0 termite/benchmarks/spawn.erl
  31. +18 −0 termite/benchmarks/spawn.scm
  32. +16 −0 termite/benchmarks/spawn_gambit.scm
  33. +17 −0 termite/benchmarks/tak.erl
  34. +17 −0 termite/benchmarks/tak.scm
  35. +199 −0 termite/data.scm
  36. +93 −0 termite/deftype.scm
  37. +28 −0 termite/examples/cell.scm
  38. +6 −0 termite/examples/config.scm
  39. +56 −0 termite/examples/cons.scm
  40. +117 −0 termite/examples/supervisor.scm
  41. +415 −0 termite/match-support.scm
  42. +25 −0 termite/match.scm
  43. +106 −0 termite/otp/gen_event.scm
  44. +79 −0 termite/otp/gen_server.scm
  45. +57 −0 termite/recv.scm
  46. +87 −0 termite/termite#.scm
  47. +925 −0 termite/termite.scm
  48. +12 −0 termite/test/test_node1.scm
  49. +1 −0  termite/test/test_node2.scm
  50. +3 −0  termite/tsi
  51. +60 −0 termite/uuid.scm
48 termite/CHANGELOG
@@ -0,0 +1,48 @@
+========================================================================
+Mon Jun 16 00:22:38 2008
+
+- Clean up code, remove experimental nameserver stuff as it is not
+ really needed
+
+========================================================================
+Thu Mar 13 00:39:57 2008
+
+- Cleaned up initialization, so that no set! would be used
+- A node will now properly report an error in the primordial thread
+ if the tcp port is already used
+
+
+========================================================================
+Tue Mar 11 01:01:29 2008
+
+- Fixed a problem with MATCH macro
+- TAGS are now unique objects and only get an UUID assigned if
+ "exported" (ie sent to another node) to avoid the creation of symbols
+ that will not be garbage collected (bug reported by Nicholas Walton)
+
+
+========================================================================
+Wed Feb 13 22:21:59 2008
+
+- Removed useless code from match.scm that was impeding compilation
+ (reported by Guillaume Cartier)
+- Termite is now licensed under the same term as Gambit is, as it will
+ simplify inter-operation with Gambit's code
+
+========================================================================
+
+Wed Feb 6 19:45:59 2008
+Version 0.11
+
+- Updated export list
+- Minor code cleanup
+
+========================================================================
+
+Thu Nov 15 01:02:19 2007
+Version 0.10
+
+- Changed the format of Termite from an "included in Gambit" format to
+ a Gambit library format
+
+========================================================================
18 termite/INSTALL
@@ -0,0 +1,18 @@
+# These are the installation instructions for Termite
+
+#1 Install the latest Gambit-C
+
+#2 Get Termite and untar it in Gambit's lib/ directory
+
+cd /usr/lobal/Gambit-C/current/lib
+
+wget http://toute.ca/termite.tar.gz
+tar -xzvf termite.tar.gz
+
+# Optional:
+# Manually copy the "tsi" file from Termite's directory to
+# Gambit's "bin" directory
+# That's for convenience so you can start a console that acts
+# like gsi but has Termite already loaded
+
+# All done!
718 termite/LICENSE
@@ -0,0 +1,718 @@
+Copyright (c) 2005-2008, Guillaume Germain
+
+Termite is licensed under the same terms as Gambit-C (LGPL and Apache v.2)
+
+It comes with absolutely no warranty of any kind.
+
+See the text of the licenses below.
+
+===============================================================================
+
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+ 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL. It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+ This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it. You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations below.
+
+ When we speak of free software, we are referring to freedom of use,
+not price. Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+ To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights. These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+ For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you. You must make sure that they, too, receive or can get the source
+code. If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it. And you must show them these terms so they know their rights.
+
+ We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+ To protect each distributor, we want to make it very clear that
+there is no warranty for the free library. Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+
+ Finally, software patents pose a constant threat to the existence of
+any free program. We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder. Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+ Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License. This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License. We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+ When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library. The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom. The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+ We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License. It also provides other free software developers Less
+of an advantage over competing non-free programs. These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries. However, the Lesser license provides advantages in certain
+special circumstances.
+
+ For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it becomes
+a de-facto standard. To achieve this, non-free programs must be
+allowed to use the library. A more frequent case is that a free
+library does the same job as widely used non-free libraries. In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+ In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software. For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+ Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+ The precise terms and conditions for copying, distribution and
+modification follow. Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library". The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+
+ GNU LESSER GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+ A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+ The "Library", below, refers to any such software library or work
+which has been distributed under these terms. A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language. (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+ "Source code" for a work means the preferred form of the work for
+making modifications to it. For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+ Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it). Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+ 1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+ You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+ 2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) The modified work must itself be a software library.
+
+ b) You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ c) You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+
+ d) If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library. To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License. (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.) Do not make any other change in
+these notices.
+
+ Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+ This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+ 4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+ If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library". Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+ However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library". The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+ When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library. The
+threshold for this to be true is not precisely defined by law.
+
+ If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work. (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+ Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+ 6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+ You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License. You must supply a copy of this License. If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License. Also, you must do one
+of these things:
+
+ a) Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood
+ that the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+
+ b) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (1) uses at run time a
+ copy of the library already present on the user's computer system,
+ rather than copying library functions into the executable, and (2)
+ will operate properly with a modified version of the library, if
+ the user installs one, as long as the modified version is
+ interface-compatible with the version that the work was made with.
+
+ c) Accompany the work with a written offer, valid for at
+ least three years, to give the same user the materials
+ specified in Subsection 6a, above, for a charge no more
+ than the cost of performing this distribution.
+
+ d) If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+
+ e) Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+
+ For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it. However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+ It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system. Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+ 7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+ a) Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+
+ b) Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+
+ 8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License. Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License. However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+ 9. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Library or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+ 10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+
+ 11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all. For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded. In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+ 13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation. If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+ 14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission. For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this. Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+ NO WARRANTY
+
+ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Libraries
+
+ If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change. You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+ To apply these terms, attach the following notices to the library. It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the library's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the
+ library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+ <signature of Ty Coon>, 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
+
+
+===============================================================================
+
+
+ Apache License
+ Version 2.0, January 2004
+ http://www.apache.org/licenses/
+
+ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+ 1. Definitions.
+
+ "License" shall mean the terms and conditions for use, reproduction,
+ and distribution as defined by Sections 1 through 9 of this document.
+
+ "Licensor" shall mean the copyright owner or entity authorized by
+ the copyright owner that is granting the License.
+
+ "Legal Entity" shall mean the union of the acting entity and all
+ other entities that control, are controlled by, or are under common
+ control with that entity. For the purposes of this definition,
+ "control" means (i) the power, direct or indirect, to cause the
+ direction or management of such entity, whether by contract or
+ otherwise, or (ii) ownership of fifty percent (50%) or more of the
+ outstanding shares, or (iii) beneficial ownership of such entity.
+
+ "You" (or "Your") shall mean an individual or Legal Entity
+ exercising permissions granted by this License.
+
+ "Source" form shall mean the preferred form for making modifications,
+ including but not limited to software source code, documentation
+ source, and configuration files.
+
+ "Object" form shall mean any form resulting from mechanical
+ transformation or translation of a Source form, including but
+ not limited to compiled object code, generated documentation,
+ and conversions to other media types.
+
+ "Work" shall mean the work of authorship, whether in Source or
+ Object form, made available under the License, as indicated by a
+ copyright notice that is included in or attached to the work
+ (an example is provided in the Appendix below).
+
+ "Derivative Works" shall mean any work, whether in Source or Object
+ form, that is based on (or derived from) the Work and for which the
+ editorial revisions, annotations, elaborations, or other modifications
+ represent, as a whole, an original work of authorship. For the purposes
+ of this License, Derivative Works shall not include works that remain
+ separable from, or merely link (or bind by name) to the interfaces of,
+ the Work and Derivative Works thereof.
+
+ "Contribution" shall mean any work of authorship, including
+ the original version of the Work and any modifications or additions
+ to that Work or Derivative Works thereof, that is intentionally
+ submitted to Licensor for inclusion in the Work by the copyright owner
+ or by an individual or Legal Entity authorized to submit on behalf of
+ the copyright owner. For the purposes of this definition, "submitted"
+ means any form of electronic, verbal, or written communication sent
+ to the Licensor or its representatives, including but not limited to
+ communication on electronic mailing lists, source code control systems,
+ and issue tracking systems that are managed by, or on behalf of, the
+ Licensor for the purpose of discussing and improving the Work, but
+ excluding communication that is conspicuously marked or otherwise
+ designated in writing by the copyright owner as "Not a Contribution."
+
+ "Contributor" shall mean Licensor and any individual or Legal Entity
+ on behalf of whom a Contribution has been received by Licensor and
+ subsequently incorporated within the Work.
+
+ 2. Grant of Copyright License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ copyright license to reproduce, prepare Derivative Works of,
+ publicly display, publicly perform, sublicense, and distribute the
+ Work and such Derivative Works in Source or Object form.
+
+ 3. Grant of Patent License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ (except as stated in this section) patent license to make, have made,
+ use, offer to sell, sell, import, and otherwise transfer the Work,
+ where such license applies only to those patent claims licensable
+ by such Contributor that are necessarily infringed by their
+ Contribution(s) alone or by combination of their Contribution(s)
+ with the Work to which such Contribution(s) was submitted. If You
+ institute patent litigation against any entity (including a
+ cross-claim or counterclaim in a lawsuit) alleging that the Work
+ or a Contribution incorporated within the Work constitutes direct
+ or contributory patent infringement, then any patent licenses
+ granted to You under this License for that Work shall terminate
+ as of the date such litigation is filed.
+
+ 4. Redistribution. You may reproduce and distribute copies of the
+ Work or Derivative Works thereof in any medium, with or without
+ modifications, and in Source or Object form, provided that You
+ meet the following conditions:
+
+ (a) You must give any other recipients of the Work or
+ Derivative Works a copy of this License; and
+
+ (b) You must cause any modified files to carry prominent notices
+ stating that You changed the files; and
+
+ (c) You must retain, in the Source form of any Derivative Works
+ that You distribute, all copyright, patent, trademark, and
+ attribution notices from the Source form of the Work,
+ excluding those notices that do not pertain to any part of
+ the Derivative Works; and
+
+ (d) If the Work includes a "NOTICE" text file as part of its
+ distribution, then any Derivative Works that You distribute must
+ include a readable copy of the attribution notices contained
+ within such NOTICE file, excluding those notices that do not
+ pertain to any part of the Derivative Works, in at least one
+ of the following places: within a NOTICE text file distributed
+ as part of the Derivative Works; within the Source form or
+ documentation, if provided along with the Derivative Works; or,
+ within a display generated by the Derivative Works, if and
+ wherever such third-party notices normally appear. The contents
+ of the NOTICE file are for informational purposes only and
+ do not modify the License. You may add Your own attribution
+ notices within Derivative Works that You distribute, alongside
+ or as an addendum to the NOTICE text from the Work, provided
+ that such additional attribution notices cannot be construed
+ as modifying the License.
+
+ You may add Your own copyright statement to Your modifications and
+ may provide additional or different license terms and conditions
+ for use, reproduction, or distribution of Your modifications, or
+ for any such Derivative Works as a whole, provided Your use,
+ reproduction, and distribution of the Work otherwise complies with
+ the conditions stated in this License.
+
+ 5. Submission of Contributions. Unless You explicitly state otherwise,
+ any Contribution intentionally submitted for inclusion in the Work
+ by You to the Licensor shall be under the terms and conditions of
+ this License, without any additional terms or conditions.
+ Notwithstanding the above, nothing herein shall supersede or modify
+ the terms of any separate license agreement you may have executed
+ with Licensor regarding such Contributions.
+
+ 6. Trademarks. This License does not grant permission to use the trade
+ names, trademarks, service marks, or product names of the Licensor,
+ except as required for reasonable and customary use in describing the
+ origin of the Work and reproducing the content of the NOTICE file.
+
+ 7. Disclaimer of Warranty. Unless required by applicable law or
+ agreed to in writing, Licensor provides the Work (and each
+ Contributor provides its Contributions) on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ implied, including, without limitation, any warranties or conditions
+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+ PARTICULAR PURPOSE. You are solely responsible for determining the
+ appropriateness of using or redistributing the Work and assume any
+ risks associated with Your exercise of permissions under this License.
+
+ 8. Limitation of Liability. In no event and under no legal theory,
+ whether in tort (including negligence), contract, or otherwise,
+ unless required by applicable law (such as deliberate and grossly
+ negligent acts) or agreed to in writing, shall any Contributor be
+ liable to You for damages, including any direct, indirect, special,
+ incidental, or consequential damages of any character arising as a
+ result of this License or out of the use or inability to use the
+ Work (including but not limited to damages for loss of goodwill,
+ work stoppage, computer failure or malfunction, or any and all
+ other commercial damages or losses), even if such Contributor
+ has been advised of the possibility of such damages.
+
+ 9. Accepting Warranty or Additional Liability. While redistributing
+ the Work or Derivative Works thereof, You may choose to offer,
+ and charge a fee for, acceptance of support, warranty, indemnity,
+ or other liability obligations and/or rights consistent with this
+ License. However, in accepting such obligations, You may act only
+ on Your own behalf and on Your sole responsibility, not on behalf
+ of any other Contributor, and only if You agree to indemnify,
+ defend, and hold each Contributor harmless for any liability
+ incurred by, or claims asserted against, such Contributor by reason
+ of your accepting any such warranty or additional liability.
+
+ END OF TERMS AND CONDITIONS
+
+ APPENDIX: How to apply the Apache License to your work.
+
+ To apply the Apache License to your work, attach the following
+ boilerplate notice, with the fields enclosed by brackets "[]"
+ replaced with your own identifying information. (Don't include
+ the brackets!) The text should be enclosed in the appropriate
+ comment syntax for the file format. We also recommend that a
+ file or class name and description of purpose be included on the
+ same "printed page" as the copyright notice for easier
+ identification within third-party archives.
+
+ Copyright [yyyy] [name of copyright owner]
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
131 termite/README
@@ -0,0 +1,131 @@
+Termite is Copyright 2005-2008 by Guillaume Germain
+(guillaume.germain@gmail.com), All Rights Reserved.
+
+Termite is released under the same license as Gambit itself,
+see the LICENSE file.
+
+* See the 'INSTALL' file for installation instructions. *
+
+The current code should be considered as beta quality. That is,
+some of it isn't yet implemented using a very good style, might
+contains some bug, will probably change in the near future, and the
+interaction with Gambit might be a little 'rough' for now.
+
+Don't hesitate to bug me (guillaume.germain@gmail.com) if something
+doesn't work as it should, if you have questions or if you have
+feature requests.
+
+--------------------------------------------------------
+
+Here is some incomplete documentation about the system.
+
+
+Some Notes
+----------
+
+See "examples/start1.sh" for a minimal Termite program.
+
+The global environment should be the same on every node, because it
+isn't included in the serialization of ojects.
+
+One should avoid to make references to unserializable objects in
+closures and continuations, else things will fail.
+
+The programs should not use mutations. Instead, rely on the fact that
+passing messages around /is/ a representation of mutable state. See
+"examples/cons.scm" for an example. Still, mutable data structures
+can be hidden behind processes with some care. Have a look at
+'data.scm' for examples.
+
+To stay in the "spirit" of Termite, one should not use SET!, SET-CAR!,
+SET-CDR!, VECTOR-SET!, STRING-SET! and similar functions. Better
+integration in the future with Gambit might prevent those forms and
+functions from being available.
+
+
+Datatypes:
+---------
+
+NODE -> node ID
+(make-node ip-address tcp-port#)
+
+TAG -> universally unique identifier
+(make-tag)
+
+
+Functions and special forms:
+---------------------------
+
+(node-init node)
+
+Necessary to initialize the system.
+
+(spawn thunk)
+
+Start a new process executing the 'body' code and return its PID.
+
+
+(spawn-link thunk)
+
+Start a new process executing the 'body' code and linking that process
+to the current one and return its PID.
+
+
+(remote-spawn node thunk)
+
+Spawn a new thunk on a remote node and return its PID.
+
+
+(self)
+
+Get the PID of the running process.
+
+
+(current-node)
+
+Get the current node we're executing on.
+
+
+(! pid message)
+Send message to process.
+
+
+(? [timeout [default-value]])
+
+Receive a message, block for 'timeout' seconds if no messages. An
+exception will be raised if no default-value is specified.
+
+
+(?? pred? [timeout [default-value]])
+Receive a message for which (pred? message) is true.
+
+
+(recv
+ (pattern . code)
+ (pattern (where clause) . code)
+ (after seconds . code))
+
+Selectively receive a message that match a pattern, and destructure
+it. The last clause can optionally be a 'timeout' clause, with code
+to execute if no messages received after a certain amount of time.
+
+
+(!? pid message [timeout [default-value]])
+
+Remote procedure call (or synchronous message). This requires
+doing something like:
+
+(recv
+ ...
+ ((from token message) (! from (list token reply)))
+ ...)
+
+
+(shutdown!)
+
+Nicely terminate the execution of the current process.
+
+
+(terminate! pid)
+
+Forcefully terminate the execution of a local process.
1  termite/VERSION
@@ -0,0 +1 @@
+0.13
5 termite/benchmarks/README
@@ -0,0 +1,5 @@
+The files in this folder are the implementations for the benchmarks
+that were used in the Termite paper (http://toute.ca/termite.pdf).
+
+They were run automatically by a Perl script that I'm too ashamed of
+to include here.
6 termite/benchmarks/bench.scm
@@ -0,0 +1,6 @@
+(define-macro (time* . code)
+ (let ((t0 (gensym)))
+ `(let ((,t0 (time->seconds (current-time))))
+ (begin ,@code)
+ (inexact->exact
+ (round (* 1000 (- (time->seconds (current-time)) ,t0)))))))
2  termite/benchmarks/config-dinos.scm
@@ -0,0 +1,2 @@
+(define node1 (make-node "dino11" 3000))
+(define node2 (make-node "dino12" 3001))
2  termite/benchmarks/config-single-node.scm
@@ -0,0 +1,2 @@
+(define node1 (make-node "127.0.0.1" 3000))
+(define node2 (make-node "127.0.0.1" 3000))
2  termite/benchmarks/config.scm
@@ -0,0 +1,2 @@
+(define node1 (make-node "127.0.0.1" 3000))
+(define node2 (make-node "127.0.0.1" 3001))
14 termite/benchmarks/fib.erl
@@ -0,0 +1,14 @@
+-module(fib).
+
+-export([run/1, fib/1]).
+
+
+fib(X) when X < 2 -> X;
+fib(X) ->
+ fib(X-1)+fib(X-2).
+
+run([Arg]) ->
+ N = list_to_integer(Arg),
+ {Time, _} = timer:tc(fib,fib,[N]),
+ io:format("(fib erlang ~w ~w)~n", [N, round(Time / 1000)]),
+ halt(0).
14 termite/benchmarks/fib.scm
@@ -0,0 +1,14 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(include "bench.scm")
+
+(define (fib n)
+ (if (< n 2)
+ n
+ (+ (fib (- n 1))
+ (fib (- n 2)))))
+
+(define (main n)
+ (let ((n (string->number n)))
+ (write `(fib termite ,n ,(time* (fib n))))
+ (newline)))
34 termite/benchmarks/migrate.scm
@@ -0,0 +1,34 @@
+(declare (block))
+
+(include "bench.scm")
+
+(define (run n)
+ (let ((this (self)))
+ (spawn
+ (lambda ()
+ (let loop ((n n))
+ (if (> n 0)
+ (begin
+ (if (even? n)
+ (migrate-task node2)
+ (migrate-task node1)))
+ (begin
+ (! this 'done)
+ (shutdown!)))
+ (loop (- n 1))))))
+ (?))
+
+(define (main n)
+ (cond
+ ((equal? (current-node) node1)
+ ;; code for node 1
+ (write `(migrate
+ termite
+ ,n
+ ,(time* (run n))))
+ (newline)
+ (remote-spawn node2 (lambda () (exit)))
+ (? 1 'done))
+
+ ;; code for node2
+ (else (?))))
27 termite/benchmarks/nrev.erl
@@ -0,0 +1,27 @@
+-module(nrev).
+
+-export([run/1, nrev/1, iota/1]).
+
+
+iota(X) ->
+ iota (X-1, []).
+
+iota(0, L) ->
+ [0|L];
+
+iota(X, L) ->
+ iota(X-1, [X|L]).
+
+nrev([]) ->
+ [];
+
+nrev([A|B]) ->
+ nrev(B) ++ [A].
+
+
+run([Arg]) ->
+ N = list_to_integer(Arg),
+ L = iota(N),
+ {Time, _} = timer:tc(nrev,nrev,[L]),
+ io:format("(nrev erlang ~w ~w)~n", [N, round(Time / 1000)]),
+ halt(0).
23 termite/benchmarks/nrev.scm
@@ -0,0 +1,23 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(include "bench.scm")
+
+(define (iota n)
+ (define (i n acc)
+ (if (= n 0)
+ acc
+ (i (- n 1)
+ (cons n acc))))
+ (i n '()))
+
+(define (nrev lst)
+ (if (null? lst)
+ lst
+ (append (nrev (cdr lst))
+ (list (car lst)))))
+
+(define (main n)
+ (let* ((n (string->number n))
+ (lst (iota n)))
+ (write `(nrev termite ,n ,(time* (nrev lst))))
+ (newline)))
43 termite/benchmarks/pingpong.erl
@@ -0,0 +1,43 @@
+-module(pingpong).
+
+-export([run/1, bench/3, pingpong_player/1, iota/1]).
+
+
+iota(0) -> [];
+iota(N) -> [N] ++ iota(N - 1).
+
+pingpong_player(N) ->
+ receive
+ {From, done} ->
+ From ! N,
+ exit(normal);
+ {From, Ball} ->
+ From ! {self(), Ball}
+ end,
+ pingpong_player(N + 1).
+
+bench(Duration, Len, Remote) ->
+ Player1 = spawn(pingpong, pingpong_player, [0]),
+ Player2 = spawn(Remote, pingpong, pingpong_player, [1]),
+ Player1 ! {Player2, iota(Len)},
+ receive
+ after Duration -> ok
+ end,
+ Player1 ! {self(), done},
+ Player2 ! {self(), done},
+ receive
+ X ->
+ io:format("(pingpong erlang ~w ~w)~n",
+ [Len, round(X / (Duration / 1000))])
+ end.
+
+run([Len, Node]) ->
+ Remote = case Node of
+ "remote" ->
+ receive X -> X end;
+ _ -> list_to_atom(Node)
+ end,
+ Duration = 5000,
+ bench(Duration, list_to_integer(Len), Remote),
+ spawn(Remote, erlang, halt, [0]),
+ halt(0).
51 termite/benchmarks/pingpong.scm
@@ -0,0 +1,51 @@
+(declare (block))
+
+(define (iota n)
+ (if (= n 0)
+ '()
+ (cons n (iota (- n 1)))))
+
+(define (ping-pong-player)
+ (let loop ((n 0))
+ (let ((msg (?)))
+ (let ((from (car msg))
+ (ball (cdr msg)))
+ (if (eq? ball 'done)
+ (! from n)
+ (begin
+ (! from (cons (self) ball))
+ (loop (+ n 1))))))))
+
+
+(define (run player1 player2 duration len)
+ (! player1 (cons player2 (iota len)))
+ (? duration 'ok) ;; pause
+
+ (! player1 (cons (self) 'done))
+ (! player2 (cons (self) 'done))
+ (?))
+
+(define (pingpong duration len)
+ (write `(pingpong
+ termite
+ ,len
+ ,(round (/ (run
+ (spawn ping-pong-player)
+ (remote-spawn node2 ping-pong-player)
+ duration
+ len)
+ duration))))
+ (newline))
+
+(define (main #!optional (len 42))
+ (cond
+ ((equal? (current-node) node1)
+ ;; code for node 1
+ (let ((duration 5))
+ (pingpong duration len)
+ (remote-spawn node2 (lambda () (exit)))
+ (? 1 'done)))
+
+ ;; code for node2
+ (else
+ (?))))
16 termite/benchmarks/pingpong2.scm
@@ -0,0 +1,16 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(define (main #!optional (len "42"))
+ (cond
+ ((equal? (current-node) node1)
+ ;; code for node 1
+ (let ((len (string->number len))
+ (duration 5))
+ (pingpong duration len)
+ (remote-spawn node2 (lambda () (exit)))
+ (? 1 'done)))
+
+ ;; code for node2
+ (else
+ (write (?))
+ (newline))))
37 termite/benchmarks/pingpong_gambit.scm
@@ -0,0 +1,37 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(define (iota n)
+ (if (= n 0)
+ '()
+ (cons n (iota (- n 1)))))
+
+(define (ping-pong-player)
+ (let loop ((n 0))
+ (let ((msg (thread-receive)))
+ (let ((from (car msg))
+ (ball (cdr msg)))
+ (if (eq? ball 'done)
+ (thread-send from n)
+ (begin
+ (thread-send from (cons (current-thread) ball))
+ (loop (+ n 1))))))))
+
+(define player1 (thread-start! (make-thread ping-pong-player)))
+(define player2 (thread-start! (make-thread ping-pong-player)))
+
+(define (bench duration len)
+ (thread-send player1 (cons player2 (iota len)))
+ (thread-receive duration 'ok) ; pause
+ (thread-send player1 (cons (current-thread) 'done))
+ (thread-send player2 (cons (current-thread) 'done))
+ (thread-receive))
+
+(define (main #!optional (len "42"))
+ (let ((len (string->number len)))
+ (let ((duration 5))
+ (write `(pingpong
+ gambit
+ ,len
+ ,(round (/ (bench duration len) duration))))
+ (newline)))
+ (thread-receive 1 'done))
41 termite/benchmarks/qsort.erl
@@ -0,0 +1,41 @@
+-module(qsort).
+
+-export([run/1, qsort/1]).
+
+qsort(L) ->
+ qsort(L, []).
+
+qsort([X|L], ReallyBigs) ->
+ {S, B} = partition(L, X),
+ SB = qsort(B, ReallyBigs),
+ qsort(S, [X|SB]);
+qsort([], Bigs) ->
+ Bigs.
+
+
+partition([X|Rest], Y) when X =< Y ->
+ {S, B} = partition(Rest, Y),
+ {[X|S], B};
+partition([X|Rest], Y) ->
+ {S, B} = partition(Rest, Y),
+ {S, [X|B]};
+partition([],_) ->
+ {[], []}.
+
+
+mkrandlist(X) ->
+ random:seed(),
+ mkrandlist(X, []).
+
+mkrandlist(0, L) ->
+ L;
+mkrandlist(X, L) ->
+ mkrandlist(X-1, [random:uniform(1000000) | L]).
+
+
+run([Arg]) ->
+ N = list_to_integer(Arg),
+ L = mkrandlist(N),
+ {Time, _} = timer:tc(qsort,qsort,[L]),
+ io:format("(qsort erlang ~w ~w)~n", [N, round(Time / 1000)]),
+ halt(0).
49 termite/benchmarks/qsort.scm
@@ -0,0 +1,49 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(include "bench.scm")
+
+(define (make-random-list n)
+ (if (= n 0)
+ '()
+ (cons (random-integer 1000000)
+ (make-random-list (- n 1)))))
+
+(define (qsort lst)
+ (define (partition lst pivot k)
+ (let loop ((lst lst)
+ (smaller '())
+ (greater '()))
+ (cond
+ ((null? lst)
+ (k smaller greater))
+ ((< (car lst) pivot)
+ (loop (cdr lst)
+ (cons (car lst) smaller)
+ greater))
+ (else
+ (loop (cdr lst)
+ smaller
+ (cons (car lst) greater))))))
+
+ (define (qs lst sorted)
+ (if (null? lst)
+ sorted
+ (let ((pivot (car lst))
+ (rest (cdr lst)))
+ (partition rest
+ pivot
+ (lambda (smaller greater)
+ (qs smaller
+ (cons pivot
+ (qs greater sorted))))))))
+
+ (qs lst '()))
+
+(random-source-randomize! default-random-source)
+
+(define (main n)
+ (let ((n (string->number n)))
+ (let ((lst (make-random-list n)))
+ (write `(qsort termite ,n ,(time* (qsort lst))))
+ (newline)
+ (force-output))))
32 termite/benchmarks/ring.erl
@@ -0,0 +1,32 @@
+-module(ring).
+
+-export([run/1, ring/2, make_relay/1]).
+
+make_relay(Next) ->
+ receive
+ K when K > 0 ->
+ Next ! K - 1,
+ make_relay(Next);
+
+ K ->
+ Next ! K
+ end.
+
+loop(K, Current, N) when N > 1 ->
+ loop(K,
+ spawn(ring, make_relay, [Current]),
+ N - 1);
+
+loop(K, Current, _) ->
+ self() ! K,
+ make_relay(Current).
+
+ring(N, K) ->
+ loop(K, self(), N).
+
+run([N, K]) ->
+ N1 = list_to_integer(N),
+ K1 = list_to_integer(K),
+ {Time, _} = timer:tc(ring,ring,[N1,K1]),
+ io:format("(ring erlang (~w ~w) ~w)~n", [N1, K1, round(Time / 1000)]),
+ halt(0).
35 termite/benchmarks/ring.scm
@@ -0,0 +1,35 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(init)
+
+(include "bench.scm")
+
+(define (make-relay next)
+ (let loop ()
+ (let ((k (?)))
+ (cond
+ ((> k 0)
+ (! next (- k 1))
+ (loop))
+ (else
+ (! next k))))))
+
+(define (ring n k)
+ (let loop ((current (self))
+ (n n))
+ (cond
+ ((> n 1)
+ (loop (spawn
+ (lambda ()
+ (make-relay current)))
+ (- n 1)))
+ (else
+ (! (self) k)
+ (make-relay current)))))
+
+(define (main n k)
+ (let ((n (string->number n))
+ (k (string->number k)))
+ (write `(ring termite (,n ,k) ,(time* (ring n k))))
+ (newline)
+ (? 1 'ok)))
34 termite/benchmarks/ring_gambit.scm
@@ -0,0 +1,34 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(include "bench.scm")
+
+(define (make-relay next)
+ (let loop ()
+ (let ((k (thread-receive)))
+ (cond
+ ((> k 0)
+ (thread-send next (- k 1))
+ (loop))
+ (else
+ (thread-send next k))))))
+
+(define (ring n k)
+ (let loop ((current (current-thread))
+ (n n))
+ (cond
+ ((> n 1)
+ (loop (thread-start!
+ (make-thread
+ (lambda ()
+ (make-relay current))))
+ (- n 1)))
+ (else
+ (thread-send (current-thread) k)
+ (make-relay current)))))
+
+
+(define (main n k)
+ (let ((n (string->number n))
+ (k (string->number k)))
+ (write `(ring gambit (,n ,k) ,(time* (ring n k))))
+ (newline)))
16 termite/benchmarks/self.erl
@@ -0,0 +1,16 @@
+-module(self).
+
+-export([run/1, test/1]).
+
+test(0) -> ok;
+
+test(N) ->
+ self() ! (N - 1),
+ receive N1 -> test(N1) end.
+
+run([Arg]) ->
+ N = list_to_integer(Arg),
+ {Time, _} = timer:tc(self, test, [N]),
+ io:format("(self erlang ~w ~w)~n", [N, round(Time / 1000)]),
+ halt(0).
+
19 termite/benchmarks/self.scm
@@ -0,0 +1,19 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(init)
+
+(include "bench.scm")
+
+(define (main n)
+ (let ((n (string->number n)))
+ (write
+ `(self
+ termite
+ ,n
+ ,(time*
+ (let loop ((n n))
+ (! (self) n)
+ (?)
+ (if (> n 0)
+ (loop (- n 1)))))))
+ (newline)))
17 termite/benchmarks/self_gambit.scm
@@ -0,0 +1,17 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(include "bench.scm")
+
+(define (main n)
+ (let ((n (string->number n)))
+ (write
+ `(self
+ gambit
+ ,n
+ ,(time*
+ (let loop ((n n))
+ (thread-send (current-thread) n)
+ (thread-receive)
+ (if (> n 0)
+ (loop (- n 1)))))))
+ (newline)))
162 termite/benchmarks/smith.erl
@@ -0,0 +1,162 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Program : Smith Waterman string matching algorithm Erlang version %
+% File : smith.erl %
+% Author : Alexander Jean-Claude Bottema (alexb@csd.uu.se) %
+% Datum : Sep 19 1995 %
+% Revidated : Sep 19 1995 %
+% --------------------------------------------------------------------------- %
+% Changes: %
+% Optimization 1: Inline "match_weights" %
+% Optimization 2: Guards on all int variables (explicit type information) %
+% --------------------------------------------------------------------------- %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(smith).
+-export([run/1, test/1, generate_sequence/2, match_sequences/2]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% max(A,B) - The maximum value of A and B
+%
+
+max(A,B) when integer(A), integer(B) ->
+ if A > B -> A
+ ; true -> B
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% alpha_beta_penalty(A,B) - The penalty value of A and B
+%
+alpha_beta_penalty(A,B) when integer(A), integer(B) -> max(A-4,B-1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% match_weights(A,B) - Weight function of A and B
+%
+% match_weights(A,B) -> if A == B -> 1 ; true -> 0 end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% generate_sequence( Length, Seed ) - Generate a random sequence of length
+% 'Length' using seed value 'Seed'.
+%
+
+generate_sequence( Length, R ) when integer(Length) ->
+ if Length == 0 -> []
+ ; true -> [R rem 10 | generate_sequence( Length - 1,
+ (R * 11 + 1237501)
+ rem 10067)]
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% generate_sequences( No, Length, Seed )
+%
+
+generate_sequences( 0, _, _ ) -> [] ;
+generate_sequences( N, Length, R ) when integer(N), integer(Length) ->
+ [generate_sequence(Length, R) | generate_sequences(N-1,Length,R+1)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Entry representation:
+%
+% Entry = {Left,Upper,UpperLeft,Max}
+%
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% match_entry(Top,Side,UpperLeft,Upper,Left) -
+% Match sequence entries with surrounding information
+
+match_entry(Top,Side,UpperLeft,Upper,Left) when integer(Top), integer(Side) ->
+ MeLeft = alpha_beta_penalty( element( 3, Left ), element( 1, Left ) ),
+ MeUpper = alpha_beta_penalty( element( 3, Upper ), element( 2, Upper ) ),
+ %
+ % match weight removed
+ %
+ if Top == Side ->
+ MeUpperLeft =
+ max(MeLeft,
+ max(MeUpper,
+ max( element( 3, UpperLeft ) + 1, 0 )))
+ ;
+ true ->
+ MeUpperLeft =
+ max(MeLeft,
+ max(MeUpper,
+ max( element( 3, UpperLeft ), 0 )))
+ end,
+ {MeLeft, MeUpper, MeUpperLeft,
+ max(MeUpperLeft,
+ max(element(4, Left),
+ max(element(4, Upper), element(4, UpperLeft))))}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% match_zero_entry( Top, Side, Left )
+%
+
+match_zero_entry( Top, Side, {Left,_,UpperLeft,Max} ) when integer(Top), integer(Side) ->
+ ELeft = alpha_beta_penalty(UpperLeft, Left),
+ %Weight = max(1-abs(Side-Top),0),
+ EUpperLeft = max(max(ELeft,max(1-abs(Side-Top),0)),0),
+ EMax = max(max(Max,EUpperLeft),0),
+ {ELeft, -1, EUpperLeft, EMax}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% match(Top, Side, Prev, UpperLeft, Left )
+%
+
+match(Tops, Side, Prev, UpperLeft, Left) ->
+ match0(Tops, Side, Prev, UpperLeft, Left, [], none).
+
+match0([], _, _, _, _, Acc, Last) -> {Acc,Last} ;
+match0([Top|Tops], Side, [Upper|Prev], UpperLeft, Left, Acc, _) when
+ integer(Top), integer(Side) ->
+ E = match_entry(Top, Side, UpperLeft, Upper, Left),
+ match0(Tops, Side, Prev, Upper, E, [E|Acc], E) ;
+match0([Top|Tops], Side, none, UpperLeft, Left, Acc, _) when
+ integer(Top), integer(Side) ->
+ E = match_zero_entry(Top, Side, Left ),
+ match0(Tops, Side, none, UpperLeft, E, [E|Acc], E).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% match_two_seq(Side, Top, Prev)
+%
+
+match_two_seq(Side, Top, Prev) ->
+ match_two_seq0(Side, Top, Prev, none).
+
+match_two_seq0([], _, _, Result) -> Result ;
+match_two_seq0([S|Side], Top, Prev, _) when integer(S) ->
+ {Row,Result} = match(Top,S,Prev,{0,0,0,0},{0,0,0,0}),
+ match_two_seq0(Side, Top, Row, Result).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% match_sequences(Tops, Side)
+%
+
+match_sequences(Tops, Side) ->
+ match_sequences0(Tops, Side, -9999999).
+
+match_sequences0([], _, MaxResult) -> MaxResult ;
+match_sequences0([Top|Tops], Side, CrntResult) ->
+ Result = element(4, match_two_seq(Top, Side, none)),
+ match_sequences0(Tops, Side, max(CrntResult, Result)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% test(N)
+%
+
+test(N) ->
+ Tops = generate_sequences(N, 32, 1),
+ Side = generate_sequence(32, 0),
+ {Time, _} = timer:tc(smith, match_sequences, [Tops, Side]),
+ io:format("(smith erlang ~w ~w)~n", [N, round(Time / 1000)]).
+
+run([Arg]) ->
+ N = list_to_integer(Arg),
+ test(N),
+ halt(0).
103 termite/benchmarks/smith.scm
@@ -0,0 +1,103 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+;; Smith Waterman string matching algorithm Scheme version (direct
+;; translation of the Erlang version)
+;;
+;; Orginal Erlang version by Alexander Jean-Claude Bottema
+;; (alexb@csd.uu.se)
+
+(include "bench.scm")
+
+(define (alpha-beta-penalty a b)
+ (max (- a 4)
+ (- b 1)))
+
+(define (generate-sequence len r)
+ (if (= len 0)
+ '()
+ (cons (remainder r 10)
+ (generate-sequence (- len 1)
+ (remainder
+ (+ (* r 11) 1237501) 10067)))))
+
+(define (generate-sequences n len r)
+ (if (= n 0)
+ '()
+ (cons
+ (generate-sequence len r)
+ (generate-sequences (- n 1) len (+ r 1)))))
+
+(define (match-entry top side upper-left upper left)
+ (let ((me-left (alpha-beta-penalty (vector-ref left 2)
+ (vector-ref left 0)))
+ (me-upper (alpha-beta-penalty (vector-ref upper 2)
+ (vector-ref upper 1))))
+ (let ((me-upper-left
+ (max me-left
+ me-upper
+ (+ (vector-ref upper-left 2) (if (= top side) 1 0))
+ 0)))
+ (vector me-left
+ me-upper
+ me-upper-left
+ (max me-upper-left
+ (vector-ref left 3)
+ (vector-ref upper 3)
+ (vector-ref upper-left 3))))))
+
+(define (match-zero-entry top side v)
+ (let ((left (vector-ref v 0))
+ (upper-left (vector-ref v 2))
+ (max* (vector-ref v 3)))
+ (let* ((e-left (alpha-beta-penalty upper-left left))
+ ;; (weight (max (- 1 (abs (- side top))) 0))
+ (e-upper-left (max e-left (- 1 (abs (- side top))) 0))
+ (e-max (max max* e-upper-left 0)))
+ (vector e-left -1 e-upper-left e-max))))
+
+(define (match* tops side prev upper-left left)
+ (match0 tops side prev upper-left left '() 'none))
+
+(define (match0 tops side prev upper-left left acc last)
+ (if (null? tops)
+ (cons acc last)
+ (let ((top (car tops))
+ (tops (cdr tops)))
+ (if (eq? prev 'none)
+ (let ((e (match-zero-entry top side left)))
+ (match0 tops side 'none upper-left e (cons e acc) e))
+ (let ((upper (car prev))
+ (prev (cdr prev)))
+ (let ((e (match-entry top side upper-left upper left)))
+ (match0 tops side prev upper e (cons e acc) e)))))))
+
+(define (match-two-seq side top prev)
+ (match-two-seq0 side top prev 'none))
+
+(define (match-two-seq0 side top prev acc)
+ (if (null? side)
+ acc
+ (let ((s (car side))
+ (side (cdr side)))
+ (let ((tmp (match* top s prev (vector 0 0 0 0) (vector 0 0 0 0))))
+ (let ((row (car tmp))
+ (result (cdr tmp)))
+ (match-two-seq0 side top row result))))))
+
+(define (match-sequences tops side)
+ (match-sequences0 tops side -9999999))
+
+(define (match-sequences0 tops side current-result)
+ (if (null? tops)
+ current-result
+ (let ((top (car tops))
+ (tops (cdr tops)))
+ (let ((result (vector-ref (match-two-seq top side 'none) 3)))
+ (match-sequences0 tops side (max current-result result))))))
+
+(define (main n)
+ (let ((n (string->number n)))
+ (let ((tops (generate-sequences n 32 1))
+ (side (generate-sequence 32 0)))
+ (write `(smith termite ,n ,(time* (match-sequences tops side))))
+ (newline))))
17 termite/benchmarks/spawn.erl
@@ -0,0 +1,17 @@
+-module(spawn).
+
+-export([run/1, test/1]).
+
+test(0) -> ok;
+
+test(N) ->
+ F = fun () -> N end,
+ spawn(F),
+ test(N - 1).
+
+run([Arg]) ->
+ N = list_to_integer(Arg),
+ {Time, _} = timer:tc(spawn, test, [N]),
+ io:format("(spawn erlang ~w ~w)~n", [N, round(Time / 1000)]),
+ halt(0).
+
18 termite/benchmarks/spawn.scm
@@ -0,0 +1,18 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(init)
+
+(include "bench.scm")
+
+(define (main n)
+ (let ((n (string->number n)))
+ (write
+ `(spawn
+ termite
+ ,n
+ ,(time*
+ (let loop ((n n))
+ (spawn (lambda () n))
+ (if (> n 0)
+ (loop (- n 1)))))))
+ (newline)))
16 termite/benchmarks/spawn_gambit.scm
@@ -0,0 +1,16 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(include "bench.scm")
+
+(define (main n)
+ (let ((n (string->number n)))
+ (write
+ `(spawn
+ gambit
+ ,n
+ ,(time*
+ (let loop ((n n))
+ (thread-start! (make-thread (lambda () n)))
+ (if (> n 0)
+ (loop (- n 1)))))))
+ (newline)))
17 termite/benchmarks/tak.erl
@@ -0,0 +1,17 @@
+-module(tak).
+
+-export([run/1, tak/3]).
+
+tak(X, Y, Z) when X =< Y ->
+ Z;
+tak(X, Y, Z) ->
+ tak(tak(X-1, Y, Z), tak(Y-1, Z, X), tak(Z-1, X, Y)).
+
+
+run([Arg1, Arg2, Arg3]) ->
+ X = list_to_integer(Arg1),
+ Y = list_to_integer(Arg2),
+ Z = list_to_integer(Arg3),
+ {Time, _} = timer:tc(tak,tak,[X, Y, Z]),
+ io:format("(tak erlang (~w ~w ~w) ~w)~n", [X, Y, Z, round(Time / 1000)]),
+ halt(0).
17 termite/benchmarks/tak.scm
@@ -0,0 +1,17 @@
+#!/usr/local/Gambit-C/bin/gsi -:dar1
+
+(include "bench.scm")
+
+(define (tak x y z)
+ (if (<= x y)
+ z
+ (tak (tak (- x 1) y z)
+ (tak (- y 1) z x)
+ (tak (- z 1) x y))))
+
+(define (main x y z)
+ (let ((x (string->number x))
+ (y (string->number y))
+ (z (string->number z)))
+ (write `(tak termite (,x ,y ,z) ,(time* (tak x y z))))
+ (newline)))
199 termite/data.scm
@@ -0,0 +1,199 @@
+;;; Various mutable data structures implemented behind processes
+
+;; (it would be "better" if those were implemented functionally)
+
+;; ----------------------------------------------------------------------------
+;; Cells
+
+(define (make-cell . content)
+ (spawn
+ (lambda ()
+ (let loop ((content (if (pair? content)
+ (car content)
+ (void))))
+ (recv
+ ((from tag 'empty?)
+ (! from (list tag (eq? (void) content)))
+ (loop content))
+
+ ((from tag 'ref)
+ (! from (list tag content))
+ (loop content))
+
+ (('set! content)
+ (loop content)))))))
+
+
+(define (cell-ref cell)
+ (!? cell 'ref))
+
+(define (cell-set! cell value)
+ (! cell (list 'set! value)))
+
+(define (cell-empty! cell)
+ (! cell (list 'set! (void))))
+
+(define (cell-empty? cell)
+ (!? cell 'empty?))
+
+;; or: (define-termite-type cell content)
+
+
+;; ----------------------------------------------------------------------------
+;; Dictionary
+
+(define (make-dict)
+ (spawn
+ (lambda ()
+ (let ((table (make-table test: equal?
+ init: #f)))
+ (let loop ()
+ (recv
+ ((from tag ('dict?))
+ (! from (list tag #t)))
+
+ ((from tag ('dict-length))
+ (! from (list tag (table-length table))))
+
+ ((from tag ('dict-ref key))
+ (! from (list tag (table-ref table key))))
+
+ (('dict-set! key)
+ (table-set! table key))
+
+ (('dict-set! key value)
+ (table-set! table key value))
+
+ ((from tag ('dict-search proc))
+ (! from (list tag (table-search proc table))))
+
+ (('dict-for-each proc)
+ (table-for-each proc table))
+
+ ((from tag ('dict->list))
+ (! from (list tag (table->list table))))
+
+ ((msg
+ (warning (list ignored: msg)))))
+
+ (loop))))))
+
+(define (dict? dict)
+ (!? dict (list 'dict?) 1 #f)) ;; we only give a second to reply to this
+
+(define (dict-length dict)
+ (!? dict (list 'dict-length)))
+
+(define (dict-ref dict key)
+ (!? dict (list 'dict-ref key)))
+
+(define (dict-set! dict . args)
+ (match args
+ ((key)
+ (! dict (list 'dict-set! key)))
+
+ ((key value)
+ (! dict (list 'dict-set! key value)))))
+
+(define (dict-search proc dict)
+ (!? dict (list 'dict-search proc)))
+
+(define (dict-for-each proc dict)
+ (! dict (list 'dict-for-each proc)))
+
+(define (dict->list dict)
+ (!? dict (list 'dict->list)))
+
+;; test...
+
+;; (init)
+;;
+;; (define dict (make-dict))
+;;
+;; (print (dict->list dict))
+;; (dict-set! dict 'foo 123)
+;; (dict-set! dict 'bar 42)
+;; (print (dict->list dict))
+;; (print (dict-search (lambda (k v) (eq? k 'bar) v) dict))
+;; (dict-for-each (lambda (k v) (print k)) dict)
+;; (dict-set! dict 'foo)
+;; (print (dict->list dict))
+;; (? 1 #t)
+
+
+;; ----------------------------------------------------------------------------
+;; Bag
+
+(define (make-bag)
+ (spawn
+ (lambda ()
+ (let ((table (make-table test: equal?
+ init: #f)))
+ (let loop ()
+ (recv
+ ((from tag ('bag?))
+ (! from (list tag #t)))
+
+ ((from tag ('bag-length))
+ (! from (list tag (table-length table))))
+
+ (('bag-add! elt)
+ (table-set! table elt #t))
+
+ (('bag-remove! elt)
+ (table-set! table elt))
+
+ ((from tag ('bag-member? elt))
+ (table-ref table elt))
+
+ ((from tag ('bag-search proc))
+ (! from (list tag (table-search (lambda (k v) (proc k)) table))))
+
+ (('bag-for-each proc)
+ (table-for-each (lambda (k v) (proc k)) table))
+
+ ((from tag ('bag->list))
+ (! from (list tag (map car (table->list table))))))
+
+ (loop))))))
+
+
+(define (bag? bag)
+ (!? bag (list 'bag?) 1 #f)) ;; we only give a second to reply to this
+
+(define (bag-length bag)
+ (!? bag (list 'bag-length)))
+
+(define (bag-add! bag elt)
+ (! bag (list 'bag-add! elt)))
+
+(define (bag-remove! bag elt)
+ (! bag (list 'bag-remove! elt)))
+
+(define (bag-member? bag elt)
+ (!? bag (list 'bag-member? elt)))
+
+(define (bag-search proc bag)
+ (!? bag (list 'bag-search proc)))
+
+(define (bag-for-each proc bag)
+ (! bag (list 'bag-for-each proc)))
+
+(define (bag->list bag)
+ (!? bag (list 'bag->list)))
+
+;; test...
+
+;; (init)
+;;
+;; (define bag (make-bag))
+;;
+;; (print (bag->list bag))
+;; (bag-add! bag 'foo)
+;; (bag-add! bag 'bar)
+;; (print (bag->list bag))
+;; (print (bag-search (lambda (elt) (eq? elt 'bar) elt) bag))
+;; (bag-for-each (lambda (elt) (print elt)) bag)
+;; (bag-remove! bag 'foo)
+;; (print (bag->list bag))
+;; (? 1 #t)
93 termite/deftype.scm
@@ -0,0 +1,93 @@
+;; 'define-type'-like functionality for Termite
+;;
+;; Mutable record created with this are implemented as processes.
+
+(define-macro (define-termite-type type id tag . fields)
+
+ (define (symbol-append . symbols)
+ (string->symbol
+ (apply
+ string-append
+ (map symbol->string symbols))))
+
+ (define (make-maker type)
+ (symbol-append 'make '- type))
+
+ (define (make-getter type field)
+ (symbol-append type '- field))
+
+ (define (make-setter type field)
+ (symbol-append type '- field '-set!))
+
+ (if (not (eq? id id:))
+ (error "id: is mandatory in define-termite-type"))
+
+ (let* ((maker (make-maker type))
+ (getters (map (lambda (field)
+ (make-getter type field))
+ fields))
+ (setters (map (lambda (field)
+ (make-setter type field))
+ fields))
+
+ (internal-type (gensym type))
+ (internal-maker (make-maker internal-type))
+ (internal-getters (map (lambda (field)
+ (make-getter internal-type field))
+ fields))
+ (internal-setters (map (lambda (field)
+ (make-setter internal-type field))
+ fields))
+
+ (facade-maker (gensym maker))
+ (plugin (gensym (symbol-append type '-plugin)))
+
+ (pid (gensym 'pid)))
+
+ `(begin
+ (define-type ,type
+ id: ,tag
+ constructor: ,facade-maker
+ unprintable:
+ ,pid)
+
+ (define-type ,internal-type
+ ,@fields)
+
+ (define ,plugin
+ (make-server-plugin
+ ;; init
+ (lambda (args)
+ (apply ,internal-maker args))
+ ;; call
+ (lambda (term state)
+ (match term
+ ,@(map (lambda (getter internal-getter)
+ `(',getter (values (,internal-getter state) state)))
+ getters
+ internal-getters)))
+ ;; cast
+ (lambda (term state)
+ (match term
+ ,@(map (lambda (setter internal-setter)
+ `((',setter x) (,internal-setter state x) state))
+ setters
+ internal-setters)))
+ ;; terminate
+ (lambda (reason state)
+ (void))))
+
+ (define (,maker ,@fields)
+ (,facade-maker (server:start ,plugin (list ,@fields))))
+
+ ,@(map (lambda (getter)
+ `(define (,getter x)
+ (server:call (,(make-getter type pid) x)
+ ',getter)))
+ getters)
+
+ ,@(map (lambda (setter)
+ `(define (,setter x value)
+ (server:cast (,(make-getter type pid) x)
+ (list ',setter value))))
+ setters))))
28 termite/examples/cell.scm
@@ -0,0 +1,28 @@
+(define-type cell
+ id: 713cb0a4-16ea-4b18-a18e-7a9e33e7b92b
+ unprintable:
+ pid)
+
+(define (cell obj)
+ (make-cell
+ (spawn
+ (lambda ()
+ (cell-loop obj)))))
+
+(define (cell-loop obj)
+ (recv
+ ((from tag 'ref)
+ (! from (list tag obj))
+ (cell-loop obj))
+
+ (('set! obj)
+ (cell-loop obj))))
+
+(define (cell-ref c) (!? (cell-pid c) 'ref))
+(define (cell-set! c obj) (! (cell-pid c) (list 'set! obj)))
+
+(define c (cell 42))
+(print (cell-ref c))
+(newline)
+(cell-set! c 123)
+(print (cell-ref c))
6 termite/examples/config.scm
@@ -0,0 +1,6 @@
+;; sample (and simple) configuration
+
+(define localhost "127.0.0.1")
+(define node1 (make-node localhost 3000))
+(define node2 (make-node localhost 3001))
+(define node3 (make-node localhost 3002))
56 termite/examples/cons.scm
@@ -0,0 +1,56 @@
+#! /usr/local/Gambit-C/bin/gsi -:dari1
+
+(init)
+
+(define-type kons
+ id: 713cb0a4-16ea-4b18-a18e-7a9e33e7b92b
+ unprintable:
+ pid)
+
+(define (kons e1 e2)
+ (make-kons
+ (spawn
+ (lambda ()
+ (kons-loop e1 e2)))))
+
+(define (kons-loop e1 e2)
+ (recv
+ ((from tag 'pair)
+ (! from (list tag (cons e1 e2)))
+ (kons-loop e1 e2))
+
+ ((from tag 'kar)
+ (! from (list tag e1))
+ (kons-loop e1 e2))
+
+ ((from tag 'kdr)
+ (! from (list tag e2))
+ (kons-loop e1 e2))
+
+ (('set-kar! x)
+ (kons-loop x e2))
+
+ (('set-kdr! x)
+ (kons-loop e1 x))
+
+ (x
+ (print 'unknown-message)
+ (raise (list unknown-message: x)))))
+
+(define (kons->cons k) (!? (kons-pid k) 'pair))
+(define (kar k) (!? (kons-pid k) 'kar))
+(define (kdr k) (!? (kons-pid k) 'kdr))
+(define (set-kar! k val) (! (kons-pid k) (list 'set-kar! val)))
+(define (set-kdr! k val) (! (kons-pid k) (list 'set-kdr! val)))
+
+(define x (kons 1 2))
+
+(pp x)
+(pp (kar x))
+(pp (kdr x))
+(pp (kons->cons x))
+(set-kar! x 123)
+(pp (kons->cons x))
+
+(? 1 'ok)
+(pp 'done)
117 termite/examples/supervisor.scm
@@ -0,0 +1,117 @@
+;; This supervisor is intended to be a transparent wrapper for a
+;; process.
+
+;; The code of the process must be in a thunk.
+
+;; The only interface requirement for the supervised process is to
+;; answer to the message 'shutdown
+
+(define (take lst n)
+ (cond
+ ((< n 1) '())
+ (else
+ (cons (car lst)
+ (take (cdr lst)
+ (- n 1))))))
+
+(define (spawn-supervised thunk
+ #!key
+ (threshold 5)
+ (window 1000)
+ (shutdown-delay 0.5)
+ (init-hook (lambda (pid) 'ok)))
+ (spawn
+ (lambda ()
+ (let loop ((failures '()))
+ (let ((pid (spawn-link thunk)))
+ (with-exception-catcher
+ (lambda (exception)
+ (match (exception-object exception)
+ (('exit ,pid reason . _)
+ (match reason
+ ('failure
+ (info "process failed")
+
+ (if (>= (length failures) threshold)
+ (if (< (- (now)
+ (list-ref failures
+ (- threshold 1)))
+ window)
+ (begin
+ (print
+ `(info: not restarting (too many failures)))
+ (print
+ `(info: halting supervisor))
+ (halt!))
+ (loop (cons (now)
+ (take failures
+ (- threshold 1)))))
+ (begin
+ (print `(info: restarting...))
+ (loop (cons (now) failures)))))
+
+ ('normal
+ (info "process is done executing")
+ (info "halting supervisor")
+ (halt!))
+
+ ('terminated
+ (info "had to terminate the process")
+ (info "halting supervisor")
+ (halt!))))
+
+ ;; the exception doesn't concern us, relay it to the
+ ;; process
+ (_
+ (! pid exception)
+ (loop failures))))
+
+ (lambda ()
+ (info "starting up supervised process")
+
+ ;; if an exception is signaled during the execution of
+ ;; init-hook, signal it to the process
+ (with-exception-catcher
+ (lambda (e) (! pid e))
+ (lambda () (init-hook pid)))
+
+ (let loop ()
+ (recv
+ ('shutdown (shutdown pid shutdown-delay))
+ (msg (! pid msg)))
+ (loop)))))))))
+
+
+(define (shutdown pid shutdown-delay)
+ (match shutdown-delay
+ (#f (terminate! pid))
+ (#t (! pid 'shutdown))
+ (n (where (number? n))
+ (! pid 'shutdown)
+ (recv
+ (after shutdown-delay
+ (terminate! pid)
+ (raise (list 'exit pid 'terminated)))))))
+
+
+(define (server-start-supervised plugin . args)
+ (spawn-supervised
+ (lambda ()
+ (server plugin))
+ init-hook: (lambda (pid)
+ (!? pid (cons 'init args) *server-timeout*))))
+
+;; (define p
+;; (spawn-supervised
+;; (lambda ()
+;; (let loop ()
+;; (recv
+;; ('crash (/ 1 0))
+;; ('shutdown (halt!))
+;; (msg
+;; (print (list msg: msg))
+;; (loop)))))
+;; ))
+;; (! p 'foo)
+;;
+;; (##repl)
415 termite/match-support.scm
@@ -0,0 +1,415 @@
+;; ----------------------------------------------------------------------------
+;; Erlang-style pattern matching for Scheme
+;;
+;; TODO
+;; - handle vectors (!)
+
+;; tree-based pattern matching optimization
+
+;; see match.scm
+
+;; utils
+
+;; ----------------------------------------------------------------------------
+;; Some basic utilities
+
+(define (filter pred? lst)
+ (cond
+ ((null? lst) '())
+
+ ((pred? (car lst))
+ (cons (car lst)
+ (filter pred? (cdr lst))))
+ (else
+ (filter pred? (cdr lst)))))
+
+(define (remove pred? lst)
+ (filter (lambda (x)
+ (not (pred? x)))
+ lst))
+
+(define (quoted-symbol? datum)
+ (and
+ (pair? datum)
+ (eq? (car datum) 'quote)
+ (pair? (cdr datum))
+ (symbol? (cadr datum))))
+
+(define (unquoted-symbol? datum)
+ (and
+ (pair? datum)
+ (eq? (car datum) 'unquote)
+ (pair? (cdr datum))
+ (symbol? (cadr datum))))
+
+;; Clause manipulation
+
+;; 2 possible clause expression:
+
+;; (match data
+;; (clause (where guard) . code)
+;; (clause . code))
+
+(define-record-type clause/rt
+ (make-clause pattern guard code)
+ clause?
+ (pattern clause-pattern)
+ (guard clause-guard)
+ (code clause-code))
+
+;; accumulate every part of the tree which satisfies PRED? and only go
+;; down the child satisfying GO-DOWN?
+(define (tree-filter pred? go-down? tree)
+ (cond
+ ((pred? tree)
+ (list tree))
+ ((and (pair? tree) (go-down? tree))
+ (append (tree-filter pred? go-down? (car tree))
+ (tree-filter pred? go-down? (cdr tree))))
+ (else '())))
+
+;; remove duplicates (bad name...)
+(define (delete-duplicates lst)
+ (cond
+ ((null? lst)
+ '())
+ ((member (car lst)
+ (cdr lst))
+ (delete-duplicates (cdr lst)))
+ (else
+ (cons (car lst)
+ (delete-duplicates (cdr lst))))))
+
+;; compile-pattern-match: generate the code for the pattern matching
+;;
+;; on-success: code to insert when a clause matches
+;; on-fail: code to execute when the whole pattern fail
+;; clause-list: list of all the pattern clauses
+;; args: the name of the variable holding the value we're matching
+;; against (bad name...)
+(define (compile-pattern-match on-success on-fail clause-list args)