twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

Compare commits

base: twc:main
Branches Tags
twc:main
twc:tg_protocol
twc:post_computer_class
twc:to_zig
twc:to_janet
twc:last_clj
twc:better_state
twc:test_harness
twc:test-exprs
twc:expr-repeat
twc:better_panics
twc:improve_prelude
twc:delete_structs
twc:with_docs
twc:base_and_prelude
twc:cljs
twc:improve_errors
twc:before_cljs
twc:refactor-parser
twc:clean-up-parser
twc:from-scratch
twc:0.1.0-alpha.8
twc:0.1.0-alpha.2
twc:0.1.0-alpha
..
compare: twc:clean-up-parser
Branches Tags
twc:main
twc:tg_protocol
twc:post_computer_class
twc:to_zig
twc:to_janet
twc:last_clj
twc:better_state
twc:test_harness
twc:test-exprs
twc:expr-repeat
twc:better_panics
twc:improve_prelude
twc:delete_structs
twc:with_docs
twc:base_and_prelude
twc:cljs
twc:improve_errors
twc:before_cljs
twc:refactor-parser
twc:clean-up-parser
twc:from-scratch
twc:0.1.0-alpha.8
twc:0.1.0-alpha.2
twc:0.1.0-alpha

No commits in common. "main" and "clean-up-parser" have entirely different histories.
main ... clean-up-p

55 changed files with 1637 additions and 75910 deletions
Show Stats Expand all files Collapse all files

29
.gitignore vendored
View File

@ -1,16 +1,14 @@
target/stale
target/js
target/classes
classes/
checkouts/
/target
/classes
/checkouts
profiles.clj
pom.xml
pom.xml.asc
*.jar
*.class
.lein-*
.nrepl-port
.prepl-port
/.lein-*
/.nrepl-port
/.prepl-port
.hgignore
.hg/
.clj-condo/
@ -19,18 +17,3 @@ pom.xml.asc
.clj-kondo/
.cpcache/
**/.DS_Store
sandbox
ludus.sublime-workspace
ludus
!src/ludus
out/
node_modules/
.shadow-cljs
.cljs_node_repl/
.helix/
target/repl-port
.repl-buffer
.repl-buffer.janet
.env
src/jpm_tree
.zig-cache

24
CHANGELOG.md Normal file
View File

@ -0,0 +1,24 @@
# Change Log
All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
## [Unreleased]
### Changed
- Add a new arity to `make-widget-async` to provide a different widget shape.
## [0.1.1] - 2021-10-23
### Changed
- Documentation on how to make the widgets.
### Removed
- `make-widget-sync` - we're all async, all the time.
### Fixed
- Fixed widget maker to keep working when daylight savings switches over.
## 0.1.0 - 2021-10-23
### Added
- Files from the new template.
- Widget maker public API - `make-widget-sync`.
[Unreleased]: https://sourcehost.site/your-name/cludus/compare/0.1.1...HEAD
[0.1.1]: https://sourcehost.site/your-name/cludus/compare/0.1.0...0.1.1

956
LICENSE
View File

@ -1,676 +1,280 @@
Ludus is copyrighted by Scott Richmond, (c) 2022, and distributed under the GNU GPL:
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, 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
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If 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 convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU 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
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state 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 program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program 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 General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<https://www.gnu.org/licenses/why-not-lgpl.html>.
Eclipse Public License - v 2.0
THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE
PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION
OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
1. DEFINITIONS
"Contribution" means:
a) in the case of the initial Contributor, the initial content
Distributed under this Agreement, and
b) in the case of each subsequent Contributor:
i) changes to the Program, and
ii) additions to the Program;
where such changes and/or additions to the Program originate from
and are Distributed by that particular Contributor. A Contribution
"originates" from a Contributor if it was added to the Program by
such Contributor itself or anyone acting on such Contributor's behalf.
Contributions do not include changes or additions to the Program that
are not Modified Works.
"Contributor" means any person or entity that Distributes the Program.
"Licensed Patents" mean patent claims licensable by a Contributor which
are necessarily infringed by the use or sale of its Contribution alone
or when combined with the Program.
"Program" means the Contributions Distributed in accordance with this
Agreement.
"Recipient" means anyone who receives the Program under this Agreement
or any Secondary License (as applicable), including Contributors.
"Derivative Works" shall mean any work, whether in Source Code or other
form, that is based on (or derived from) the Program and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship.
"Modified Works" shall mean any work in Source Code or other form that
results from an addition to, deletion from, or modification of the
contents of the Program, including, for purposes of clarity any new file
in Source Code form that contains any contents of the Program. Modified
Works shall not include works that contain only declarations,
interfaces, types, classes, structures, or files of the Program solely
in each case in order to link to, bind by name, or subclass the Program
or Modified Works thereof.
"Distribute" means the acts of a) distributing or b) making available
in any manner that enables the transfer of a copy.
"Source Code" means the form of a Program preferred for making
modifications, including but not limited to software source code,
documentation source, and configuration files.
"Secondary License" means either the GNU General Public License,
Version 2.0, or any later versions of that license, including any
exceptions or additional permissions as identified by the initial
Contributor.
2. GRANT OF RIGHTS
a) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free copyright
license to reproduce, prepare Derivative Works of, publicly display,
publicly perform, Distribute and sublicense the Contribution of such
Contributor, if any, and such Derivative Works.
b) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free patent
license under Licensed Patents to make, use, sell, offer to sell,
import and otherwise transfer the Contribution of such Contributor,
if any, in Source Code or other form. This patent license shall
apply to the combination of the Contribution and the Program if, at
the time the Contribution is added by the Contributor, such addition
of the Contribution causes such combination to be covered by the
Licensed Patents. The patent license shall not apply to any other
combinations which include the Contribution. No hardware per se is
licensed hereunder.
c) Recipient understands that although each Contributor grants the
licenses to its Contributions set forth herein, no assurances are
provided by any Contributor that the Program does not infringe the
patent or other intellectual property rights of any other entity.
Each Contributor disclaims any liability to Recipient for claims
brought by any other entity based on infringement of intellectual
property rights or otherwise. As a condition to exercising the
rights and licenses granted hereunder, each Recipient hereby
assumes sole responsibility to secure any other intellectual
property rights needed, if any. For example, if a third party
patent license is required to allow Recipient to Distribute the
Program, it is Recipient's responsibility to acquire that license
before distributing the Program.
d) Each Contributor represents that to its knowledge it has
sufficient copyright rights in its Contribution, if any, to grant
the copyright license set forth in this Agreement.
e) Notwithstanding the terms of any Secondary License, no
Contributor makes additional grants to any Recipient (other than
those set forth in this Agreement) as a result of such Recipient's
receipt of the Program under the terms of a Secondary License
(if permitted under the terms of Section 3).
3. REQUIREMENTS
3.1 If a Contributor Distributes the Program in any form, then:
a) the Program must also be made available as Source Code, in
accordance with section 3.2, and the Contributor must accompany
the Program with a statement that the Source Code for the Program
is available under this Agreement, and informs Recipients how to
obtain it in a reasonable manner on or through a medium customarily
used for software exchange; and
b) the Contributor may Distribute the Program under a license
different than this Agreement, provided that such license:
i) effectively disclaims on behalf of all other Contributors all
warranties and conditions, express and implied, including
warranties or conditions of title and non-infringement, and
implied warranties or conditions of merchantability and fitness
for a particular purpose;
ii) effectively excludes on behalf of all other Contributors all
liability for damages, including direct, indirect, special,
incidental and consequential damages, such as lost profits;
iii) does not attempt to limit or alter the recipients' rights
in the Source Code under section 3.2; and
iv) requires any subsequent distribution of the Program by any
party to be under a license that satisfies the requirements
of this section 3.
3.2 When the Program is Distributed as Source Code:
a) it must be made available under this Agreement, or if the
Program (i) is combined with other material in a separate file or
files made available under a Secondary License, and (ii) the initial
Contributor attached to the Source Code the notice described in
Exhibit A of this Agreement, then the Program may be made available
under the terms of such Secondary Licenses, and
b) a copy of this Agreement must be included with each copy of
the Program.
3.3 Contributors may not remove or alter any copyright, patent,
trademark, attribution notices, disclaimers of warranty, or limitations
of liability ("notices") contained within the Program from any copy of
the Program which they Distribute, provided that Contributors may add
their own appropriate notices.
4. COMMERCIAL DISTRIBUTION
Commercial distributors of software may accept certain responsibilities
with respect to end users, business partners and the like. While this
license is intended to facilitate the commercial use of the Program,
the Contributor who includes the Program in a commercial product
offering should do so in a manner which does not create potential
liability for other Contributors. Therefore, if a Contributor includes
the Program in a commercial product offering, such Contributor
("Commercial Contributor") hereby agrees to defend and indemnify every
other Contributor ("Indemnified Contributor") against any losses,
damages and costs (collectively "Losses") arising from claims, lawsuits
and other legal actions brought by a third party against the Indemnified
Contributor to the extent caused by the acts or omissions of such
Commercial Contributor in connection with its distribution of the Program
in a commercial product offering. The obligations in this section do not
apply to any claims or Losses relating to any actual or alleged
intellectual property infringement. In order to qualify, an Indemnified
Contributor must: a) promptly notify the Commercial Contributor in
writing of such claim, and b) allow the Commercial Contributor to control,
and cooperate with the Commercial Contributor in, the defense and any
related settlement negotiations. The Indemnified Contributor may
participate in any such claim at its own expense.
For example, a Contributor might include the Program in a commercial
product offering, Product X. That Contributor is then a Commercial
Contributor. If that Commercial Contributor then makes performance
claims, or offers warranties related to Product X, those performance
claims and warranties are such Commercial Contributor's responsibility
alone. Under this section, the Commercial Contributor would have to
defend claims against the other Contributors related to those performance
claims and warranties, and if a court requires any other Contributor to
pay any damages as a result, the Commercial Contributor must pay
those damages.
5. NO WARRANTY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT
PERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED 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. Each Recipient is solely responsible for determining the
appropriateness of using and distributing the Program and assumes all
risks associated with its exercise of rights under this Agreement,
including but not limited to the risks and costs of program errors,
compliance with applicable laws, damage to or loss of data, programs
or equipment, and unavailability or interruption of operations.
6. DISCLAIMER OF LIABILITY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT
PERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS
SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST
PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE
EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
7. GENERAL
If any provision of this Agreement is invalid or unenforceable under
applicable law, it shall not affect the validity or enforceability of
the remainder of the terms of this Agreement, and without further
action by the parties hereto, such provision shall be reformed to the
minimum extent necessary to make such provision valid and enforceable.
If Recipient institutes patent litigation against any entity
(including a cross-claim or counterclaim in a lawsuit) alleging that the
Program itself (excluding combinations of the Program with other software
or hardware) infringes such Recipient's patent(s), then such Recipient's
rights granted under Section 2(b) shall terminate as of the date such
litigation is filed.
All Recipient's rights under this Agreement shall terminate if it
fails to comply with any of the material terms or conditions of this
Agreement and does not cure such failure in a reasonable period of
time after becoming aware of such noncompliance. If all Recipient's
rights under this Agreement terminate, Recipient agrees to cease use
and distribution of the Program as soon as reasonably practicable.
However, Recipient's obligations under this Agreement and any licenses
granted by Recipient relating to the Program shall continue and survive.
Everyone is permitted to copy and distribute copies of this Agreement,
but in order to avoid inconsistency the Agreement is copyrighted and
may only be modified in the following manner. The Agreement Steward
reserves the right to publish new versions (including revisions) of
this Agreement from time to time. No one other than the Agreement
Steward has the right to modify this Agreement. The Eclipse Foundation
is the initial Agreement Steward. The Eclipse Foundation may assign the
responsibility to serve as the Agreement Steward to a suitable separate
entity. Each new version of the Agreement will be given a distinguishing
version number. The Program (including Contributions) may always be
Distributed subject to the version of the Agreement under which it was
received. In addition, after a new version of the Agreement is published,
Contributor may elect to Distribute the Program (including its
Contributions) under the new version.
Except as expressly stated in Sections 2(a) and 2(b) above, Recipient
receives no rights or licenses to the intellectual property of any
Contributor under this Agreement, whether expressly, by implication,
estoppel or otherwise. All rights in the Program not expressly granted
under this Agreement are reserved. Nothing in this Agreement is intended
to be enforceable by any entity that is not a Contributor or Recipient.
No third-party beneficiary rights are created under this Agreement.
Exhibit A - Form of Secondary Licenses Notice
"This Source Code may also be made available under the following
Secondary Licenses when the conditions for such availability set forth
in the Eclipse Public License, v. 2.0 are satisfied: GNU General Public
License as published by the Free Software Foundation, either version 2
of the License, or (at your option) any later version, with the GNU
Classpath Exception which is available at
https://www.gnu.org/software/classpath/license.html."
Simply including a copy of this Agreement, including this Exhibit A
is not sufficient to license the Source Code under Secondary Licenses.
If it is not possible or desirable to put the notice in a particular
file, then You may include the notice in a location (such as a LICENSE
file in a relevant directory) where a recipient would be likely to
look for such a notice.
You may add additional accurate notices of copyright ownership.

101
README.md
View File

@ -1,93 +1,22 @@
![Ludus logo](logo.png)
## Ludus: A friendly, dynamic, functional language
Ludus is a scripting programming language that is designed to be friendly, dynamic, and functional.
# cludus
This repo currently contains a work-in-progress implementation of an interpreter for the Ludus programming language, using [Janet](https://janet-lang.org) as a host language.
Ludus is part of the [_Thinking with Computers_ project](https://alea.ludus.dev/twc/), run by Scott Richmond at the University of Toronto, with collaborator Matt Nish-Lapidus; Bree Lohman and Mynt Marsellus are the RAs for the project. Ludus is our research language, which aspires to be a free translation of Logo for the 2020s.
A Clojure library designed to ... well, that part is up to you.
Here are our design goals:
## Usage
#### Friendly
Ludus, like Logo, is meant to be a teaching language, often for students who don't think of themselves as "computer people." Our intended audience are humanities and art people at the university level (undergrads, grads, faculty). Everything is kept as simple as possible, but no simpler. Everything is consistent as possible. We aspire to the best error messages we can muster, which is important for a language to be teachable. That means being as strict as we can muster, _in order to be friendlier_.
FIXME
Our current development target is Ludus on the web: https://web.ludus.dev. That wires what we do on the langauge interpreter (here in this repo) to a web frontend.
## License
Naturally, it starts with Logo's famed turtle graphics.
Copyright © 2021 FIXME
#### Dynamic
Statically typed programming languages generally give more helpful error messages than dynamic ones, but learning a type system (even one with robust type inference) requires learning two parallel systems: the type system and the expression system (well, and the pattern system). Type systems only really make sense once you've learned why they're necessary. And their benefits seem (to us, anyway) to be largely necessary when writing long-lived, maintainable, multi-author code. Ludus code is likely to be one-off, expressive, and single-authored.
This program and the accompanying materials are made available under the
terms of the Eclipse Public License 2.0 which is available at
http://www.eclipse.org/legal/epl-2.0.
To stay friendly, Ludus is dynamic. But: despite the dynamism, we aim to be as strict as possible. Certainly, we want to avoid the type conversion shenanigans of a language like JavaScript.
#### Functional
Ludus is emphatically functional: it uses functions for just about everything. This is both because your humble PI had his world reordered when he learned his first functional language (Elixir), and because the research into Logo and the programming cultures of MIT in the 1970s revolve around extremely functional Lisp code (i.e., Scheme). Logo is a weird little language, but it is a descendant of Lisp. So is Ludus.
Also, we believe that Ludus's immutable bindings and persistent or immutable data structures and careful approach to manipulating state lead to a lot of good pedagogical results. Learning a programming language involves learning how to model what's going on inside the computer; Ludus, we think, makes that both simpler and easier.
If you're looking for cognate languages, Ludus takes a _lot_ of design inspiration from Clojure and Elixir (which itself took a lot from Clojure). (The current--quick, dirty, and slow--version of Ludus is written in [Janet](https://janet-lang.org).) Clojure and Elixir are great! If you're asking why you should use Ludus instead of them, you're already at the point where you should be using them. Ludus is, maybe, for the people whom you'd like to work with in 5 years at your Pheonix shop (but even then, probably not).
### Status
Pre-alpha, still under active development. Lots of things change all the time.
The current version of Ludus is a pure function that runs in JavaScript as a WASM blob. We have plans for more and better things.
### Use
Current emphasis is on the web version: https://web.ludus.dev.
### Main features
* Expression-oriented: everything returns a value
* Pattern matching in all the places
* No operators: everything is called as a function
* Easy-peasy partial application with placeholders
* Function pipelines
* Persistent or immutable data structures
* Careful, explicit state management using `box`es
* Clean, concise, expressive syntax
* Value-based equality; only functions are reference types
#### Under construction
* Actor-model style concurrency.
* Faster, bytecode-based VM written in a systems language, for better performance.
* Performant persistent, immutable data structures, à la Clojure.
### `Hello, world!`
Ludus is a scripting language. At current it does not have a good REPL. Our aim is to get interactive coding absolutely correct, and our efforts in [ludus-web](https://github.com/thinking-with-computers/ludus-web) are currently under way to surface the right interactivity models for Ludus.
Either:
```
"Hello, world!"
```
`=> "Hello, world!"`
Ludus scripts (and blocks) simply return their last expression; this script returns the bare string and exits.
Or:
```
print! ("Hello, world!")
```
```
=> Hello, world!
=> :ok
```
Here, we use the `print!` function, which sends a string to a console (`stdout` on Unix, or a little console box on the web). Because `print!` returns the keyword `:ok` when it completes, that is the result of the last expression in the script--and so Ludus also prints this.
### Some code
Fibonacci numbers:
```
& fibonacci!, with multi-clause fns/pattern matching
fn fib {
"Returns the nth fibonacci number."
(1) -> 1
(2) -> 1
(n) -> add (
fib (sub (n, 1))
fib (sub (n, 2)))
}
fib (10) &=> 55
```
### More on Ludus
See the [language reference](language.md) and [the documentation for the prelude](prelude.md).
This Source Code may also be made available under the following Secondary
Licenses when the conditions for such availability set forth in the Eclipse
Public License, v. 2.0 are satisfied: GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or (at your
option) any later version, with the GNU Classpath Exception which is available
at https://www.gnu.org/software/classpath/license.html.

130
build/driver.cpp
View File

@ -1,130 +0,0 @@
#include <cstdint>
#include <emscripten.h>
#include <emscripten/bind.h>
#include <string>
#include <stdio.h>
#include "janet.h"
using std::string;
// set all our exported Janet functions as null pointers
static JanetFunction *janet_ludus = NULL;
// these let us look up functions
Janet env_lookup(JanetTable *env, const char *name) {
Janet out;
janet_resolve(env, janet_csymbol(name), &out);
return out;
}
JanetFunction *env_lookup_function(JanetTable *env, const char *name) {
Janet value = env_lookup(env, name);
if (!janet_checktype(value, JANET_FUNCTION)) {
janet_panicf("expected %s to be a function, got %q\n", name, value);
}
return janet_unwrap_function(value);
}
// this lets us call a function
bool call_fn(JanetFunction *fn, int argc, const Janet *argv, Janet *out) {
JanetFiber *fiber = NULL;
if (janet_pcall(fn, argc, argv, out, &fiber) == JANET_SIGNAL_OK) {
return true;
} else {
janet_stacktrace(fiber, *out);
return false;
}
}
// this is darkish magic, reads an embedded file
// do not fuck with this, fellas
unsigned char *read_file(const char *filename, size_t *length) {
size_t capacity = 2 << 17;
unsigned char *src = (unsigned char *)malloc(capacity * sizeof(unsigned char));
assert(src);
size_t total_bytes_read = 0;
FILE *file = fopen(filename, "r");
assert(file);
size_t bytes_read;
do {
size_t remaining_capacity = capacity - total_bytes_read;
if (remaining_capacity == 0) {
capacity <<= 1;
src = (unsigned char*)realloc(src, capacity * sizeof(unsigned char));
assert(src);
remaining_capacity = capacity - total_bytes_read;
}
bytes_read = fread(&src[total_bytes_read], sizeof(unsigned char), remaining_capacity, file);
total_bytes_read += bytes_read;
} while (bytes_read > 0);
fclose(file);
*length = total_bytes_read;
return src;
}
// finally, getting a string back
// this is our result type
struct StringResult {
string value;
};
// this is our result constructor
// Janet's getcstring resturns const char*
StringResult string_result(const char* cstr) {
// ...which we have to cast to a std::string
return (StringResult) {.value = (string) cstr };
}
// and this is a function that takes and returns a string
// it returns a StringResult, tho
StringResult ludus(string source) {
Janet result;
const Janet args[1] = {janet_cstringv(source.c_str())};
call_fn(janet_ludus, 1, args, &result);
// get the cstring in the result
// the 0 passed here is the index in the result of the string
const char* cstr = janet_getcstring(&result, 0);
// return a constructed StringResult
return string_result(cstr);
}
// This function sets up our Janet interpreter, and fixes the null pointers
EMSCRIPTEN_KEEPALIVE
int main() {
janet_init(); // start the interpreter
JanetTable *core_env = janet_core_env(NULL); // get a core env
JanetTable *lookup = janet_env_lookup(core_env); // and get an env table
// load the janet image into memory
// note that the image is hardcoded here
size_t image_length;
unsigned char *image = read_file("ludus.jimage", &image_length);
// load the image into the Janet environment
Janet env = janet_unmarshal(image, image_length, 0, lookup, NULL);
if(!janet_checktype(env, JANET_TABLE)) {
janet_panicf("invalid image %q", env);
}
// fix the null pointers, as above
// note that the bound symbols are just the normal fn names
// no namespacing
janet_ludus = env_lookup_function(janet_unwrap_table(env), "ludus");
janet_gcroot(janet_wrap_function(janet_ludus));
}
// these bindings are exported into javascript
EMSCRIPTEN_BINDINGS(module) {
using namespace emscripten;
// these are the functions that will be available
function("ludus", &ludus, allow_raw_pointers());
// we also want a wrapper for our StringResult
// we won't access it directly, but emcc makes it nice
value_object<StringResult>("StringResult")
.field("value", &StringResult::value);
}

51563
build/janet.c
View File

File diff suppressed because it is too large Load Diff

2277
build/janet.h
View File

File diff suppressed because it is too large Load Diff

13
build/justfile
View File

@ -1,13 +0,0 @@
build:
# the complex emscripten invocation
# note we have the stack size set to 1024*1024 (1 MB)
emcc \
-o out.mjs \
janet.c driver.cpp \
--embed-file ludus.jimage \
-lembind \
-s "EXPORTED_FUNCTIONS=['_main']" \
-s EXPORT_ES6 \
-s ALLOW_MEMORY_GROWTH=1 \
-s STACK_SIZE=1048576 \
-s MODULARIZE

BIN
build/ludus.jimage
View File

Binary file not shown.

370
build/ludus.mjs
View File

@ -1,370 +0,0 @@
import init from "./out.mjs"
const mod = await init()
let res = null
let code = null
export function run (source) {
code = source
const output = mod.ludus(source).value
res = JSON.parse(output)
return res
}
export function stdout () {
if (!res) return ""
return res.io.stdout.data
}
export function turtle_commands () {
if (!res) return []
return res.io.turtle.data
}
export function result () {
return res
}
const turtle_init = {
position: [0, 0],
heading: 0,
pendown: true,
pencolor: "white",
penwidth: 1,
visible: true
}
const colors = {
black: [0, 0, 0, 255],
silver: [192, 192, 192, 255],
gray: [128, 128, 128, 255],
white: [255, 255, 255, 255],
maroon: [128, 0, 0, 255],
red: [255, 0, 0, 255],
purple: [128, 0, 128, 255],
fuchsia: [255, 0, 255, 255],
green: [0, 128, 0, 255],
lime: [0, 255, 0, 255],
olive: [128, 128, 0, 255],
yellow: [255, 255, 0, 255],
navy: [0, 0, 128, 255],
blue: [0, 0, 255, 255],
teal: [0, 128, 128, 255],
aqua: [0, 255, 25, 255],
}
function resolve_color (color) {
if (typeof color === 'string') return colors[color]
if (typeof color === 'number') return [color, color, color, 255]
if (Array.isArray(color)) return color
return [0, 0, 0, 255] // default to black?
}
let background_color = "black"
function add (v1, v2) {
const [x1, y1] = v1
const [x2, y2] = v2
return [x1 + x2, y1 + y2]
}
function mult (vector, scalar) {
const [x, y] = vector
return [x * scalar, y * scalar]
}
function unit_of (heading) {
const turns = -heading + 0.25
const radians = turn_to_rad(turns)
return [Math.cos(radians), Math.sin(radians)]
}
function command_to_state (prev_state, curr_command) {
const verb = curr_command[0]
switch (verb) {
case "goto": {
const [_, x, y] = curr_command
return {...prev_state, position: [x, y]}
}
case "home": {
return {...prev_state, position: [0, 0], heading: 0}
}
case "right": {
const [_, angle] = curr_command
const {heading} = prev_state
return {...prev_state, heading: heading + angle}
}
case "left": {
const [_, angle] = curr_command
const {heading} = prev_state
return {...prev_state, heading: heading - angle}
}
case "forward": {
const [_, steps] = curr_command
const {heading, position} = prev_state
const unit = unit_of(heading)
const move = mult(unit, steps)
return {...prev_state, position: add(position, move)}
}
case "back": {
const [_, steps] = curr_command
const {heading, position} = prev_state
const unit = unit_of(heading)
const move = mult(unit, -steps)
return {...prev_state, position: add(position, move)}
}
case "penup": {
return {...prev_state, pendown: false}
}
case "pendown": {
return {...prev_state, pendown: true}
}
case "penwidth": {
const [_, width] = curr_command
return {...prev_state, penwidth: width}
}
case "pencolor": {
const [_, color] = curr_command
return {...prev_state, pencolor: color}
}
case "setheading": {
const [_, heading] = curr_command
return {...prev_state, heading: heading}
}
case "loadstate": {
// console.log("LOADSTATE: ", curr_command)
const [_, [x, y], heading, visible, pendown, penwidth, pencolor] = curr_command
return {position: [x, y], heading, visible, pendown, penwidth, pencolor}
}
case "show": {
return {...prev_state, visible: true}
}
case "hide": {
return {...prev_state, visible: false}
}
case "background": {
background_color = curr_command[1]
return prev_state
}
}
}
function eq_vect (v1, v2) {
const [x1, y1] = v1
const [x2, y2] = v2
return (x1 === x2) && (y1 === y2)
}
function eq_color (c1, c2) {
if (c1 === c2) return true
const res1 = resolve_color(c1)
const res2 = resolve_color(c2)
for (let i = 0; i < res1.length; ++i) {
if (res1[i] !== res2[i]) return false
}
return true
}
function states_to_call (prev, curr) {
const calls = []
// whose state should we use?
// pen states will only differ on more than one property
// if we use `loadstate`
// my sense is `prev`, but that may change
if (prev.pendown && !eq_vect(prev.position, curr.position)) {
calls.push(["line", prev.position[0], prev.position[1], curr.position[0], curr.position[1]])
}
if (!eq_color(curr.pencolor, prev.pencolor)) {
calls.push(["stroke", ...resolve_color(curr.pencolor)])
}
if (curr.penwidth !== prev.penwidth) {
calls.push(["strokeWeight", curr.penwidth])
}
return calls
}
const turtle_radius = 20
const turtle_angle = 0.385
const turtle_color = [255, 255, 255, 150]
const p5_call_root = [
["background", ...resolve_color(background_color)],
["push"],
["rotate", Math.PI],
["scale", -1, 1],
["stroke", ...resolve_color(turtle_init.pencolor)],
]
function rotate (vector, heading) {
const radians = turn_to_rad(heading)
const [x, y] = vector
return [
(x * Math.cos (radians)) - (y * Math.sin (radians)),
(x * Math.sin (radians)) + (y * Math.cos (radians))
]
}
function turn_to_rad (heading) {
return (heading % 1) * 2 * Math.PI
}
function turn_to_deg (heading) {
return (heading % 1) * 360
}
function svg_render_line (prev, curr) {
if (!prev.pendown) return ""
if (eq_vect(prev.position, curr.position)) return ""
const {position: [x1, y1], pencolor, penwidth} = prev
const {position: [x2, y2]} = curr
const [r, g, b, a] = resolve_color(pencolor)
return `
<line x1="${x1}" y1="${y1}" x2="${x2}" y2="${y2}" stroke="rgb(${r} ${g} ${b})" stroke-opacity="${a/255}" stroke-width="${penwidth}"/>
`
}
function escape_svg (svg) {
return svg
.replace(/&/g, "&amp;")
.replace(/</g, "&lt;")
.replace(/>/g, "&gt;")
.replace(/"/g, "&quot;")
.replace(/'/g, "&apos;")
}
export function extract_ludus (svg) {
const code = svg.split("<ludus>")[1]?.split("</ludus>")[0] ?? ""
return code
.replace(/&amp;/g, "&")
.replace(/&lt;/g, "<")
.replace(/&gt;/g, ">")
.replace(/&quot;/g, `"`)
.replace(/&apos;/g, `'`)
}
function svg_render_path (states) {
const path = []
for (let i = 1; i < states.length; ++i) {
const prev = states[i - 1]
const curr = states[i]
path.push(svg_render_line(prev, curr))
}
return path.join("")
}
function svg_render_turtle (state) {
if (!state.visible) return ""
const [fr, fg, fb, fa] = turtle_color
const fill_alpha = fa/255
const {heading, pencolor, position: [x, y], pendown, penwidth} = state
const origin = [0, turtle_radius]
const [x1, y1] = origin
const [x2, y2] = rotate(origin, turtle_angle)
const [x3, y3] = rotate(origin, -turtle_angle)
const [pr, pg, pb, pa] = resolve_color(pencolor)
const pen_alpha = pa/255
const ink = pendown ? `<line x1="${x1}" y1="${y1}" x2="0" y2="0" stroke="rgb(${pr} ${pg} ${pb})" stroke-opacity="${pen_alpha}" stroke-width="${penwidth}" />` : ""
return `
<g transform="translate(${x}, ${y})rotate(${-turn_to_deg(heading)})">
<polygon points="${x1} ${y1} ${x2} ${y2} ${x3} ${y3}" stroke="none" fill="rgb(${fr} ${fg} ${fb})" fill-opacity="${fill_alpha}"/>
${ink}
</g>
`
}
export function svg (commands) {
// console.log(commands)
const states = [turtle_init]
commands.reduce((prev_state, command) => {
const new_state = command_to_state(prev_state, command)
states.push(new_state)
return new_state
}, turtle_init)
// console.log(states)
const {maxX, maxY, minX, minY} = states.reduce((accum, {position: [x, y]}) => {
accum.maxX = Math.max(accum.maxX, x)
accum.maxY = Math.max(accum.maxY, y)
accum.minX = Math.min(accum.minX, x)
accum.minY = Math.min(accum.minY, y)
return accum
}, {maxX: 0, maxY: 0, minX: 0, minY: 0})
const [r, g, b, a] = resolve_color(background_color)
const view_width = (maxX - minX) * 1.2
const view_height = (maxY - minY) * 1.2
const margin = Math.max(view_width, view_height) * 0.1
const x1 = minX - margin
// don't actually need these:
// const y1 = minY - margin
// const x2 = maxX + margin
const y2 = maxY + margin
const path = svg_render_path(states)
const turtle = svg_render_turtle(states[states.length - 1])
return `<?xml version="1.0" standalone="no"?>
<svg version="1.1" xmlns="http://www.w3.org/2000/svg" style="background-color:rgb(${r} ${g} ${b}); background-opacity: ${a/255}" viewBox="${x1} ${-y2} ${view_width} ${view_height}">
<g transform="scale(-1, 1) rotate(180)">
${path}
${turtle}
</g>
<ludus>
${escape_svg(code)}
</ludus>
</svg>
`
}
function p5_render_turtle (state, calls) {
if (!state.visible) return
calls.push(["push"])
const [r, g, b, a] = turtle_color
calls.push(["fill", r, g, b, a])
const {heading, pencolor, position: [x, y], pendown, penwidth} = state
const origin = [0, turtle_radius]
const [x1, y1] = origin
const [x2, y2] = rotate(origin, turtle_angle)
const [x3, y3] = rotate(origin, -turtle_angle)
calls.push(["translate", x, y])
// need negative turtle rotation with the other p5 translations
calls.push(["rotate", -turn_to_rad(heading)])
calls.push(["noStroke"])
calls.push(["beginShape"])
calls.push(["vertex", x1, y1])
calls.push(["vertex", x2, y2])
calls.push(["vertex", x3, y3])
calls.push(["endShape"])
calls.push(["strokeWeight", penwidth])
calls.push(["stroke", ...resolve_color(pencolor)])
if (pendown) calls.push(["line", 0, 0, x1, y1])
calls.push(["pop"])
return calls
}
export function p5 (commands) {
const states = [turtle_init]
commands.reduce((prev_state, command) => {
const new_state = command_to_state(prev_state, command)
states.push(new_state)
return new_state
}, turtle_init)
// console.log(states)
const p5_calls = [...p5_call_root]
for (let i = 1; i < states.length; ++i) {
const prev = states[i - 1]
const curr = states[i]
const calls = states_to_call(prev, curr)
for (const call of calls) {
p5_calls.push(call)
}
}
p5_calls[0] = ["background", ...resolve_color(background_color)]
p5_render_turtle(states[states.length - 1], p5_calls)
p5_calls.push(["pop"])
return p5_calls
}

7170
build/out.mjs
View File

File diff suppressed because it is too large Load Diff

BIN
build/out.wasm
View File

Binary file not shown.

13
build/p5_test.mjs
View File

@ -1,13 +0,0 @@
import {run, p5} from "./ludus.mjs"
const code = `
print! ("Hello, world!")
pencolor! (colors :white)
fd! (50)
pw! (3)
`
const result = run(code)
console.log(result.io.stdout.data)
console.log(p5(result.io.turtle.data))

22
build/svg_test.mjs
View File

@ -1,22 +0,0 @@
import {run, svg, stdout} from "./ludus.mjs"
const code = `
let start = unbox (turtle_state)
fd! (100)
rt! (0.25)
fd! (100)
loadstate! (start)
& home! ()
rt! (0.25)
fd! (100)
lt! (0.25)
`
const result = run(code)
// console.log(stdout(result))
console.log(svg(result.io.turtle.data))

37
build/svg_test.svg
View File

@ -1,37 +0,0 @@
<?xml version="1.0" standalone="no"?>
<svg version="1.1" xmlns="http://www.w3.org/2000/svg" style="background-color:rgb(0 0 0); background-opacity: 1" viewBox="-12 -112 120 120">
<g transform="scale(-1, 1) rotate(180)">
<line x1="0" y1="0" x2="6.123233995736766e-15" y2="100" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1"/>
<line x1="6.123233995736766e-15" y1="100" x2="0" y2="0" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1"/>
<line x1="0" y1="0" x2="100" y2="0" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1"/>
<g transform="translate(100, 0)rotate(90)">
<polygon points="0 20 -13.226237306473037 -15.00222139260919 13.226237306473037 -15.00222139260919" stroke="none" fill="rgb(255 255 255)" fill-opacity="0.5882352941176471"/>
<line x1="0" y1="20" x2="0" y2="0" stroke="rgb(255 255 255)" stroke-opacity="1" stroke-width="1" />
</g>
</g>
<ludus>
let home = unbox (turtle_state)
fd! (100)
loadstate! (home)
rt! (0.25)
fd! (100)
do turtle_state &gt; unbox
</ludus>
</svg>
Side by Side

Before

Width:  |  Height:  |  Size: 1.1 KiB

9
build/test.mjs
View File

@ -1,9 +0,0 @@
import {run} from "./ludus.mjs"
console.log(run(`
forward! (100)
right! (0.25)
print! ("foobar")
`))

7
deps.edn Normal file
View File

@ -0,0 +1,7 @@
{
:dependencies [nrepl "0.9.0"]
:aliases {:nREPL
{:extra-deps
{nrepl/nrepl {:mvn/version "0.9.0"}}}}
}

3
doc/intro.md Normal file
View File

@ -0,0 +1,3 @@
# Introduction to cludus
TODO: write [great documentation](http://jacobian.org/writing/what-to-write/)

31
justfile
View File

@ -1,31 +0,0 @@
# open a janet repl in a different os window
repl:
kitten @ launch --type=os-window --allow-remote-control --cwd=current --title=hx_repl:ludus --keep-focus
kitten @ send-text -m "title:hx_repl:ludus" "janet -s\n"
# restart the repl server
restart:
kitten @ send-text -m "title:hx_repl:ludus" "\04"
kitten @ send-text -m "title:hx_repl:ludus" "janet -s\n"
# send what's selected to the repl and evaluate it
eval:
sd "$" "\n" | sd "\n\n" "\n" | kitten @ send-text -m "title:hx_repl:ludus" --stdin
# get documentation for a symbol in janet/clojure
doc:
sd "$" "\n" | sd "\n\n" "\n" | xargs -I _ echo "(doc " _ ")" | kitten @ send-text -m "title:hx_repl:ludus" --stdin
# publish to npm (did you build things first?)
publish:
npm version patch
npm publish
# build the ludus jimage
build:
rm -f build/out.mjs
rm -f build/out.wasm
rm -f build/ludus.jimage
janet -c src/ludus.janet build/ludus.jimage
cd build && just build
git commit -am "build"

513
language.md
View File

@ -1,513 +0,0 @@
# Ludus language reference
This is not intended for beginners, but to be a language overview for experienced programmers. That said, it may help beginners orient themselves in the language.
## Comments
Ludus's comment character is `&`. Anything after an ampersand on a line is ignored. There are no multiline comments.
## Atomic values
Ludus has four types of atomic values.
### `nil`
`nil` is Ludus's representation of nothing. In the grand Lisp tradition, Ludus can, and occasionally does, use `nil`-punning. Its type is `:nil`.
### Booleans
`true` and `false`. That said, in all conditional constructs, `nil` and `false` are "falsy," and everything else is "truthy." Their type is `:boolean`.
### Numbers
Ludus has numbers, which are IEEE-754 64-bit floats. Numbers are more complicated than you think, probably.
Number literals in Ludus are either integers or decimal floating point numbers, e.g. `32.34`, `42`, `-0.23`. Underscores in numbers are ignored, and can be used to separate long numbers, e.g. `1_234_567_890`.
Numbers' type is `:number`.
### Keywords
Ludus keywords begin with a colon and a letter, e.g. `:keyword`. Types are represented as keywords. Some functions take an optional units argument as a keyword, e.g. `:radians`. Keywords are also used as keys for associative collections. Keywords' type is `:keyword`.
Keywords must begin with an ASCII upper- or lower-case letter, and can then include any letter character, as well as `_`, `/`, `!`, `?`, and `*`.
## Strings
Ludus strings are UTF-8 strings, and only use double quotes. Strings may be multiline. For example, this is a string: `"foo"`. So is this:
```
"foo
bar baz"
```
Strings use backslashes for escapes, including `\n` for newline, `\t` for tab, `\"` for a double quote, and `\{` for an open curly brace (see below on interpolation).
Strings' type is `:string`.
### String interpolation
Strings may also insert a string representation of any Ludus value that is bound to a name, by inserting that name in curly braces. To wit,
```
let foo = :foo
let bar = 42
let baz = [1, 2, 3]
"{foo} {bar} {baz}" &=> ":foo 42 1, 2, 3"
```
Interpolations may _not_ be arbitrary expressions: only bound names may be used in interpolations.
## Collections
Ludus has a few different types of collections, in increasing order of complexity: tuples, lists, sets, dicts, and packages. All collections are immutable.
#### Separators
In all collection literals, members are written with a separator between them. On the same line, use a comma; or a newline will also separate elements. You may use as many separators as you wish at any point inside a collection or pattern. `(,,,,,,,3,,4,,,,,,)` and `(3, 4)` are the same value.
#### Efficiency
At the current moment, Ludus collections are all copy-on-write; this means that Ludus is _not_ performant with large collections. Eventually, Ludus will have Clojure-style persistent, immutable collections.
### Tuples
Tuples are fully-immutable, ordered collections of any kinds of values, delimited by parentheses, e.g. `(1, :a, "foo")`. At current, they have no length limit (although they eventually will). Unlike in some languages, tuples can be empty or contain a single element: `()` and `(:foo)` are both just fine. Tuples largely cannot be manipulated functionally; they must be written as literals and unpacked using pattern matching. They can, however, be converted to lists, either through pattern matching or the `list` function. Their type is `:tuple`.
### Lists
Lists are persistent and immutable ordered collections of any kinds of values, delimited by square braces, e.g. `[1, :a, "foo"]`. Their type is `:list`.
Lists may be combined using splats, written with ellipses, e.g., `[...foo, ...bar]`.
### Sets
Sets are persistent and immutable unordered collections of any kinds of values, which can only contain one instance of any given value. They are written similarly to ordered collections: `${1, :a, "foo"}`. Their type is `:set`.
### Dictionaries, or dicts
Dicts are persistent and immutable associative collections of any kinds of values. Dicts use keywords as keys (and cannot use any other kind of Ludus value as a key, not even strings), but can store any values. Dict literals are written as keyword-value pairs: `#{:a 1, :b false}`. Single words may be used as a shorthand for a key-value pair. Accessing a key that holds no value returns `nil`. Their type is `:dict`.
### Packages
Packages are immutable collections of bindings. They may only be described at the top level of a script, and their names must begin with a capital letter. Accessing a key that has no value on a package results in a validation error. They may not be accessed using functions, but only direct keyword access. Their type is `:pkg`.
They are written with the form `pkg`, then a package name, beginning with a capital letter, that will be bound as their name, and then an associative structure (pairs or word shorthands), delimited by `{}`, e.g.:
```
pkg Foo {
:bar "bar"
:baz 42
quux
}
```
### Working with collections
Ludus names are bound permanently and immutably. Collections are immutable. How do you add something to a list or a dict? How do you get things out of them?
Ludus provides functions that allow working with persistent collections. They're detailed in [the Prelude](prelude.md). That said, all functions that modify collections take a collection and produce the modified collection _as a return value_, without changing the original collection. E.g., `append ([1, 2, 3], 4)` will produce `[1, 2, 3, 4]`, but the original list is unchanged. (For dicts, the equivalent is `assoc`.)
## Expressions
Ludus is an expression-based language: all forms in the language are expressions and return values, except `panic!`. That said, not all expressions may be used everywhere.
### Terminating expressions
Expressions in scripts and blocks are terminated by a newline or a semicolon. In compound forms, like, `if`, the terminator comes after the `else` expression.
In forms with multiple clauses surrounded by curly braces (i.e., function bodies, `match`, `when`, etc.), you may separate clauses with semicolons as well as newlines.
### Toplevel expressions
Some expressions may only be used in the "top level" of a script. Because they are the toplevel, they are assured to be statically knowable. These include: `pkg`, `ns`, `use`, `import`, and `test`. (NB: not all of these are yet implemented.)
### Non-binding expressions
Some forms may take any expression that does _not_ [bind a name](#words-and-bindings), for example, any entry in a collection, or the right-hand side of a `let` binding. This is because binding a name in some positions is ambiguous, or nonsensical, or leads to unwarranted complications.
### Simple expressions
Many compound forms will only accept "simple" expressions. Formally, simple expressions are either literal (atomic, string, or collection literals) or synthetic expressions. They are expressions which do not take sub-expressions: no `if`, `when`, `match`, etc. (`do` expressions are currently not simple, but that may be revised.)
## Words and bindings
Ludus uses _words_ to bind values to names. Words must start with a lower case ASCII letter, and can subsequently include any letter character (modulo backing character encoding), as well as , `_`, `/`, `?`, `!`, and `*`.
Ludus binds values to names immutably and permanently: no name in the same scope may ever be re-bound to a different value. (Although see [boxes](#boxes-and-state), below.
Attempting to use an unbound name (a word that has not had a value bound to it) will result in a validation error, and the script will not run.
### `let` bindings: a very short introduction
Ludus's basic binding form is `let`:
```
let foo = :bar & `foo` is now bound to `bar` for the rest of the scope.
let foo = :baz & Validation error: name foo was bound in line 1
```
`let` bindings are more complex; we will return to these below.
## Patterns
Ludus makes extensive use of pattern-matching. Patterns do two jobs at once: they match values (or don't); and they bind names. The left-hand side of the examples just above in the `let` binding is not just a word: it is a pattern. Patterns also arise in conditional forms and function declarations.
### The placeholder: `_`
The simplest pattern is the placeholder: it matches against anything, and does not bind a name. It is written as a single underscore: `_`, e.g., `let _ = :foo`.
#### Ignored names
If you wish to be a bit more explict than using a placeholder, you can use an ignored name, which is a name that starts with an underscore: `_foo`. This is not bound, is not a valid name, and can be used however much you wish, even multiple times in the same pattern. It is, in fact, a placeholder, plus a reader-facing description.
### Literal patterns
Patterns can be literal atomic values or strings: `0`, `false`, `nil`, `:foo`, etc. That means you can write `let 0 = 0` or `let :foo = :foo`, and, while nothing will happen, everything will be just fine.
Literals match against, well, literal values: if the pattern and the value are the same, they match! If not, they don't match.
Literal values do not bind anything.
### Word patterns
Word patterns match against any value, and bind that value to the word as a name. The scope of that binding depends on the form the pattern is in. `let foo = :bar` binds `:bar` to `foo` for the rest of the scope.
#### Typed patterns
Word patterns can, optionally, take a type, using the `as` reserved word, and the keyword representing the desired type: `let foo as :number = 42`.
### String patterns
Ludus has a simple but powerful form of string pattern matching that mirrors string interpolation. Any word inside curly braces in a string will match against a substring of a string passed into a pattern.
```
let i_am = "I am the walrus"
let "I {verb} the {noun}" = i_am
(verb, noun) &=> ("am", "walrus")
```
Note that such names may well be bound to empty strings: a match does not guarantee that there will be anything in the string. This is particularly relevant at the beginning and end of string patterns:
```
let we_are = "We are the eggmen"
let "{first}We {what}" = we_are
(first, what) &=> ("", "are the eggmen")
```
### Collection patterns
Tuples, lists, and dicts can be destructured using patterns. They are written nearly identically to their literal counterparts. Collection patterns are composed of any number of simpler patterns or other collection patterns. They bind any names nested in them, match literals in them, etc.
#### Tuple patterns
Tuple patterns are delimited using parens, using commas or newlines to separate any number of other patterns. Consider `let (x, y, z) = (1, 2, 3)`. `x`, `y`, and `z` are now bound to 1, 2, and 3, respectively.
The last item in a tuple pattern can be a splat--`...`--which either discards any remaining unenumerated values in a tuple, or binds them to a list. Without a splat, tuples patterns only match against tuples of the same length.
```
let mytup = (1, 2, 3)
let (x, _, y) = mytup & x is now 1, y is now 3
let (a, ...) = mytup & a is now 1; a bare splat (without a name) is just fine
let (_, ...cs) = mytup & cs is now [2, 3]
let (p, q) = mytup & panic! no match
let () = () & empty tuples are also patterns
```
#### List patterns
List patterns are identical to tuple patterns, but they are written using square braces. They also match against a specific number of members, and may take a splat in the last position, e.g. `let [first, ...rest] = [1, 2, 3]`.
Note that list patterns, like tuple patterns, match on explicit length. That means that if you are matching only the first items of a list, you must explicitly include a splat pattern, e.g. `let [first, second, ...] = [1, 2, 3, 4]`.
#### Dict patterns
Dict patterns are written either with shorthand words, or keyword-pattern pairs. Consider: `let #{:a foo, :b 12, c} = #{:a 1, :b 12, :c 4}`. `foo` is now 1; `b` is now 12, `c` is now 4. If a dict does not hold a value at a particular key, there is no match.
Dict patterns may also use a splat as their last member: `let #{:a 1, ...b} = #{:a 1, :b 2, :c 3}` will bind `b` to `#{:b 2, :c 3}`.
Like tuple and list patterns, dict patterns without a splat at the end match only on exact equivalence on all keys.
## `let` bindings
`let` bindings are the basic form of matching and binding in Ludus. It is written `let {pattern} = {non-binding expression}`. The pattern can be arbitrarily complex. If the left-hand side of a `let` binding does not match, Ludus will raise a panic, halting evaluation of the script.
## Scope and blocks
Ludus is lexically scoped. Bindings are valid for the remainder of the scope they act on. To introduce a new scope, Ludus uses a block, a collection of expressions delimited by curly braces and separated by semicolons or newlines. The value of a block, as well as the value of a script, is the last expression in it. In `let foo = {:this; :set; :of; :expressions; "is actually"; :ignored }`, `foo` will be bound to `:ignored`.
That said, you can use bindings in blocks, which will not be available outside that block--but blocks can use bidnings from their parent scope:
```
let outer = 42
let first = {
let inner = 23
add (outer, inner)
} & first is now bound to 65
inner & Validation error: unbound name inner
```
### Shadowing
Even though names are bound permanently in Ludus, it is perfectly possible (and occasionally quite useful) to "shadow" names from an enclosing scope.
```
let x = 42
let y = {
let first = x
let x = 23 & this is fine
let second = x
add (first, second)
} & y is now 65
```
## Conditional forms
Ludus has a robust set of conditional forms, all of which are expressions and resolve to a single value.
### `if`
`if` evaluates a condition; if the result of the condition is truthy, it evaluates is `then` branch; if the condition is falsy, it evaluates its `else` branch. Both branches must always be present. Newlines may come before `then` and `else`.
`if {simple expression} then {non-binding expression} else {non-binding expression}`
### `when`
`when` is like Lisp's `cond`: it takes a series of clauses, separated by semicolons or newlines, delimited by curly braces. Clauses are written `lhs -> rhs`. `when` expressions are extremely useful for avoiding nested `if`s.
The left hand of a clause is a simple expression; the right hand of a clause is any expression. When the left hand is truthy, the right hand is evaluated, and the result of that evaluation is returned; no further clauses are evaluated. If no clause has a truthy left-hand value, then a panic is raised. In the example below, not the use of literal `true` as an always-matching clause.
```
when {
maybe () -> :something
mabye_not () -> :something_else
true -> :always
}
```
### `match`
A `match` form is the most powerful conditional form in Ludus. It consists of a test expression, and a series of clauses. The test expression must be a simple expression, followed by `with`, and then a series of clauses separated by a semicolon or newline, delimited by curly braces.
```
match may_fail () with {
(:ok, value) -> calculate_result (value)
(:err, msg) -> { log! (msg); recover_somehow () }
}
```
The left hand of a match clause is a pattern; the right hand is an expression: `pattern -> expression`. If the pattern matches the test expression of a clause, the expression is evaluated with any bindings from the pattern, and `match` form evaluates to the result of that expression.
If a test expression does not match against any clause's pattern, a panic is raised.
Ludus does not attempt to do any exhaustiveness checking on match forms; match errors are always runtime errors.
#### Guards
`match` clauses may have a _guard expression_, which allows a clause only to match if the expression's result is truthy. In the previous example, consider that we might want different behaviour depending on the value of the number:
```
match may_fail () with {
(:ok, value) if pos? (value) -> calculate_positive_result (value)
(:ok, value) if neg? (value) -> calculate_negative_result (value)
(:ok, 0) -> do_something_with_zero ()
(:err, msg) -> { log! (msg); recover_somehow () }
}
```
## Functions
Ludus is an emphatically functional language. Almost everything in Ludus is accomplished by applying functions to values, or calling functions with arguments. (These are precise synonyms.)
Functions have the type `:fn`.
### Calling functions
Functions are called by placing a tuple with arguments immediately after a function name, e.g. `add (1, 2)` adds `1` and `2`. Because they are represented as tuples, arguments must be explicitly written; splats cannot be used to pass an arbitrary number of arguments to a function.
### Defining functions
Functions have three increasingly complex forms to define them. All of them include the concept of a function clause, which is just a match clause whose left hand side must be a _tuple_ pattern.
#### Anonymous lambda
An anonymous lambda is written `fn {tuple pattern} -> {expression}`, `fn (x, y) -> if gt? (x, y) then x else add (x, y)`. Lambdas may only have one clause.
#### Named functions
A named function is identical to a lambda, with the one change that a word follows the `fn` reserved word: `fn {name} {tuple pattern} -> {expression}`. E.g., `fn add_1 (x) -> add (x, 1)`. The name of the function is bound for the remainder of the scope.
#### Compound functions
Compound functions are functions that have multiple clauses. They must be named, and in place of a single clause after a name, they consist in one or more clauses, separated by semicolons or newlines, delimited by curly braces. Optionally, compound functions may have a docstring as their first element after the opening curly brace. The docstring explains the function's purpose and use, before any of the function clauses.
An example from Ludus's Prelude:
```
fn some {
"Takes a possibly `nil` value and a default value. Returns the value if it's not `nil`, returns the default if it's `nil`."
(nil, default) -> default
(value, _) -> value
}
```
### Closures
Functions in Ludus are closures: function bodies have access not only to their specific scope, but any enclosing scope. That said, functions only have access to names bound _before_ they are defined; nothing is hoisted in Ludus.
### Mutual recursion and forward declaration
If you try the following, you'll get a validation error:
```
fn stupid_odd? {
(0) -> false
(x) -> supid_even? (dec (x)) & Validation error: unbound name stupid_even?
}
fn stupid_even? {
(0) -> true
(x) -> stupid_odd? (dec (x))
}
```
To allow for mutual recursion, Ludus allows forward declarations, which are written `fn name` without any clauses. In the example above, we would simply put `fn stupid_even?` before we define `stupid_odd?`.
If you declare a function without defining it, however, Ludus will raise a validation error.
### The Prelude
The Prelude is a substantial set of functions that is available in any given Ludus script. (It is, itself, just a Ludus file that has special access to host functions.) Because of that, a large number of functions are always available. The prelude documentation is [here](prelude.md).
### Partial application
Functions in Ludus can be partially applied by using a placeholder in the arguments. Partial application may only use a single placeholder (partially applied functions are always unary), but it can be anywhere in the arguments: `let add_1 = add(1, _)` or `let double = mult(_, 2)`.
Unary functions and called keywords may _not_ be partially applied: it is redundant.
Because of "partial application," Ludus has a concept of an "argument tuple" (which may include a single placeholder) in addition to a tuple literal (which may not include a placeholder).
### Function pipelines, or `do` forms
In place of nesting function calls inside other function calls, Ludus allows for a more streamlined version of function application: the `do` form or function pipeline. `do` is followed by an initial expression. `do` expressions use `>` as an operator: whatever is on the left hand side of the `>` is passed in as a single argument to whatever is on its right hand side. For example:
```
let silly_result = do 23 >
mult (_, 2) > add (1, _) >
sub (_, 2) > div (_, 9) & silly_result is 5
```
Newlines may appear after any instance of `>` in a `do` expression. That does, however, mean that you must be careful not to accidentally include any trailing `>`s.
### Called keywords
Keywords may be called as functions, in which case they extract the value stored at that key in the value passed in:
```
let foo = #{:a 1, :b 2}
let bar = :a (foo) & `bar` is now 1
```
Called keywords can be used in pipelines.
In addition, keywords may be called when they are bound to names:
```
let foo = #{:a 1, :b 2}
let bar = :a
bar (foo) & => 1
```
## Synthetic expressions
Synthetic expressions are valid combinations of words, keywords, package names, and argument tuples which allow for calling functions and extracting values from associative collections. The root--first term--of a synthetic expression must be a word or a keyword; subsequent terms must be either argument tuples or keywords.
```
let foo = #{:a 1, :b #{:c "bar" :d "baz"}}
let bar = foo :b :c & `bar` is now "bar"
let baz = :b (foo) :d & `baz` is now "baz"
```
## Looping forms
Ludus has optimized tail calls--the most straightforward way to accomplish repeating behaviour is function recursion. There are two additional looping forms, `repeat` and `loop`.
### `repeat`
`repeat` is a help to learners, and is useful for executing side effects multiple times. It is written `repeat {number|word} { {exprs} }`. From turtle graphics:
```
repeat 4 {
forward! (100)
right! (0.25)
}
```
Note that `repeat` does two interesting things:
1. It never returns a value other than `nil`. If it's in the block, it disappears. This is a unique (and frankly, undesirable) property in Ludus.
2. Unlike everything else in Ludus, repeate _requires_ a block, and not simply an expression. You cannot write `repeat 4 forward! (100)`.
### `loop`/`recur`
`loop` and `recur` are largely identical to recursive functions for repetition, but use a special form to allow an anonymous construction and a few guard rails.
The syntax here is `loop <tuple> with { <function clauses> }`. (Or, you can have a single function clause instead of a set of clauses.) The tuple is passed in as the first set of arguments.
```
let xs = [1, 2, 3, 4]
loop (xs, 0) with {
([x], sum) -> add (x, sum) & matches against the last element of the list
([x, ...xs], sum) -> recur (xs, add (x, sum)) & recurs with the tail
} &=> 10
```
`recur` is the recursive call. It must be in tail position--`recur` must be the root of a synthetic expression, in return position. If `recur` is not in tail position, a validation error will be raised.
In addition, `recur` calls must have the same number of arguments as the original tuple passed to `loop`. While Ludus will allow you to write clauses in `loop` forms with a different arity than the original tuple, those will never match.
`recur` calls return to the nearest `loop`. Nested `loop`s are probably a bad idea and should be avoided when possible.
## Environment and context: the toplevel
The "toplevel" of a script are the expressions that are not embedded in other expressions or forms: not inside a block, not a member of a collection, not on the right hand side of a binding, not inside a function body. The toplevel-only forms:
### `import`
`import` allows for the evaluation of other Ludus scripts: `import "path/to/file" as name`. `import` just evaluates that file, and then binds a name to the result of evaluating that script. This, right now, is quite basic: circular imports are currently allowed but will lead to endless recursion; results are not cached, so each `import` in a chain re-evaluates the file; and so on.
Status: not yet implemented.
### `use`
`use` loads the contents of a namespace into a script's context. To ensure that this is statically checkable, this must be at the toplevel.
Status: not yet implemented.
### `pkg`
Packages, `pkg`es, may only be described at the toplevel of a script. This is to ensure they can be statically evaluatable.
### `test`
A `test` expression is a way of ensuring things behave the way you want them to. Run the script in test mode, and these are evaluated. If the expression under `test` returns a truthy value, you're all good! If the expression under `test` returns a falsy value or raises a panic, then Ludus will report which test(s) failed.
```
test "something goes right" eq? (:foo, :foo)
test "something goes wrong" {
let foo = :foo
let bar = :bar
eq? (foo, bar)
} &=> test failed: "something goes wrong" on line 3
```
`test`s must be at the toplevel--or embedded within other tests in _their_ highest level.
Formally: `test <string> <expression>`.
Status: not yet implemented.
## Changing things: `box`es
Ludus does not let you re-bind names. It does, however, have a type that allows for changing values over time: `box`. A box is a place to put things, it has its own identity, it can store whatever you put in it, but to get what's in it, you have to `unbox` it.
Syntactically and semantically, `box`es are straightforward, but do require a bit more overhead than `let` bindings. The idea is that Ludus makes it obvious where mutable state is in a program, as well as where that mutable state may change. It does so elegantly, but with some guardrails that may take a little getting used to.
The type of a `box` is, predictably, `:box`.
```
box foo = 42 & foo is now bound to a _box that contains 42_
add (1, foo) & panic! no match: foo is _not_ a number
store! (foo, 23) & foo is now a box containing 23
update! (foo, inc) & foo is now a ref containing 24
unbox (foo) &=> 23; use unbox to get the value contained in a box
```
### Ending with a bang!
Ludus has a strong naming convention that functions that change state or could cause an explicit panic end in an exclamation point (or, in computer nerd parlance, a "bang"). So anything function that mutates the value held in a reference ends with a bang: `store!` and `update!` take bangs; `unbox` does not.
This convention also includes anything that prints to the console: `print!`, `report!`, `doc!`, `update!`, `store!`, etc.
(Note that there are a few counter-examples to this: math functions that could cause a panic [in place of returning NaN] do not end with bangs: `div`, `inv`, and `mod`; each of these has variants that allow for more graceful error handling).
### Ending with a whimper?
Relatedly, just about any function that returns a boolean value is a predicate function--and has a name that ends with a question mark: `eq?` tests for equality; `box?` tells you if something is a ref or not; `lte?` is less-than-or-equal.
## Errors: panic! in the Ludus script
A special form, `panic!`, halts script execution with the expression that follows as an error message.
```
panic! :oops
if true then :ok else panic! "It's false!"
```
Panics also happen in the following cases:
* a `let` binding pattern has no match against the value of its expression
* a `match` or `when` form has no matching clause
* a function is called with arguments that do not match any of its clauses
* something that is not a function or keyword is called as a function
* a called keyword is partially applied
* `div`, `inv`, or `mod` divides by zero
* `sqrt` takes the square root of a negative number
* certain error handling functions, like `unwrap!` or `assert!`, are invoked on values that cause them to panic
In fact, the only functions in the Prelude which explicitly cause panics are, at current, `div`, `inv`, `mod`, `sqrt`, `unwrap!`, and `assert!`.
### `nil`s, not errors
Ludus, however, tries to return `nil` instead of panicking where it seems prudent. So, for example, attempting to get access a value at a keyword off a number or `nil`, while nonsensical, will return `nil` rather than panicking:
```
let a = true
a :b :c :d :e &=> nil
let b = [1, 2, 3]
at (b, 12) &=> nil
```
### Result tuples
Operations that could fail--especially when you want some information about why--don't always return `nil` on failures. Instead of exceptions or special error values, recoverable errors in Ludus are handled instead by result tuples: `(:ok, value)` and `(:err, msg)`. So, for example, `unwrap!` takes a result tuple and either returns the value in the `:ok` case, or panics in the `:err` case.
Variants of some functions that may have undesirably inexplicit behaviour are written as `{name}/safe`. So, for example, you can get a variant of `div` that returns a result tuple in `div/safe`, which returns `(:ok, result)` when everything's good; and `(:err, "division by zero")` when the divisor is 0.

BIN
logo.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 40 KiB

15
notary.json
View File

@ -1,15 +0,0 @@
{
"source": ["./target/ludus"],
"bundle_id": "dev.ludus.core",
"apple_id": {
"username": "s.richmond@utoronto.ca",
"password": "@keychain:Notary"
},
"sign": {
"application_identity": "9F27C69TKX"
},
"dmg": {
"output_path": "./target/ludus.dmg",
"volume_name": "Ludus"
}
}

5220
package-lock.json generated
View File

File diff suppressed because it is too large Load Diff

17
package.json
View File

@ -1,17 +0,0 @@
{
"name": "@ludus/ludus-js-pure",
"version": "0.1.36",
"description": "A Ludus interpreter in a pure JS function.",
"type": "module",
"main": "build/ludus.mjs",
"directories": {},
"keywords": [],
"author": "Scott Richmond",
"license": "GPL-3.0",
"files": [
"build/out.wasm",
"build/out.mjs",
"build/ludus.mjs"
],
"devDependencies": {}
}

7
postlude.ld
View File

@ -1,7 +0,0 @@
& this file runs after any given interpretation
& even if the original interpretation panics
& the goal is to output any global state held in Ludus
& this does not have base loaded into it, only prelude: must be pure Ludus
store! (turtle_state, turtle_init)
store! (turtle_commands, [])

1466
prelude.ld
View File

File diff suppressed because it is too large Load Diff

1574
prelude.md
View File

File diff suppressed because one or more lines are too long

9
project.clj Normal file
View File

@ -0,0 +1,9 @@
(defproject ludus "0.1.0-SNAPSHOT"
:description "FIXME: write description"
:url "http://example.com/FIXME"
:license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
:url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.10.3"]]
:plugins [[lein-cljfmt "0.8.0"]]
:repl-options {:init-ns ludus.core}
:main ludus.core)

285
sandbox.ld
View File

@ -1,285 +0,0 @@
let input = "I remember my mother"
print! ("DOCTOR")
print! ("> ", input)
let sanitized = do input > trim > downcase
& ensuring we have spaces at the beginning and end
& this lets us match patterns as written below
let padded = join ([" ", sanitized, " "])
fn switch_persons {
("i") -> "you"
("you") -> "i"
("am") -> "are"
("me") -> "you"
("my") -> "your"
(x) -> x
}
fn repersonalize (x) -> do x >
trim >
split (_, " ") >
map (switch_persons, _) >
join (_, " ")
fn one_of {
(str as :string) -> str
(strs as :list) -> random (strs)
}
let output = match padded with {
"{x} hello {y}" -> "How do you do. Please state your problem"
"{x} hi {y}" -> "How do you do. Please state your problem"
"{x} computer {y}" -> [
"Do computers worry you"
"What do you think about machines"
"Why do you mention computers"
"What do you think machines have to do with your problem"
]
"{x} name {y}" -> "I am not interested in names"
"{x} sorry {y}" -> [
"Please don't apologize"
"Apologies are not necessary"
"What feelings do you have when you apologize"
]
"{x} i remember {y}" -> {
let switched = repersonalize (y)
[
"Do you often think of {switched}"
"Does thinking of {switched} bring anything else to mind"
"What else do you remember"
"Why do you recall {switched} right now"
"What in the present situation reminds you of {switched}"
"What is the connection between me and {switched}"
]
}
"{x} do you remember {y}" -> {
let switched = repersonalize (y)
[
"Did you think I would forget {switched}"
"Why do you think I should recall {switched} now"
"What about {switched}"
"You mentioned {switched}"
]
}
"{x} if {y}" -> {
let switched = repersonalize (y)
[
"Do you reall think that its likely that {switched}"
"Do you wish that {switched}"
"What do you think about {switched}"
"Really--if {switched}"
]
}
"{x} i dreamt {y}" -> {
let switched = repersonalize (y)
[
"Really--{y}"
"Have you ever fantasized {y} while you were awake"
"Have you dreamt {y} before"
]
}
"{x} dream about {y}" -> {
let switched = repersonalize (y)
"How do you feel about {switched} in reality"
}
"{x} dream {y}" -> [
"What does this dream suggest to you"
"Do you dream often"
"What persons appear in your dreams"
"Don't you believe that dream has to do with your problem"
]
"{x} my mother {y}" -> {
let switched = repersonalize (y)
[
"Who else in your family {y}"
"Tell me more about your family"
]
}
"{x} my father {y}" -> [
"Your father"
"Does he influence you strongly"
"What else comes to mind when you think of your father"
]
"{x} i want {y}" -> {
let switched = repersonalize (y)
[
"What would it mean if you got {y}"
"Why do you want {y}"
"Suppose you got {y} soon"
]
}
"{x} i am glad {y}" -> {
let switched = repersonalize (y)
[
"How have I helped you to be {y}"
"What makes you happy just now"
"Can you explain why you are suddenly {y}"
]
}
"{x} i am sad {y}" -> {
let switched = repersonalize (y)
[
"I am sorry to hear you are depressed"
"I'm sure it's not pleasant to be sad"
]
}
"{x} are like {y}" -> {
let switched_x = repersonalize (x)
let switched_y = repersonalize (y)
"What resemblance to you see between {switched_x} and {switched_y}"
}
"{x} is like {y}" -> {
let switched_x = repersonalize (x)
let switched_y = repersonalize (y)
[
"In what way is it that {switched_x} is like {switched_y}"
"What resemblance do you see"
"Could there really be some connection"
"How"
]
}
"{x} alike {y}" -> [
"In what way"
"What similarities are there"
]
"{x} same {y}" -> "What other connections do you see"
"{x} i was {y}" -> {
let switched = repersonalize (y)
[
"Were you really"
"Perhaps I already knew you were {switched}"
"Why do you tell me you were {switched} now"
]
}
"{x} was i {y}" -> {
let switched = repersonalize (y)
[
"What if you were {switched}"
"Do you think you were {switched}"
"What wouuld it mean if you were {switched}"
]
}
"{x} i am {y}" -> {
let switched = repersonalize (y)
[
"In what way are you {switched}"
"Do you want to be {switched}"
]
}
"{x} am i {y}" -> {
let switched = repersonalize (y)
[
"Do you believe you are {switched}"
"Would you want to be {switched}"
"You wish I would tell you you are {switched}"
"What would it mean if you were {switched}"
]
}
"{x} am {y}" -> [
"Why do you say *AM*"
"I don't understand that"
]
"{x} are you {y}" -> {
let switched = repersonalize (y)
[
"Why are you interested in whether I am {switched} or not"
"Would you prefer if I weren't {switched}"
"Perhaps I am {switched} in your fantasies"
]
}
"{x} you are {y}" -> {
let switched = repersonalize (y)
"What makes you think I am {y}"
}
"{x} because {y}" -> [
"Is that the real reason"
"What other reasons might there be"
"Does that reason seem to explain anything else"
]
"{x} were you {y}" -> {
let switched = repersonalize (y)
[
"Perhaps I was {switched}"
"What od you think"
"What if I had been {switched}"
]
}
"{x} i can't {y}" -> {
let switched = repersonalize (y)
[
"Maybe you could {switched} now"
"What if you could {switched}"
]
}
"{x} i feel {y}" -> {
let switched = repersonalize (y)
"Do you often feel {switched}"
}
"{x} i felt {y}" -> "What other feelings do you have"
"{x} i {y} you {z}" -> {
let switched = repersonalize (y)
"Perhaps in your fantasy we {switched} each other"
}
"{x} why don't you {y}" -> {
let switched = repersonalize (y)
[
"Should you {y} yourself"
"Do you believe I don't {y}"
"Perhaps I will {y} in good time"
]
}
"{x} yes {y}" -> [
"You seem quite positive"
"You are sure"
"I understand"
]
"{x} no {y}" -> [
"Why not"
"You are being a bit negative"
"Are you saying *NO* just to be negative"
]
"{x} someone {y}" -> "Can you be more specific"
"{x} everyone {y}" -> [
"Surely not everyone"
"Can you think of anyone in particular"
"Who for example"
"You are thinking of a special person"
]
"{x} always {y}" -> [
"Can you think of a specific example"
"When"
"What incident are you thinking of"
"Really--always"
]
"{x} what {y}" -> [
"Why do you ask"
"Does that question interest you"
"What is it you really want to know"
"What do you think"
"What comes to your mind when you ask that"
]
"{x} perhaps {y}" -> "You do not seem quite certain"
"{x} are {y}" -> {
let switched = repersonalize (y)
[
"Did you think they might not be {switched}"
"Possibly they are {switched}"
]
}
_ -> [
"Very interesting"
"I am not sure I understand you fully"
"What does that suggest to you"
"Please continue"
"Go on"
"Do you feel strongly about discussing such things"
]
}
print! (">>> ", do output > one_of > upcase)

337
src/base.janet
View File

@ -1,337 +0,0 @@
# A base library for Ludus
# Only loaded in the prelude
(import /src/scanner :as s)
(defn bool [x] (if (= :^nil x) nil x))
(defn ludus/and [& args] (every? (map bool args)))
(defn ludus/or [& args] (some bool args))
(defn ludus/type [value]
(when (= :^nil value) (break :nil))
(def typed? (when (dictionary? value) (value :^type)))
(def the-type (if typed? typed? (type value)))
(case the-type
:buffer :string
:boolean :bool
:array :list
:table :dict
:cfunction :function
the-type))
(var stringify nil)
(defn- dict-str [dict]
(string/join
(map
(fn [[k v]] (string (stringify k) " " (stringify v)))
(pairs dict))
", "))
(defn- stringish? [x] (or (string? x) (buffer? x)))
(defn- stringify* [value]
(when (stringish? value) (break value))
(def type (ludus/type value))
(case type
:nil ""
:number (string value)
:bool (string value)
:keyword (string ":" value)
:tuple
(string/join (map stringify value) ", ")
:list
(string/join (map stringify value) ", ")
:dict (dict-str value)
:set
(string/join (map stringify (keys value)) ", ")
:box (stringify (value :^value))
:fn (string "fn " (value :name))
:function (string "builtin " (string value))
:pkg (dict-str value)
))
(set stringify stringify*)
(var show nil)
(defn- show-pkg [x]
(def tab (struct/to-table x))
(set (tab :^name) nil)
(set (tab :^type) nil)
(string "pkg " (x :^name) " {" (stringify tab) "}")
)
(defn- dict-show [dict]
(string/join
(map
(fn [[k v]] (string (show k) " " (show v)))
(pairs dict))
", "))
(defn- set-show [sett]
(def prepped (merge sett))
(set (prepped :^type) nil)
(def shown (map show (keys prepped)))
(string/join shown ", ")
)
(defn- show* [x]
(case (ludus/type x)
:nil "nil"
:string (string "\"" x "\"")
:tuple (string "(" (string/join (map show x) ", ") ")")
:list (string "[" (string/join (map show x) ", ") "]")
:dict (string "#{" (dict-show x) "}")
:set (string "${" (set-show x) "}")
:box (string "box " (x :name) " [ " (show (x :^value)) " ]")
:pkg (show-pkg x)
(stringify x)))
(set show show*)
# (var json nil)
# (defn- dict-json [dict]
# (string/join
# (map
# (fn [[k v]] (string (json k) ": " (json v)))
# (pairs dict))
# ", "))
# (defn- json* [x]
# (case (ludus/type x)
# :nil "\"null\""
# :number (string x)
# :bool (if true "\"true\"" "\"false\"")
# :string (string "\"" x "\"")
# :keyword (string "\"" x "\"")
# :tuple (string "[" (string/join (map json x) ", ") "]")
# :list (string "[" (string/join (map json x) ", ")"]")
# :dict (string "{" (dict-json x) "}")
# :set (string "[" (string/join (map json (keys x)) ", ") "]")
# (show x)))
# (set json json*)
(defn show-patt [x]
(case (x :type)
:nil "nil"
:bool (string (x :data))
:number (string (x :data))
:keyword (string ":" (x :data))
:word (x :data)
:placeholder (get-in x [:token :lexeme])
:tuple (string "(" (string/join (map show-patt (x :data)) ", ") ")")
:list (string "[" (string/join (map show-patt (x :data)) ", ")"]")
:dict (string "#{" (string/join (map show-patt (x :data)) ", ") "}")
:pair (string (show-patt (get-in x [:data 0])) " " (show-patt (get-in x [:data 1])))
:typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0])))
:interpolated (get-in x [:token :lexeme])
:string (get-in x [:token :lexeme])
:splat (string "..." (when (x :data) (show-patt (x :data))))
(error (string "cannot show pattern of unknown type " (x :type)))))
(defn pretty-patterns [fnn]
(def {:body clauses} fnn)
(string/join (map (fn [x] (-> x first show-patt)) clauses) "\n"))
(defn doc [fnn]
(when (not= :fn (ludus/type fnn)) (break "No documentation available."))
(def {:name name :doc docstring} fnn)
(string/join [name
(pretty-patterns fnn)
(if docstring docstring "No docstring available.")]
"\n"))
(defn- conj!-set [sett value]
(set (sett value) true)
sett)
(defn- conj-set [sett value]
(def new (merge sett))
(conj!-set new value))
(defn- conj!-list [list value]
(array/push list value))
(defn- conj-list [list value]
(def new (array/slice list))
(conj!-list new value))
(defn conj! [x value]
(case (ludus/type x)
:list (conj!-list x value)
:set (conj!-set x value)))
(defn conj [x value]
(case (ludus/type x)
:list (conj-list x value)
:set (conj-set x value)
(error (string "cannot conj onto " (show x)))))
(defn disj! [sett value]
(set (sett value) nil)
sett)
(defn disj [sett value]
(def new (merge sett))
(set (new value) nil)
new)
(defn assoc! [dict key value]
(set (dict key) value)
dict)
(defn assoc [dict key value]
(merge dict {key value}))
(defn dissoc! [dict key]
(set (dict key) nil)
dict)
(defn dissoc [dict key]
(def new (merge dict))
(set (new key) nil)
new)
(defn ludus/get [key dict &opt def]
(default def :^nil)
(get dict key def))
(defn rest [indexed]
(array/slice indexed 1))
(defn to_list [x]
(case (ludus/type x)
:list x
:tuple @[;x]
:dict (pairs x)
:set (-> x (dissoc :^type) keys)
@[x]))
(defn showprint [x]
(if (= :string (ludus/type x))
x
(show x)))
(defn print! [args]
(print ;(map showprint args)))
(defn prn [x]
(pp x)
x)
(defn concat [x y & zs]
(case (ludus/type x)
:string (string x y ;zs)
:list (array/concat @[] x y ;zs)
:set (merge x y ;zs)))
(defn unbox [b] (get b :^value))
(defn store! [b x] (set (b :^value) x))
(defn mod [x y]
(% x y))
(defn- byte->ascii [c i]
(if (< c 128)
(string/from-bytes c)
(error (string "non-ASCII character at index" i))))
(defn chars [str]
(def out @[])
(try
(for i 0 (length str)
(array/push out (byte->ascii (str i) i)))
([e] (break [:err e])))
[:ok out])
(defn to_number [str]
(when (string/find "&" str)
(break [:err (string "Could not parse `" str "` as a number")]))
(def scanned (s/scan (string/trim str)))
(when (< 0 (length (scanned :errors)))
(break [:err (string "Could not parse `" str "` as a number")]))
(def tokens (scanned :tokens))
(when (< 3 (length tokens))
(break [:err (string "Could not parse `" str "` as a number")]))
(def fst (first tokens))
(when (not= :number (fst :type))
(break [:err (string "Could not parse `" str "` as a number")]))
[:ok (fst :literal)])
(def ctx {
"add" +
"and" ludus/and
"assoc!" assoc!
"assoc" assoc
"atan_2" math/atan2
"bool" bool
"ceil" math/ceil
"chars" chars
"concat" concat
"conj!" conj!
"conj" conj
"cos" math/cos
"count" length
"dec" dec
"disj!" disj!
"disj" disj
"dissoc!" dissoc!
"dissoc" dissoc
"div" /
"doc" doc
"downcase" string/ascii-lower
"eq?" deep=
"first" first
"floor" math/floor
"get" ludus/get
"gt" >
"gte" >=
"inc" inc
"last" last
"lt" <
"lte" <=
"mod" mod
"mult" *
"not" not
"nth" ludus/get
"or" ludus/or
"pi" math/pi
"print!" print!
"prn" prn
"push" array/push
"random" math/random
"range" range
"rest" rest
"round" math/round
"show" show
"sin" math/sin
"slice" array/slice
"split" string/split
"sqrt" math/sqrt
"store!" store!
"str_slice" string/slice
"stringify" stringify
"sub" -
"tan" math/tan
"to_list" to_list
"to_number" to_number
"trim" string/trim
"triml" string/triml
"trimr" string/trimr
"type" ludus/type
"unbox" unbox
"upcase" string/ascii-upper
})
(def base (let [b @{:^type :dict}]
(each [k v] (pairs ctx)
(set (b (keyword k)) v))
b))
(to_number " 123 a ")

131
src/doc.janet
View File

@ -1,131 +0,0 @@
(import /src/base :as base)
(import /src/prelude :as prelude)
(defn map-values [f dict]
(from-pairs (map (fn [[k v]] [k (f v)]) (pairs dict))))
(def with-docs (map-values base/doc prelude/ctx))
(def sorted-names (-> with-docs keys sort))
(defn escape-underscores [str] (string/replace "_" "\\_" str))
(defn escape-punctuation [str] (->> str
(string/replace "?" "")
(string/replace "!" "")
(string/replace "/" "")))
(defn toc-entry [name]
(def escaped (escape-underscores name))
(string "[" escaped "](#" (escape-punctuation escaped) ")"))
(def alphabetical-list
(string/join (map toc-entry sorted-names) "&nbsp;&nbsp;&nbsp; "))
(def topics {
"math" ["abs" "add" "angle" "atan/2" "between?" "ceil" "cos" "dec" "deg/rad" "deg/turn" "dist" "div" "div/0" "div/safe" "even?" "floor" "gt?" "gte?" "heading/vector" "inc" "inv" "inv/0" "inv/safe" "lt?" "lte?" "max" "min" "mod" "mod/0" "mod/safe" "mult" "neg" "neg?" "odd?" "pi" "pos?" "rad/deg" "rad/turn" "random" "random_int" "range" "round" "sin" "sqrt" "sqrt/safe" "square" "sub" "sum_of_squares" "tan" "tau" "to_number" "turn/deg" "turn/rad" "zero?"]
"boolean" ["and" "bool" "bool?" "false?" "not" "or" "true?"]
"dicts" ["any?" "assoc" "assoc?" "coll?" "count" "dict" "dict?" "diff" "dissoc" "empty?" "get" "keys" "random" "update" "values"]
"lists" ["any?" "append" "at" "butlast" "coll?" "concat" "count" "each!" "empty?" "filter" "first" "fold" "join" "keep" "last" "list" "list?" "map" "ordered?" "random" "range" "rest" "second" "sentence" "slice"]
"sets" ["any?" "append" "coll?" "concat" "contains?" "count" "empty?" "omit" "random" "set" "set?"]
"tuples" ["any?" "at" "coll?" "count" "empty?" "first" "last" "ordered?" "rest" "second" "tuple?"]
"strings" ["any?" "chars" "chars/safe" "concat" "count" "downcase" "empty?" "join" "sentence" "show" "slice" "split" "string" "string?" "strip" "to_number" "trim" "upcase" "words"]
"types and values" ["assoc?" "bool?" "box?" "coll?" "dict?" "eq?" "fn?" "keyword?" "list?" "neq?" "nil?" "number?" "ordered?" "set?" "show" "some" "some?" "string?" "tuple?" "type"]
"boxes and state" ["box?" "unbox" "store!" "update!"]
"results" ["err" "err?" "ok" "ok?" "unwrap!" "unwrap_or"]
"errors" ["assert!"]
"turtle graphics" ["back!" "background!" "bk!" "clear!" "colors" "fd!" "forward!" "goto!" "heading" "heading/vector" "hideturtle!" "home!" "left!" "loadstate!" "lt!" "pc!" "pd!" "pencolor" "pencolor!" "pendown!" "pendown?" "penup!" "penwidth" "penwidth!" "position" "pu!" "pw!" "render_turtle!" "reset_turtle!" "right!" "rt!" "setheading!" "showturtle!" "turtle_state"]
"environment and i/o" ["doc!" "print!" "report!" "state"]
})
(defn capitalize [str]
(def fst (slice str 0 1))
(def rest (slice str 1))
(def init_cap (string/ascii-upper fst))
(def lower_rest (string/ascii-lower rest))
(string init_cap lower_rest))
(defn topic-entry [topic]
(string "### " (capitalize topic) "\n"
(as-> topic _ (topics _) (array/slice _) (sort _) (map toc-entry _)
(string/join _ "&nbsp;&nbsp;&nbsp; "))
"\n"))
(def by-topic (let [the-topics (-> topics keys sort)
topics-entries (map topic-entry the-topics)]
(string/join topics-entries "\n")))
(defn compose-entry [name]
(def header (string "\n### " name "\n"))
(def the-doc (get with-docs name))
(when (= "No documentation available." the-doc)
(break (string header the-doc "\n")))
(def lines (string/split "\n" the-doc))
(def description (last lines))
(def patterns (string/join (slice lines 1 (-> lines length dec)) "\n"))
(def backto "[Back to top.](#ludus-prelude-documentation)\n")
(string header description "\n```\n" patterns "\n```\n" backto))
(compose-entry "update")
(def entries (string/join (map compose-entry sorted-names) "\n---"))
(def doc-file (string
```
# Ludus prelude documentation
These functions are available in every Ludus script.
The documentation for any function can be found within Ludus by passing the function to `doc!`,
e.g., running `doc! (add)` will send the documentation for `add` to the console.
For more information on the syntax & semantics of the Ludus language, see [language.md](./language.md).
The prelude itself is just a Ludus file, which you can see at [prelude.ld](./prelude.ld).
## A few notes
**Naming conventions.** Functions whose name ends with a question mark, e.g., `eq?`, return booleans.
Functions whose name ends with an exclamation point, e.g., `make!`, change state in some way.
In other words, they _do things_ rather than _calculating values_.
Functions whose name includes a slash either convert from one value to another, e.g. `deg/rad`,
or they are variations on a function, e.g. `div/0` as a variation on `div`.
**How entries are formatted.** Each entry has a brief (sometimes too brief!) description of what it does.
It is followed by the patterns for each of its function clauses.
This should be enough to indicate order of arguments, types, and so on.
**Patterns often, but do not always, indicate types.** Typed patterns are written as `foo as :bar`,
where the type is indicated by the keyword.
Possible ludus types are: `:nil`, `:boolean`, `:number`, `:keyword` (atomic values);
`:string` (strings are their own beast); `:tuple` and `:list` (ordered collections), `:set`s, and `:dict`ionaries (the other collection types); `:pkg` (packages, which are quasi-collections); `:fn` (functions); and `:box`es.
**Conventional types.** Ludus has two types based on conventions.
* _Result tuples._ Results are a way of modeling the result of a calculation that might fail.
The two possible values are `(:ok, value)` and `(:err, msg)`.
`msg` is usually a string describing what went wrong.
To work with result tuples, see [`unwrap!`](#unwrap) and [`unwrap_or`](#unwrap_or).
That said, usually you work with these using pattern matching.
* _Vectors._ Vectors are 2-element tuples of x and y coordinates.
The origin is `(0, 0)`.
Many math functions take vectors as well as numbers, e.g., `add` and `mult`.
You will see vectors indicated in patterns by an `(x, y)` tuple.
You can see what this looks like in the last clause of `add`: `((x1, y1), (x2, y2))`.
## Functions by topic
```
by-topic
```
## All functions, alphabetically
```
alphabetical-list
```
## Function documentation
```
entries
))
(spit "prelude.md" doc-file)

140
src/errors.janet
View File

@ -1,140 +0,0 @@
(import /src/base :as b)
(defn- get-line [source line]
((string/split "\n" source) (dec line)))
(defn- caret [source line start]
(def lines (string/split "\n" source))
(def the-line (lines (dec line)))
(def prev-lines (slice lines 0 (dec line)))
(def char-counts (map (fn [x] (-> x length inc)) prev-lines))
(def prev-line-chars (sum char-counts))
(def offset (- start prev-line-chars))
(def indent (string/repeat "." (+ 6 offset)))
(string indent "^")
)
(defn scan-error [e]
(def {:line line-num :input input :source source :start start :msg msg} e)
(print "Syntax error: " msg)
(print " on line " line-num " in " input ":")
(def source-line (get-line source line-num))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn parse-error [e]
(def msg (e :msg))
(def {:line line-num :input input :source source :start start} (e :token))
(def source-line (get-line source line-num))
(print "Syntax error: " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn validation-error [e]
(def msg (e :msg))
(def {:line line-num :input input :source source :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(case msg
"unbound name"
(do
(print "Validation error: " msg " " (get-in e [:node :data]))
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start)))
(do
(print "Validation error: " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))))
e)
(defn- fn-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print " on line " line-num " in " input ", ")
(def called (e :called))
(print " calling: " (slice (b/show called) 3))
(def value (e :value))
(print " with arguments: " (b/show value))
(print " expected match with one of:")
(def patterns (b/pretty-patterns called))
(def fmt-patt (do
(def lines (string/split "\n" patterns))
(def indented (map (fn [x] (string " " x)) lines))
(string/join indented "\n")
))
(print fmt-patt)
(print " >>> " source-line)
(print (caret source line-num start))
)
(defn- let-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print " on line " line-num " in " input ", ")
(print " matching: " (b/show (e :value)))
(def pattern (get-in e [:node :data 0]))
(print " with pattern: " (b/show-patt pattern))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- match-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(print " on line " line-num " in " input ", ")
(def value (e :value))
(print " matching: " (b/show value))
(print " with patterns:")
(def clauses (get-in e [:node :data 1]))
(def patterns (b/pretty-patterns {:body clauses}))
(def fmt-patt (do
(def lines (string/split "\n" patterns))
(def indented (map (fn [x] (string " " x)) lines))
(string/join indented "\n")
))
(print fmt-patt)
(def source-line (get-line source line-num))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- generic-panic [e]
(def msg (e :msg))
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print "Ludus panicked! " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- unbound-name [e]
(def {:line line-num :source source :lexeme name :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print "Ludus panicked! unbound name " name)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn runtime-error [e]
(when (= :string (type e))
(print (string "Internal Ludus error: " e))
(print "Please file an issue at https://alea.ludus.dev/twc/ludus/issues")
(break e))
(def msg (e :msg))
(case msg
"no match: function call" (fn-no-match e)
"no match: let binding" (let-no-match e)
"no match: match form" (match-no-match e)
"no match: when form" (generic-panic e)
"unbound name" (unbound-name e)
(generic-panic e))
e)

657
src/interpreter.janet
View File

@ -1,657 +0,0 @@
# A tree walk interpreter for ludus
(import /src/base :as b)
(var interpret nil)
(var match-pattern nil)
(defn- todo [msg] (error (string "not yet implemented: " msg)))
(defn- resolve-name [name ctx]
# # (print "resolving " name " in:")
# # (pp ctx)
(when (not ctx) (break :^not-found))
(if (has-key? ctx name)
(ctx name)
(resolve-name name (ctx :^parent))))
(defn- match-word [word value ctx]
(def name (word :data))
# # (print "matched " (b/show value) " to " name)
(set (ctx name) value)
{:success true :ctx ctx})
(defn- typed [pattern value ctx]
(def [type-ast word] (pattern :data))
(def type (type-ast :data))
(if (= type (b/ludus/type value))
(match-word word value ctx)
{:success false :miss [pattern value]}))
(defn- match-tuple [pattern value ctx]
(when (not (tuple? value))
(break {:success false :miss [pattern value]}))
(def val-len (length value))
(var members (pattern :data))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(def patt-len (length members))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-len patt-len)
# (print "mismatched splatted tuple lengths")
(break {:success false :miss [pattern value]}))
# (print "splat!")
(set splat (last members))
(set members (slice members 0 (dec patt-len))))
(when (and (not splat?) (not= val-len patt-len))
# (print "mismatched tuple lengths")
(break {:success false :miss [pattern value]}))
(var curr-mem :^nothing)
(var curr-val :^nothing)
(var success true)
(for i 0 (length members)
(set curr-mem (get members i))
(set curr-val (get value i))
# (print "in tuple, matching " curr-val " with ")
# (pp curr-mem)
(def match? (match-pattern curr-mem curr-val ctx))
# (pp match?)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data))
(def rest (array/slice value (length members)))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-list [pattern value ctx]
(when (not (array? value))
(break {:success false :miss [pattern value]}))
(def val-len (length value))
(var members (pattern :data))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(def patt-len (length members))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-len patt-len)
# (print "mismatched splatted list lengths")
(break {:success false :miss [pattern value]}))
# (print "splat!")
(set splat (last members))
(set members (slice members 0 (dec patt-len))))
(when (and (not splat?) (not= val-len patt-len))
# (print "mismatched list lengths")
(break {:success false :miss [pattern value]}))
(var curr-mem :^nothing)
(var curr-val :^nothing)
(var success true)
(for i 0 (length members)
(set curr-mem (get members i))
(set curr-val (get value i))
# (print "in list, matching " curr-val " with ")
# (pp curr-mem)
(def match? (match-pattern curr-mem curr-val ctx))
# (pp match?)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data))
(def rest (array/slice value (length members)))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-string [pattern value ctx]
(when (not (string? value))
(break {:success false :miss [pattern value]}))
(def {:compiled compiled :bindings bindings} pattern)
# (print "matching " value " with")
# (pp (pattern :grammar))
(def matches (peg/match compiled value))
(when (not matches)
(break {:success false :miss [pattern value]}))
(when (not= (length matches) (length bindings))
(error "oops: different number of matches and bindings"))
(for i 0 (length matches)
(set (ctx (bindings i)) (matches i)))
{:success true :ctx ctx})
(defn- match-dict [pattern value ctx]
(when (not (table? value))
(break {:success false :miss [pattern value]}))
(def val-size (length value))
(var members (pattern :data))
(def patt-len (length members))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-size patt-len)
# (print "mismatched splatted dict lengths")
(break {:success false :miss [pattern value]}))
# (print "splat!")
(set splat (last members))
(set members (slice members 0 (dec patt-len))))
(when (and (not splat?) (not= val-size patt-len))
# (print "mismatched dict lengths")
(break {:success false :miss [pattern value]}))
(var success true)
(def matched-keys @[])
(for i 0 (length members)
(def curr-pair (get members i))
(def [curr-key curr-patt] (curr-pair :data))
(def key (interpret curr-key ctx))
(def curr-val (value key))
(def match? (match-pattern curr-patt curr-val ctx))
(array/push matched-keys key)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data) success)
(def rest (merge value))
(each key matched-keys
(set (rest key) nil))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-pattern* [pattern value &opt ctx]
# (print "in match-pattern, matching " value " with:")
# (pp pattern)
(default ctx @{})
(def data (pattern :data))
(case (pattern :type)
# always match
:placeholder {:success true :ctx ctx}
:ignored {:success true :ctx ctx}
:word (match-word pattern value ctx)
# match on equality
:nil {:success (= :^nil value) :ctx ctx}
:bool {:success (= data value) :ctx ctx}
:number {:success (= data value) :ctx ctx}
:string {:success (= data value) :ctx ctx}
:keyword {:success (= data value) :ctx ctx}
# TODO: lists, dicts
:tuple (match-tuple pattern value ctx)
:list (match-list pattern value ctx)
:dict (match-dict pattern value ctx)
:interpolated (match-string pattern value ctx)
:typed (typed pattern value ctx)
))
(set match-pattern match-pattern*)
(defn- lett [ast ctx]
# (print "lett!")
# (pp ast)
(def [patt expr] (ast :data))
(def value (interpret expr ctx))
(def match? (match-pattern patt value))
(if (match? :success)
(do
(merge-into ctx (match? :ctx))
value)
(error {:node ast :value value :msg "no match: let binding"})))
(defn- matchh [ast ctx]
(def [to-match clauses] (ast :data))
(def value (interpret to-match ctx))
(def len (length clauses))
(when (ast :match) (break ((ast :match) 0 value ctx)))
(defn match-fn [i value ctx]
(when (= len i)
(error {:node ast :value value :msg "no match: match form"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match? (match-pattern patt value @{:^parent ctx}))
(when (not (match? :success))
(break (match-fn (inc i) value ctx)))
(def body-ctx (match? :ctx))
(def guard? (if guard
(b/bool (interpret guard body-ctx)) true))
(when (not guard?)
(break (match-fn (inc i) value ctx)))
(interpret expr body-ctx))
(set (ast :match) match-fn)
(match-fn 0 value ctx))
(defn- script [ast ctx]
(def lines (ast :data))
(def last-line (last lines))
(for i 0 (-> lines length dec)
(interpret (lines i) ctx))
(interpret last-line ctx))
(defn- block [ast parent]
(def lines (ast :data))
(def last-line (last lines))
(def ctx @{:^parent parent})
(for i 0 (-> lines length dec)
(interpret (lines i) ctx))
(interpret last-line ctx))
(defn- to_string [ctx] (fn [x]
(if (buffer? x)
(string x)
(b/stringify (interpret x ctx)))))
(defn- interpolated [ast ctx]
(def terms (ast :data))
(def interpolations (map (to_string ctx) terms))
(string/join interpolations))
(defn- iff [ast ctx]
(def [condition then else] (ast :data))
(if (b/bool (interpret condition ctx))
(interpret then ctx)
(interpret else ctx)))
# TODO: use a tail call here
(defn- whenn [ast ctx]
(def clauses (ast :data))
(var result :^nothing)
(each clause clauses
(def [lhs rhs] clause)
(when (b/bool (interpret lhs ctx))
(set result (interpret rhs ctx))
(break)))
(when (= result :^nothing)
(error {:node ast :msg "no match: when form"}))
result)
(defn- word [ast ctx]
(def resolved (resolve-name (ast :data) ctx))
(if (= :^not-found resolved)
(error {:node ast :msg "unbound name"})
resolved))
(defn- tup [ast ctx]
(def members (ast :data))
(def the-tup @[])
(each member members
(array/push the-tup (interpret member ctx)))
[;the-tup])
(defn- args [ast ctx]
(def members (ast :data))
(def the-args @[])
(each member members
(array/push the-args (interpret member ctx)))
(if (ast :partial)
{:^type :partial :args the-args}
[;the-args]))
(defn- sett [ast ctx]
(def members (ast :data))
(def the-set @{:^type :set})
(each member members
(def value (interpret member ctx))
(set (the-set value) true))
the-set)
(defn- list [ast ctx]
(def members (ast :data))
(def the-list @[])
(each member members
(if (= :splat (member :type))
(do
(def splatted (interpret (member :data) ctx))
(when (not= :array (type splatted))
(error {:node member :msg "cannot splat non-list into list"}))
(array/concat the-list splatted))
(array/push the-list (interpret member ctx))))
the-list)
(defn- dict [ast ctx]
(def members (ast :data))
(def the-dict @{})
(each member members
(if (= :splat (member :type))
(do
(def splatted (interpret (member :data) ctx))
(when (or
(not= :table (type splatted))
(:^type splatted))
(error {:node member :msg "cannot splat non-dict into dict"}))
(merge-into the-dict splatted))
(do
(def [key-ast value-ast] (member :data))
# (print "dict key")
# (pp key-ast)
# (print "dict value")
# (pp value-ast)
(def key (interpret key-ast ctx))
(def value (interpret value-ast ctx))
(set (the-dict key) value))))
the-dict)
(defn- box [ast ctx]
(def {:data value-ast :name name} ast)
(def value (interpret value-ast ctx))
(def box @{:^type :box :^value value :name name})
(set (ctx name) box)
box)
(defn- repeatt [ast ctx]
(def [times-ast body] (ast :data))
(def times (interpret times-ast ctx))
(when (not (number? times))
(error {:node times-ast :msg (string "repeat needs a `number` of times; you gave me a " (type times))}))
(repeat times (interpret body ctx)))
(defn- panic [ast ctx]
(def info (interpret (ast :data) ctx))
(error {:node ast :msg info}))
# TODO: add docstrings & pattern docs to fns
# Depends on: good string representation of patterns
# For now, this should be enough to tall the thing
(defn- fnn [ast ctx]
(def {:name name :data clauses :doc doc} ast)
# (print "defining fn " name)
(def closure (merge ctx))
(def the-fn @{:name name :^type :fn :body clauses :ctx closure :doc doc})
(when (not= :^not-found (resolve-name name ctx))
# (print "fn "name" was forward declared")
(def fwd (resolve-name name ctx))
(set (fwd :body) clauses)
(set (fwd :ctx) closure)
(set (fwd :doc) doc)
# (print "fn " name " has been defined")
# (pp fwd)
(break fwd))
# (pp the-fn)
(set (closure name) the-fn)
(set (ctx name) the-fn)
the-fn)
(defn- is_placeholder [x] (= x :_))
(var call-fn nil)
(defn- partial [root-ast the-fn partial-args]
(when (the-fn :applied)
(error {:msg "cannot partially apply a partially applied function"
:node root-ast :called the-fn :args partial-args}))
# (print "calling partially applied function")
(def args (partial-args :args))
# (pp args)
(def pos (find-index is_placeholder args))
(def name (string (the-fn :name) " *partial*"))
(defn partial-fn [root-ast missing]
# (print "calling function with arg " (b/show missing))
# (pp partial-args)
(def full-args (array/slice args))
(set (full-args pos) missing)
# (print "all args: " (b/show full-args))
(call-fn root-ast the-fn [;full-args]))
{:^type :fn :applied true :name name :body partial-fn})
(defn- call-fn* [root-ast the-fn args]
# (print "on line " (get-in root-ast [:token :line]))
# (print "calling " (b/show the-fn))
# (print "with args " (b/show args))
# (pp args)
(when (or
(= :function (type the-fn))
(= :cfunction (type the-fn)))
# (print "Janet function")
(break (the-fn ;args)))
(def clauses (the-fn :body))
(when (= :nothing clauses)
(error {:node root-ast :called the-fn :value args :msg "cannot call function before it is defined"}))
(when (= :function (type clauses))
(break (clauses root-ast ;args)))
(def len (length clauses))
(when (the-fn :match) (break ((the-fn :match) root-ast 0 args)))
(defn match-fn [root-ast i args]
(when (= len i)
(error {:node root-ast :called the-fn :value args :msg "no match: function call"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match?
(match-pattern patt args @{:^parent (the-fn :ctx)}))
(when (not (match? :success))
(break (match-fn root-ast (inc i) args)))
# (print "matched!")
(def body-ctx (match? :ctx))
(def guard? (if guard
(b/bool (interpret guard body-ctx)) true))
# (print "passed guard")
(when (not guard?)
(break (match-fn root-ast (inc i) args)))
(interpret expr body-ctx))
(set (the-fn :match) match-fn)
(match-fn root-ast 0 args))
(set call-fn call-fn*)
(defn- call-partial [root-ast the-fn arg] ((the-fn :body) root-ast ;arg))
(defn- apply-synth-term [root-ast prev curr]
# (print "applying " (b/show prev))
# (print "to" (b/show curr))
(def types [(b/ludus/type prev) (b/ludus/type curr)])
# (print "typle:")
# (pp types)
(match types
[:fn :tuple] (call-fn root-ast prev curr)
[:fn :partial] (partial root-ast prev curr)
[:function :tuple] (call-fn root-ast prev curr)
# [:applied :tuple] (call-partial root-ast prev curr)
[:keyword :args] (get (first curr) prev :^nil)
[:keyword :tuple] (get (first curr) prev :^nil)
[:dict :keyword] (get prev curr :^nil)
[:nil :keyword] :^nil
[:pkg :keyword] (get prev curr :^nil)
[:pkg :pkg-kw] (get prev curr :^nil)
(error (string "cannot call " (b/ludus/type prev) " `" (b/show prev) "`"))))
(defn- synthetic [ast ctx]
(def terms (ast :data))
# (print "interpreting synthetic")
# (pp ast)
# (pp terms)
(def first-term (first terms))
(def last-term (last terms))
(var prev (interpret first-term ctx))
# (print "root term: ")
# (pp prev)
(for i 1 (-> terms length dec)
(def curr (interpret (terms i) ctx))
# (print "term " i ": " curr)
(set prev (apply-synth-term first-term prev curr)))
# (print "done with inner terms, applying last term")
(apply-synth-term first-term prev (interpret last-term ctx)))
(defn- doo [ast ctx]
(def terms (ast :data))
(var prev (interpret (first terms) ctx))
(def last-term (last terms))
(for i 1 (-> terms length dec)
(def curr (interpret (terms i) ctx))
(set prev (apply-synth-term (first terms) curr [prev])))
(def last-fn (interpret last-term ctx))
(apply-synth-term (first terms) last-fn [prev]))
(defn- pkg [ast ctx]
(def members (ast :data))
(def the-pkg @{:^name (ast :name) :^type :pkg})
(each member members
(def [key-ast value-ast] (member :data))
(def key (interpret key-ast ctx))
(def value (interpret value-ast ctx))
(set (the-pkg key) value))
# (pp the-pkg)
(def out (table/to-struct the-pkg))
(set (ctx (ast :name)) out)
out)
(defn- loopp [ast ctx]
# (print "looping!")
(def data (ast :data))
(def args (interpret (data 0) ctx))
# this doesn't work: context persists between different interpretations
# we want functions to work this way, but not loops (I think)
# (when (ast :match) (break ((ast :match) 0 args)))
(def clauses (data 1))
(def len (length clauses))
(var loop-ctx @{:^parent ctx})
(defn match-fn [i args]
(when (= len i)
(error {:node ast :value args :msg "no match: loop"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match?
(match-pattern patt args loop-ctx))
(when (not (match? :success))
# (print "no match")
(break (match-fn (inc i) args)))
# (print "matched!")
(def body-ctx (match? :ctx))
(def guard? (if guard
(b/bool (interpret guard body-ctx)) true))
# (print "passed guard")
(when (not guard?)
(break (match-fn (inc i) args)))
(interpret expr body-ctx))
(set (ast :match) match-fn)
(set (loop-ctx :^recur) match-fn)
# (print "ATTACHED MATCH-FN")
(match-fn 0 args))
(defn- recur [ast ctx]
# (print "recurring!")
(def passed (ast :data))
(def args (interpret passed ctx))
(def match-fn (resolve-name :^recur ctx))
# (print "match fn in ctx:")
# (pp (ctx :^recur))
# (pp match-fn)
# (pp ctx)
(match-fn 0 args))
# TODO for 0.1.0
(defn- testt [ast ctx] (todo "test"))
(defn- ns [ast ctx] (todo "nses"))
(defn- importt [ast ctx] (todo "imports"))
(defn- withh [ast ctx] (todo "with"))
(defn- usee [ast ctx] (todo "use"))
(defn- interpret* [ast ctx]
# (print "interpreting node " (ast :type))
(case (ast :type)
# literals
:nil :^nil
:number (ast :data)
:bool (ast :data)
:string (ast :data)
:keyword (ast :data)
:placeholder :_
# collections
:tuple (tup ast ctx)
:args (args ast ctx)
:list (list ast ctx)
:set (sett ast ctx)
:dict (dict ast ctx)
# composite forms
:if (iff ast ctx)
:block (block ast ctx)
:when (whenn ast ctx)
:script (script ast ctx)
:panic (panic ast ctx)
# looping forms
:loop (loopp ast ctx)
:recur (recur ast ctx)
:repeat (repeatt ast ctx)
# named/naming forms
:word (word ast ctx)
:interpolated (interpolated ast ctx)
:box (box ast ctx)
:pkg (pkg ast ctx)
:pkg-name (word ast ctx)
# patterned forms
:let (lett ast ctx)
:match (matchh ast ctx)
# functions
:fn (fnn ast ctx)
# synthetic
:synthetic (synthetic ast ctx)
# do
:do (doo ast ctx)
# deferred until after computer class
# :with (withh ast ctx)
# :import (importt ast ctx)
# :ns (ns ast ctx)
# :use (usee ast ctx)
# :test (testt ast ctx)
))
(set interpret interpret*)
# # repl
# (import /src/scanner :as s)
# (import /src/parser :as p)
# (import /src/validate :as v)
# (var source nil)
# (defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
# (defn run []
# (def scanned (s/scan source))
# (when (has-errors? scanned) (break (scanned :errors)))
# (def parsed (p/parse scanned))
# (when (has-errors? parsed) (break (parsed :errors)))
# (def validated (v/valid parsed b/ctx))
# # (when (has-errors? validated) (break (validated :errors)))
# # (def cleaned (get-in parsed [:ast :data 1]))
# # # (pp cleaned)
# (interpret (parsed :ast) @{:^parent b/lett})
# # (try (interpret (parsed :ast) @{:^parent b/ctx})
# # ([e] (if (struct? e) (error (e :msg)) (error e))))
# )
# # (do
# (comment
# (set source `
# let foo = 42
# "{foo} bar baz"
# `)
# (def result (run))
# )

131
src/json.janet
View File

@ -1,131 +0,0 @@
# pulled from cfiggers/jayson
(defmacro- letv [bindings & body]
~(do ,;(seq [[k v] :in (partition 2 bindings)] ['var k v]) ,;body))
(defn- read-hex [n]
(scan-number (string "0x" n)))
(defn- check-utf-16 [capture]
(let [u (read-hex capture)]
(if (and (>= u 0xD800)
(<= u 0xDBFF))
capture
false)))
(def- utf-8->bytes
(peg/compile
~{:double-u-esc (/ (* "\\u" (cmt (<- 4) ,|(check-utf-16 $)) "\\u" (<- 4))
,|(+ (blshift (- (read-hex $0) 0xD800) 10)
(- (read-hex $1) 0xDC00) 0x10000))
:single-u-esc (/ (* "\\u" (<- 4)) ,|(read-hex $))
:unicode-esc (/ (+ :double-u-esc :single-u-esc)
,|(string/from-bytes
;(cond
(<= $ 0x7f) [$]
(<= $ 0x7ff)
[(bor (band (brshift $ 6) 0x1F) 0xC0)
(bor (band (brshift $ 0) 0x3F) 0x80)]
(<= $ 0xffff)
[(bor (band (brshift $ 12) 0x0F) 0xE0)
(bor (band (brshift $ 6) 0x3F) 0x80)
(bor (band (brshift $ 0) 0x3F) 0x80)]
# Otherwise
[(bor (band (brshift $ 18) 0x07) 0xF0)
(bor (band (brshift $ 12) 0x3F) 0x80)
(bor (band (brshift $ 6) 0x3F) 0x80)
(bor (band (brshift $ 0) 0x3F) 0x80)])))
:escape (/ (* "\\" (<- (set "avbnfrt\"\\/")))
,|(get {"a" "\a" "v" "\v" "b" "\b"
"n" "\n" "f" "\f" "r" "\r"
"t" "\t"} $ $))
:main (+ (some (+ :unicode-esc :escape (<- 1))) -1)}))
(defn decode
``
Returns a janet object after parsing JSON. If `keywords` is truthy,
string keys will be converted to keywords. If `nils` is truthy, `null`
will become `nil` instead of the keyword `:json/null`.
``
[json-source &opt keywords nils]
(def json-parser
{:null (if nils
~(/ (<- (+ "null" "Null")) nil)
~(/ (<- (+ "null" "Null")) :json/null))
:bool-t ~(/ (<- (+ "true")) true)
:bool-f ~(/ (<- (+ "false")) false)
:number ~(/ (<- (* (? "-") :d+ (? (* "." :d+)))) ,|(scan-number $))
:string ~(/ (* "\"" (<- (to (* (> -1 (not "\\")) "\"")))
(* (> -1 (not "\\")) "\""))
,|(string/join (peg/match utf-8->bytes $)))
:array ~(/ (* "[" :s* (? (* :value (any (* :s* "," :value)))) "]") ,|(array ;$&))
:key-value (if keywords
~(* :s* (/ :string ,|(keyword $)) :s* ":" :value)
~(* :s* :string :s* ":" :value))
:object ~(/ (* "{" :s* (? (* :key-value (any (* :s* "," :key-value)))) "}")
,|(from-pairs (partition 2 $&)))
:value ~(* :s* (+ :null :bool-t :bool-f :number :string :array :object) :s*)
:unmatched ~(/ (<- (to (+ :value -1))) ,|[:unmatched $])
:main ~(some (+ :value "\n" :unmatched))})
(first (peg/match (peg/compile json-parser) json-source)))
(def- bytes->utf-8
(peg/compile
~{:four-byte (/ (* (<- (range "\xf0\xff")) (<- 1) (<- 1) (<- 1))
,|(bor (blshift (band (first $0) 0x07) 18)
(blshift (band (first $1) 0x3F) 12)
(blshift (band (first $2) 0x3F) 6)
(blshift (band (first $3) 0x3F) 0)))
:three-byte (/ (* (<- (range "\xe0\xef")) (<- 1) (<- 1))
,|(bor (blshift (band (first $0) 0x0F) 12)
(blshift (band (first $1) 0x3F) 6)
(blshift (band (first $2) 0x3F) 0)))
:two-byte (/ (* (<- (range "\x80\xdf")) (<- 1))
,|(bor (blshift (band (first $0) 0x1F) 6)
(blshift (band (first $1) 0x3F) 0)))
:multi-byte (/ (+ :two-byte :three-byte :four-byte)
,|(if (< $ 0x10000)
(string/format "\\u%04X" $)
(string/format "\\u%04X\\u%04X"
(+ (brshift (- $ 0x10000) 10) 0xD800)
(+ (band (- $ 0x10000) 0x3FF) 0xDC00))))
:one-byte (<- (range "\x20\x7f"))
:0to31 (/ (<- (range "\0\x1F"))
,|(or ({"\a" "\\u0007" "\b" "\\u0008"
"\t" "\\u0009" "\n" "\\u000A"
"\v" "\\u000B" "\f" "\\u000C"
"\r" "\\u000D"} $)
(string/format "\\u%04X" (first $))))
:backslash (/ (<- "\\") "\\\\")
:quote (/ (<- "\"") "\\\"")
:main (+ (some (+ :0to31 :backslash :quote :one-byte :multi-byte)) -1)}))
(defn- encodeone [x depth]
(if (> depth 1024) (error "recurred too deeply"))
(cond
(= x :json/null) "null"
(= x nil) "null"
(bytes? x) (string "\"" (string/join (peg/match bytes->utf-8 x)) "\"")
(indexed? x) (string "[" (string/join (map |(encodeone $ (inc depth)) x) ",") "]")
(dictionary? x) (string "{" (string/join
(seq [[k v] :in (pairs x)]
(string "\"" (string/join (peg/match bytes->utf-8 k)) "\"" ":" (encodeone v (inc depth)))) ",") "}")
(case (type x)
:nil "null"
:boolean (string x)
:number (string x)
(error "type not supported"))))
(defn encode
``
Encodes a janet value in JSON (utf-8). If `buf` is provided, the formated
JSON is append to `buf` instead of a new buffer. Returns the modifed buffer.
``
[x &opt buf]
(letv [ret (encodeone x 0)]
(if (and buf (buffer? buf))
(buffer/push ret)
(thaw ret))))

106
src/ludus.janet
View File

@ -1,106 +0,0 @@
# an integrated Ludus interpreter
# devised in order to run under wasm
# takes a string, returns a string with a json object
# (try (os/cd "janet") ([_] nil)) # for REPL
(import /src/scanner :as s)
(import /src/parser :as p)
(import /src/validate :as v)
(import /src/interpreter :as i)
(import /src/errors :as e)
(import /src/base :as b)
(import /src/prelude :as prelude)
(import /src/json :as j)
(defn ludus [source]
# if we can't load prelude, bail
(when (= :error prelude/pkg) (error "could not load prelude"))
# get us a clean working slate
(def ctx @{:^parent prelude/ctx})
(def errors @[])
(var result @"")
(def console @"")
# capture all `print`s
(setdyn :out console)
# an output table
# this will change: the shape of our output
# at the moment, there's only one stack of turtle graphics
# we will be getting more
(def out @{:errors errors :result result
:io @{
:stdout @{:proto [:text-stream "0.1.0"] :data console}
:turtle @{:proto [:turtle-graphics "0.1.0"] :data @[]}}})
### start the program
# first, scanning
(def scanned (s/scan source))
(when (any? (scanned :errors))
(each err (scanned :errors)
(e/scan-error err))
(break (-> out j/encode string)))
# then, parsing
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(each err (parsed :errors)
(e/parse-error err))
(break (-> out j/encode string)))
# then, validation
(def validated (v/valid parsed ctx))
(when (any? (validated :errors))
(each err (validated :errors)
(e/validation-error err))
(break (-> out j/encode string)))
# and, finally, try interpreting the program
(try (do
# we need to do this every run or we get the very same sequence of "random" numbers every time we run a program
(math/seedrandom (os/cryptorand 8))
(set result (i/interpret (parsed :ast) ctx)))
([err]
(e/runtime-error err)
(break (-> out j/encode string))))
# stop capturing output
(setdyn :out stdout)
# update our output table with our output
(set (out :result) (b/show result))
(set (((out :io) :turtle) :data) (get-in prelude/pkg [:turtle_commands :^value]))
# run the "postlude": any Ludus code that needs to run after each program
# right now this is just resetting the boxes that hold turtle commands and state
(try
(i/interpret prelude/post/ast ctx)
([err] (e/runtime-error err)))
# json-encode our output table, and convert it from a buffer to a string (which we require for playing nice with WASM/C)
(-> out j/encode string))
#### REPL
(comment
# (do
# (def start (os/clock))
(def source `
fd! (100)
rt! (0.25)
fd! (100)
lt! (0.25)
fd! (100)
setheading! (0.75)
unbox (turtle_state)
`)
(def out (-> source
ludus
j/decode
))
# (def end (os/clock))
(setdyn :out stdout)
(pp out)
(def console (out "console"))
(print console)
(def result (out "result"))
(print result)
# (print (- end start))
)

21
src/ludus/analyzer.clj Normal file
View File

@ -0,0 +1,21 @@
(ns ludus.analyzer
(:require
[ludus.ast :as ast]
[ludus.token :as token]))
(defn analyze [ast] ast)
(comment "
Here's where we do a bunch of static analysis.
Some things we might wish for:
* No unused bindings
* No unbound names
* Compound `loop` and `gen` forms must have LHS's (tuple patterns) of the same length
* Recur must be in tail position in `loop`s
* Tail call optimization for simple recursion (rewrite it as a loop?)
* Check arities for statically known functions
* Enforce single-member tuple after called keywords
* Placeholders may only appear in tuples in synthetic expressions
* Each of these may have zero or one placeholders
* Arity of called keywords must be 1
")

2
src/ludus/ast.clj Normal file
View File

@ -0,0 +1,2 @@
(ns ludus.ast)

1
src/ludus/collections.clj Normal file
View File

@ -0,0 +1 @@
(ns ludus.collections)

33
src/ludus/core.clj Normal file
View File

@ -0,0 +1,33 @@
(ns ludus.core
"A tree-walk interpreter for the Ludus language."
(:require
[ludus.scanner :as scanner]))
(defn- report [line, where, message]
(println (str "[line " line "] Error" where ": " message)))
(defn- error [line, message]
(report line "" message))
(defn- run [source]
(let [tokens (scanner/scan source)]
(run! println tokens)))
(defn- run-file [path]
(let [source (slurp path)]
(run source)))
(defn- run-prompt []
(loop [_ ""]
(print "Ludus >> ")
(flush)
(when-let [line (read-line)]
(recur (run line)))))
(defn -main [& args]
(cond
(> (count args) 1) (do
(println "Usage: ludus [script]")
(System/exit 64))
(= (count args) 1) (run-file (first args))
:else (run-prompt)))

240
src/ludus/interpreter.clj Normal file
View File

@ -0,0 +1,240 @@
(ns ludus.interpreter
(:require
[ludus.parser :as parser]
[ludus.scanner :as scanner]
[ludus.ast :as ast]
[ludus.collections :as colls]
[ludus.prelude :as prelude]
[clojure.pprint :as pp]))
;; right now this is not very efficient:
;; it's got runtime checking
;; we should be able to do these checks statically
;; that's for later, tho
(defn- resolve [word ctx-atom]
(let [ctx @ctx-atom]
(if (contains? ctx word)
(get ctx word)
(if (contains? ctx ::parent)
(recur word (::parent ctx))
(throw (new Exception (str "Unbound name: " word)))))))
(declare interpret match)
(defn- match-tuple [pattern value ctx-atom]
(cond
(not (vector? value)) {:success false :reason "Could not match non-tuple value to tuple"}
(not (= ::colls/tuple (first value))) {:success false :reason "Could not match list to tuple"}
(not (= (:length pattern) (dec (count value))))
{:success false :reason "Cannot match tuples of different lengths"}
(= 0 (:length pattern) (dec (count value))) {:success true :ctx {}}
:else (let [members (:members pattern)]
(loop [i (:length pattern)
ctx {}]
(if (= 0 i)
{:success true :ctx ctx}
(let [match? (match (nth members (dec i)) (nth value i) ctx-atom)]
(if (:success match?)
(recur (dec i) (merge ctx (:ctx match?)))
{:success false :reason (str "Could not match " pattern " with " value)})))))))
(defn- match [pattern value ctx-atom]
(let [ctx @ctx-atom]
(case (::ast/type pattern)
::ast/placeholder {:success true :ctx {}}
::ast/atom
(let [match-value (:value pattern)]
(if (= match-value value)
{:success true :ctx {}}
{:success false
:reason (str "No match: Could not match " match-value " with " value)}))
::ast/word
(let [word (:word pattern)]
(if (contains? ctx word)
{:success false :reason (str "Name " word " is already bound")}
{:success true :ctx {word value}}))
::ast/tuple (match-tuple pattern value ctx-atom)
(do
(println "ERROR! Unexpected pattern:")
(pp/pprint pattern)))))
(defn- update-ctx [ctx new-ctx]
(println "Adding to context:")
(pp/pprint new-ctx)
(merge ctx new-ctx))
;; TODO: get "if let" pattern working
;; TODO: get typed exceptions to distinguish panics
(defn- interpret-let [ast ctx]
(let [pattern (:pattern ast)
expr (:expr ast)
value (interpret expr ctx)
match (match pattern value ctx)
success (:success match)]
(if success
(swap! ctx update-ctx (:ctx match))
(throw (ex-info (:reason match) {})))
value))
(defn- interpret-if [ast ctx]
(let [if-expr (:if ast)
then-expr (:then ast)
else-expr (:else ast)
if-value (interpret if-expr ast)]
(if if-value
(interpret then-expr ctx)
(interpret else-expr ctx))))
(defn- interpret-match [ast ctx]
(let [match-expr (:expr ast)
expr (interpret match-expr ctx)
clauses (:clauses ast)]
(loop [clause (first clauses)
clauses (rest clauses)]
(if clause
(let [pattern (:pattern clause)
body (:body clause)
new-ctx (atom {::parent ctx})
match? (match pattern expr new-ctx)
success (:success match?)
clause-ctx (:ctx match?)]
(if success
(do
(swap! new-ctx #(merge % clause-ctx))
(interpret body new-ctx))
(recur (first clauses) (rest clauses))))
(throw (ex-info "Match Error: No match found" {}))))))
(defn- interpret-called-kw [kw tuple ctx]
(if (not (= 1 (:length tuple)))
;; TODO: check this statically
(throw (ex-info "Called keywords must be unary" {}))
(let [kw (interpret kw ctx)
map (second (interpret tuple ctx))]
(get map kw))))
(defn- call-fn [fn tuple ctx]
(let [passed (interpret tuple ctx)]
(case (::ast/type fn)
::ast/clj (apply (:body fn) (next passed))
(throw (ex-info "I don't know how to call that" {:fn fn})))))
;; TODO: add placeholder partial application
(defn- interpret-synthetic-term [prev-value curr ctx]
(let [type (::ast/type curr)]
(if (= type ::ast/atom)
(get prev-value (:value curr))
(call-fn prev-value curr ctx))))
(defn- interpret-synthetic [ast ctx]
(let [terms (:terms ast)
first (first terms)
second (second terms)
rest (rest (rest terms))
first-term-type (::ast/type first)
first-val (if (= first-term-type ::ast/atom)
(interpret-called-kw first second ctx)
(interpret-synthetic-term (interpret first ctx) second ctx))]
(reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest)))
(defn- map-values [f]
(map (fn [kv]
(let [[k v] kv]
[k (f v)]))))
(defn interpret [ast ctx]
(case (::ast/type ast)
::ast/atom (:value ast)
::ast/word (resolve (:word ast) ctx)
::ast/let (interpret-let ast ctx)
::ast/if (interpret-if ast ctx)
::ast/match (interpret-match ast ctx)
::ast/synthetic (interpret-synthetic ast ctx)
::ast/block
(let [exprs (:exprs ast)
inner (pop exprs)
last (peek exprs)
ctx (atom {::parent ctx})]
(run! #(interpret % ctx) inner)
(interpret last ctx))
::ast/script
(let [exprs (:exprs ast)
inner (pop exprs)
last (peek exprs)
ctx (atom prelude/prelude)]
(run! #(interpret % ctx) inner)
(interpret last ctx))
;; note that the runtime representations of collections is
;; unboxed in the tree-walk interpreter
;; tuples & lists are both vectors, the first element
;; distinguishes them
::ast/tuple
(let [members (:members ast)]
(into [::colls/tuple] (map #(interpret % ctx)) members))
::ast/list
(let [members (:members ast)]
(into [::colls/list] (map #(interpret % ctx)) members))
::ast/set
(let [members (:members ast)]
(into #{} (map #(interpret % ctx)) members))
::ast/hash
(let [members (:members ast)]
(into {} (map-values #(interpret % ctx)) members))
(do
(println "ERROR! Unexpected AST node:")
(pp/pprint ast))))
(do
(def source "
if false then :yay else print(:foo)
")
(println "")
(println "****************************************")
(println "*** *** NEW INTERPRETATION *** ***")
(println "")
(-> source
(scanner/scan)
(parser/parse)
(::parser/ast)
(interpret {})
(pp/pprint)))
(comment "
Left to do:
* if-let pattern
* improve panics
* add location info for panics
")

638
src/ludus/parser.clj Normal file
View File

@ -0,0 +1,638 @@
(ns ludus.parser
(:require
[ludus.token :as token]
[ludus.scanner :as scanner]
[ludus.ast :as ast]
[clojure.pprint :as pp]
[clojure.set :as s]))
;; a parser map and some functions to work with them
(defn- parser [tokens]
{::tokens tokens ::token 0 ::ast {} ::errors []})
(defn- current [parser]
(nth (::tokens parser) (::token parser) nil))
(defn- peek [parser]
(nth (::tokens parser) (inc (::token parser)) nil))
(defn- at-end? [parser]
(let [curr (current parser)]
(or (nil? curr) (= ::token/eof (::token/type curr)))))
(defn- advance [parser]
(update parser ::token inc))
(defn- token-type [parser]
(::token/type (current parser)))
(defn- node-type [parser]
(get-in parser [::ast ::ast/type]))
;; some forward declarations
(declare parse-expr parse-word parse-pattern)
;; handle some errors
(def sync-on #{::token/newline
::token/semicolon
::token/comma
::token/rparen
::token/rbracket
::token/rbrace
::token/eof})
(defn- sync [parser message origin end]
(let [poison {::ast/type ::ast/poison
:message message
:origin origin
:end end}]
(-> parser
(assoc ::ast poison)
(update ::errors conj poison))))
(defn- poisoned? [parser]
(= ::ast/poison (get-in parser [::ast ::ast/type])))
(defn- panic
([parser message] (panic parser message sync-on))
([parser message sync-on]
(println (str "PANIC!!! in the parser: " message))
(let [sync-on (conj (if (set? sync-on) sync-on #{sync-on}) ::token/eof)
origin (current parser)]
(loop [parser parser]
(let [curr (current parser)
type (::token/type curr)]
(if (or (at-end? parser) (contains? sync-on type))
(sync parser message origin curr)
(recur (advance parser))))))))
;; some helper functions
(defn- expect [tokens message parser]
(let [curr (current parser)
tokens (if (set? tokens) tokens #{tokens})
type (::token/type curr)]
(if (contains? tokens type)
(advance parser)
(-> parser
(advance)
(panic message tokens)))))
(defn- expect* [tokens message parser]
(let [curr (current parser)
tokens (if (set? tokens) tokens #{tokens})
type (::token/type curr)]
(if (contains? tokens type)
{:success true :parser (advance parser)}
{:success false :parser (panic (advance parser) message)})))
(defn- accept [tokens parser]
(let [curr (current parser)
tokens (if (set? tokens) tokens #{tokens})
type (::token/type curr)]
(if (contains? tokens type)
(advance parser)
parser)))
(defn- accept-many [tokens parser]
(let [tokens (if (set? tokens) tokens #{tokens})]
(loop [parser parser]
(let [curr (current parser)
type (::token/type curr)]
(if (contains? tokens type)
(recur (advance parser))
parser)))))
;; various parsing functions
(defn- parse-atom [parser]
(let [token (current parser)]
(-> parser
(advance)
(assoc ::ast {::ast/type ::ast/atom
:token token
:value (::token/literal token)}))))
;; just a quick and dirty map to associate atomic words with values
(def atomic-words {::token/nil nil
::token/true true
::token/false false})
(defn parse-atomic-word [parser]
(let [token (current parser)]
(-> parser
(advance)
(assoc ::ast {::ast/type ::ast/atom
:token token
:value (get atomic-words (::token/type token))}))))
(defn- add-member [members member]
(if (nil? member)
members
(conj members member)))
(defn- parse-tuple [origin]
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
members []
current_member nil]
(let [curr (current parser)]
(case (token-type parser)
::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast
{::ast/type ::ast/tuple
:length (count ms)
:members ms}))
(::token/comma ::token/newline)
(recur
(accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil)
(::token/rbrace ::token/rbracket)
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
(let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})]
(recur parsed members (::ast parsed)))))))
(defn- parse-list [origin]
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
members []
current_member nil]
(let [curr (current parser)]
(case (token-type parser)
::token/rbracket (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast
{::ast/type ::ast/list
:members ms}))
(::token/comma ::token/newline)
(recur
(accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil)
(::token/rbrace ::token/rparen)
(panic parser (str "Mismatched enclosure in list: " (::token/lexeme curr)))
::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated list" ::token/eof)
(let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbracket})]
(recur parsed members (::ast parsed)))))))
(defn- parse-set [origin]
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
members []
current_member nil]
(let [curr (current parser)]
(case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast
{::ast/type ::ast/set
:members ms}))
(::token/comma ::token/newline)
(recur
(accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil)
(::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr)))
::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated set" ::token/eof)
(let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbrace})]
(recur parsed members (::ast parsed)))))))
(defn- parse-hash [origin]
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
members {}
current_member nil]
(let [curr (current parser)]
(case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast
{::ast/type ::ast/hash
:members ms}))
(::token/comma ::token/newline)
(recur
(accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil)
(::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr)))
::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated set" ::token/eof)
::token/word
(if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])]
(recur parsed members {(keyword word) (::ast parsed)}))
(panic parser "Hashmap entries must be single words or keyword+expression pairs." #{::token/rbrace}))
::token/keyword
(if (not current_member) (let [kw (parse-atom parser) expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})]
(println "found keyword/expr pair:" (:value kw))
(pp/pprint (::ast expr))
(recur expr members {(:value (::ast kw)) (::ast expr)}))
(panic parser "Hashmap entries must be single words or keyword+expression pairs." #{::token/rbrace}))
(panic parser "Hashmap entries must be single words or keyword+expression pairs" #{::token/rbrace})))))
(defn- parse-block [origin]
(loop [parser (accept-many #{::token/newline ::token/semicolon} (advance origin))
exprs []
current_expr nil]
(let [curr (current parser)]
(case (token-type parser)
::token/rbrace
(let [es (add-member exprs current_expr)]
(if (empty? es)
(advance (panic parser "Blocks must have at least one expression"))
(assoc (advance parser) ::ast {::ast/type ::ast/block
:exprs es})))
(::token/semicolon ::token/newline)
(recur
(accept-many #{::token/newline ::token/semicolon} parser)
(add-member exprs current_expr) nil)
(::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in block: " (::token/lexeme curr)))
::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated block" ::token/eof)
(let [parsed
(if current_expr
(panic parser "Expected end of expression" #{::token/semicolon ::token/newline})
(parse-expr parser))]
(recur parsed exprs (::ast parsed)))))))
(defn parse-script [parser]
(loop [parser (accept-many #{::token/newline ::token/semicolon} parser)
exprs []
current_expr nil]
(case (token-type parser)
::token/eof
(let [es (add-member exprs current_expr)]
(if (empty? es)
(panic parser "Scripts must have at least one expression")
(assoc parser ::ast {::ast/type ::ast/script :exprs es})))
(::token/semicolon ::token/newline)
(recur
(accept-many #{::token/semicolon ::token/newline} parser)
(add-member exprs current_expr)
nil)
(let [parsed
(if current_expr
(panic parser "Expected end of expression" #{::token/semicolon ::token/newline})
(parse-expr parser))]
(recur parsed exprs (::ast parsed))))))
(defn- parse-synthetic [parser]
(loop [parser parser
terms []]
(let [curr (current parser)
type (::token/type curr)]
(case type
::token/keyword
(recur (advance parser) (conj terms (::ast (parse-atom parser))))
::token/word
(recur (advance parser) (conj terms (::ast (parse-word parser))))
::token/lparen
(let [parsed (parse-tuple parser)]
(recur parsed (conj terms (::ast parsed))))
(assoc parser ::ast {::ast/type ::ast/synthetic :terms terms})))))
(defn- parse-word [parser]
(let [curr (current parser)]
(-> parser
(advance)
(assoc ::ast {::ast/type ::ast/word :word (::token/lexeme curr)}))))
(def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow}))
(defn- parse-tuple-pattern [origin]
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
members []
current_member nil]
(let [curr (current parser)]
(case (token-type parser)
::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast
{::ast/type ::ast/tuple
:length (count ms)
:members ms}))
(::token/comma ::token/newline)
(recur
(accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil)
(::token/rbrace ::token/rbracket)
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
(let [parsed (parse-pattern parser)]
(recur parsed members (::ast parsed)))))))
(defn- parse-pattern [parser]
(let [curr (current parser)
type (::token/type curr)]
(case type
::token/placeholder (-> parser
(advance)
(assoc ::ast {::ast/type ::ast/placeholder}))
::token/word (parse-word parser)
(::token/number ::token/string ::token/keyword) (parse-atom parser)
::token/lparen (parse-tuple-pattern parser)
::token/error
(panic parser (:message (current parser)) sync-pattern)
(panic parser "Expected pattern" sync-pattern))))
(defn- parse-let-expr [parser pattern]
(let [expr (parse-expr parser)]
(assoc expr ::ast {::ast/type ::ast/let
:pattern (::ast pattern) :expr (::ast expr)})))
(defn- parse-assignment [parser]
(let [assignment (expect* ::token/equals "Expected assignment" parser)
success (:success assignment)]
(if success
(parse-let-expr (:parser assignment) parser)
(panic parser "Expected assignment"))))
(defn- parse-let [parser]
(let [pattern (parse-pattern (advance parser))]
(parse-assignment pattern)))
(defn- parse-else [parser]
(let [ast (::ast parser)
else-kw (expect* ::token/else "Expected else clause after then" parser)
success (:success else-kw)
else-kw-parser (:parser else-kw)]
(if success
(let [expr (parse-expr else-kw-parser)
else-expr (::ast expr)]
(assoc expr ::ast (assoc ast :else else-expr)))
else-kw-parser)))
(defn- parse-then [parser]
(let [ast (::ast parser)
then-kw (expect* ::token/then "Expected then clause after if" parser)
success (:success then-kw)
then-kw-parser (:parser then-kw)]
(if success
(let [expr (parse-expr then-kw-parser (conj sync-on ::token/else))
then-expr (::ast expr)]
(parse-else (accept ::token/newline (assoc expr ::ast (assoc ast :then then-expr)))))
then-kw-parser)))
(defn- parse-if [parser]
(let [if-expr (parse-expr (advance parser) #{::token/newline ::token/then})
ast (assoc if-expr ::ast {::ast/type ::ast/if :if (::ast if-expr)})]
(parse-then (accept ::token/newline ast))))
(defn- parse-match-clause [parser]
(let [pattern (parse-pattern parser)
rarrow (expect* #{::token/rarrow} "Expected arrow after pattern" pattern)]
(if (:success rarrow)
(let [body (parse-expr (:parser rarrow))]
(assoc body ::ast {::ast/type ::ast/clause
:pattern (::ast pattern) :body (::ast body)}))
(panic pattern "Expected -> in match clause. Clauses must be in the form pattern -> expression" #{::token/newline ::token/rbrace}))))
(defn- parse-match-clauses [parser]
(loop [parser (accept-many #{::token/newline} (advance parser))
clauses []]
(let [curr (current parser)]
(case (::token/type curr)
::token/rbrace
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses})
::token/newline
(recur (accept-many #{::token/newline} parser) clauses)
(let [clause (parse-match-clause parser)]
(recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause))))))))
(defn- parse-match [parser]
(let [match-expr (parse-expr (advance parser) #{::token/with})
match-header (expect* #{::token/with} "Expected with" match-expr)]
(if (:success match-header)
(let [clauses (:parser match-header)]
(if (= (token-type clauses) ::token/lbrace)
;; match expression with one or many clauses in braces
(let [clauses (parse-match-clauses clauses)]
(assoc clauses ::ast {::ast/type ::ast/match
:expr (::ast match-expr)
:clauses (get-in clauses [::ast :clauses])}))
;; match expression with single match clause
(let [clause (parse-match-clause clauses)]
(assoc clause ::ast {::ast/type ::ast/match
:expr (::ast match-expr)
:clauses [(::ast clause)]}))))
(panic parser "Expected with after match expression"))))
(defn- parse-fn-clause [parser]
(if (not (= ::token/lparen (token-type parser)))
(panic parser "Function clauses must begin with tuple patterns")
(let [pattern (parse-tuple-pattern parser)
arrow (expect* #{::token/rarrow} "Expected arrow" pattern)
body (parse-expr (:parser arrow))]
(if (:success arrow)
(assoc body ::ast {::ast/type ::ast/clause
:pattern (::ast pattern) :body (::ast body)})
(panic pattern "Expected -> in function clause. Clauses must be in the form of (pattern) -> expression")))))
(defn- parse-fn-clauses [parser]
(loop [parser (accept-many #{::token/newline} (advance parser))
clauses []]
(let [curr (current parser)]
(case (::token/type curr)
::token/rbrace
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses})
::token/newline
(recur (accept-many #{::token/newline} parser) clauses)
(let [clause (parse-fn-clause parser)]
(recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause))))))))
(defn- parse-named-fn [parser]
(let [name (parse-word parser)]
(case (token-type name)
::token/lparen
(let [clause (parse-fn-clause name)]
(assoc clause ::ast {::ast/type ::ast/fn
:name (get-in name [::ast :word])
:clauses [(::ast clause)]}))
::token/lbrace
(let [clauses (parse-fn-clauses name)]
(assoc clauses ::ast {::ast/type ::ast/match
:name (get-in name [::ast :word])
:clauses (get-in clauses [::ast :clauses])}))
(panic name "Expected one or more function clauses"))))
(defn- parse-fn [parser]
(let [first (advance parser)]
(case (::token/type (current first))
::token/lparen
(let [clause (parse-fn-clause first)]
(assoc clause ::ast {::ast/type ::ast/fn
:name "anonymous"
:clauses [(::ast clause)]}))
::token/word (parse-named-fn first)
(panic parser "Expected name or clause after fn"))))
(defn- parse-expr
([parser] (parse-expr parser sync-on))
([parser sync-on]
(let [token (current parser)]
(case (::token/type token)
(::token/number ::token/string)
(parse-atom parser)
::token/keyword
(let [next (peek parser)
type (::token/type next)]
(if (= type ::token/lparen)
(parse-synthetic parser)
(parse-atom parser)))
::token/word
(let [next (peek parser)
type (::token/type next)]
(case type
(::token/lparen ::token/keyword) (parse-synthetic parser)
(parse-word parser)))
(::token/nil ::token/true ::token/false)
(parse-atomic-word parser)
::token/lparen (parse-tuple parser)
::token/lbracket (parse-list parser)
::token/startset (parse-set parser)
::token/starthash (parse-hash parser)
::token/lbrace (parse-block parser)
::token/let (parse-let parser)
::token/if (parse-if parser)
::token/match (parse-match parser)
::token/fn (parse-fn parser)
;; TODO: improve handling of comments?
;; Scanner now just skips comments
;; ::token/comment (advance parser)
::token/error (panic parser (:message token) sync-on)
(::token/rparen ::token/rbrace ::token/rbracket)
(panic parser (str "Unbalanced enclosure: " (::token/lexeme token)))
(::token/semicolon ::token/comma)
(panic parser (str "Unexpected delimiter: " (::token/lexeme token)))
(panic parser "Expected expression" sync-on)))))
(defn parse [lexed]
(-> lexed
(:tokens)
(parser)
(parse-script)))
(do
(def pp pp/pprint)
(def source "fn foo {
(foo, bar, baz) -> {:foo}
}
")
(def lexed (scanner/scan source))
(def tokens (:tokens lexed))
(def p (parser tokens))
(println "")
(println "")
(println "******************************************************")
(println "")
(println "*** *** NEW PARSE *** ***")
(-> p
(parse-fn)
(::ast)
(pp)))
(comment "
Further thoughts/still to do:
* Functions
* anonymous, simple
* named, simple
* anonymous, complex?
* named, complex
* with docstrings?
* Cond expressions
* Loops
* Structs
* Namespaces
* Types (:|)
* Modules
* Add `as` clauses to patterns
* Add `when` clauses to patterns
* var/mut
* ref/swap
* Splats in lists, hashmaps, sets
* AST nodes should include tokens/locations
- at current, only atoms do this
* Improve error handling in hashmap parsing
* Consider error handling in match expressions
* Add treatment of ignored variables
* Placeholders
* How much in parser, how much in analysis?
Some architectural changes:
* UGH, this code is just kind of a mess and hard to reason about
* Especially sequential forms
* Parsers are hard
* One idea:
* Refactor everything so that it returns a success or failure
* Because this is all stateless, in sequential forms, you can just do all the things
* This lets you do one let (with everything building up) and then a cond with bespoke errors/panics
* This also still lets you encapsulate parsererrors with poisoned nodes
")

26
src/ludus/prelude.clj Normal file
View File

@ -0,0 +1,26 @@
(ns ludus.prelude
(:require
[ludus.ast :as ast]))
(def eq {:name "eq"
::ast/type ::ast/clj
:body =})
(def add {:name "add"
::ast/type ::ast/clj
:body +})
(def panic {:name "panic"
::ast/type ::ast/clj
:body (fn [& args] (throw (ex-info "Ludus panicked!" {:args args})))})
(def print {:name "print"
::ast/type ::ast/clj
:body (fn [& args]
(println (str args))
:ok)})
(def prelude {"eq" eq
"add" add
"panic" panic
"print" print})

314
src/ludus/scanner.clj Normal file
View File

@ -0,0 +1,314 @@
(ns ludus.scanner
(:require
[ludus.token :as token]
[clojure.pprint :as pp]
[clojure.edn :as edn]
[clojure.string :as s]))
(def reserved-words
"List of Ludus reserved words."
;; see ludus-spec repo for more info
{"as" ::token/as
"cond" ::token/cond
"do" ::token/do
"else" ::token/else
"false" ::token/false
"fn" ::token/fn
"if" ::token/if
"import" ::token/import
"let" ::token/let
"match" ::token/match
"mut" ::token/mut
"nil" ::token/nil
"panic!" ::token/panic
"then" ::token/then
"true" ::token/true
"var" ::token/var
"with" ::token/with
;; below here, probable
"defer" ::token/defer
"gen" ::token/gen
"loop" ::token/loop
"ns" ::token/ns
"recur" ::token/recur
"repeat" ::token/repeat
"test" ::token/test
"wait" ::token/wait
"yield" ::token/yield
;; below here, possible
"when" ::token/when})
(defn- new-scanner
"Creates a new scanner."
[source]
{::source source
::length (count source)
::errors []
::start 0
::current 0
::line 1
::tokens []})
(defn- at-end?
"Tests if a scanner is at end of input."
[scanner]
(>= (::current scanner) (::length scanner)))
(defn- current-char
"Gets the current character of the scanner."
[scanner]
(nth (::source scanner) (::current scanner) nil))
(defn- advance
"Advances the scanner by a single character."
[scanner]
(update scanner ::current inc))
(defn- next-char
"Gets the next character from the scanner."
[scanner]
(current-char (advance scanner)))
(defn- current-lexeme
[scanner]
(subs (::source scanner) (::start scanner) (::current scanner)))
(defn- char-in-range? [start end char]
(and char
(>= (int char) (int start))
(<= (int char) (int end))))
(defn- digit? [c]
(char-in-range? \0 \9 c))
(defn- nonzero-digit? [c]
(char-in-range? \1 \9 c))
;; for now, use very basic ASCII charset in words
;; TODO: research the implications of using the whole
;; (defn- alpha? [c] (boolean (re-find #"\p{L}" (str c))))
(defn- alpha? [c]
(or (char-in-range? \a \z c) (char-in-range? \A \Z c)))
;; legal characters in words
(def word-chars #{\_ \? \! \* \/})
(defn- word-char? [c]
(or (alpha? c) (digit? c) (contains? word-chars c)))
(defn- whitespace? [c]
(or (= c \space) (= c \tab)))
(def terminators #{\: \; \newline \{ \} \( \) \[ \] \$ \# \- \< \& \, \| nil \\})
(defn- terminates? [c]
(or (whitespace? c) (contains? terminators c)))
(defn- add-token
([scanner token-type]
(add-token scanner token-type nil))
([scanner token-type literal]
(update scanner ::tokens conj
(token/token
token-type
(current-lexeme scanner)
literal
(::line scanner)
(::start scanner)))))
;; TODO: errors should also be in the vector of tokens
;; The goal is to be able to be able to hand this to an LSP?
;; Do we need a different structure
(defn- add-error [scanner msg]
(let [token (token/token
::token/error
(current-lexeme scanner)
nil
(::line scanner)
(::start scanner))
err-token (assoc token :message msg)]
(-> scanner
(update ::errors conj err-token)
(update ::tokens conj err-token))))
(defn- add-keyword
[scanner]
(loop [scanner scanner
key ""]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner ::token/keyword (keyword key))
(word-char? char) (recur (advance scanner) (str key char))
:else (add-error scanner (str "Unexpected " char "after keyword :" key))))))
;; TODO: improve number parsing?
;; Currently this uses Clojure's number formatting rules (since we use the EDN reader)
;; These rules are here: https://cljs.github.io/api/syntax/number
(defn- add-number [char scanner]
(loop [scanner scanner
num (str char)
float? false]
(let [curr (current-char scanner)]
(cond
(= curr \_) (recur (advance scanner) num float?) ;; consume underscores unharmed
(= curr \.) (if float?
(add-error scanner (str "Unexpected second decimal point after " num "."))
(recur (advance scanner) (str num curr) true))
(terminates? curr) (add-token scanner ::token/number (edn/read-string num))
(digit? curr) (recur (advance scanner) (str num curr) float?)
:else (add-error scanner (str "Unexpected " curr " after number " num "."))))))
;; TODO: add string interpolation
;; This still has to be devised
(defn- add-string
[scanner]
(loop [scanner scanner
string ""]
(let [char (current-char scanner)]
(case char
\newline (add-error scanner "Unterminated string.")
\" (add-token (advance scanner) ::token/string string)
\\ (let [next (next-char scanner)
scanner (if (= next \newline)
(update scanner ::line inc)
scanner)]
(recur (advance (advance scanner)) (str string next)))
(if (at-end? scanner)
(add-error scanner "Unterminated string.")
(recur (advance scanner) (str string char)))))))
(defn- add-word
[char scanner]
(loop [scanner scanner
word (str char)]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner (get reserved-words word ::token/word))
(word-char? curr) (recur (advance scanner) (str word curr))
:else (add-error scanner (str "Unexpected " curr " after word " word "."))))))
(defn- add-ignored
[scanner]
(loop [scanner scanner
ignored "_"]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner ::token/ignored)
(word-char? char) (recur (advance scanner) (str ignored char))
:else (add-error scanner (str "Unexpected " char " after word " ignored "."))))))
(defn- add-comment [char scanner]
(loop [scanner scanner
comm (str char)]
(let [char (current-char scanner)]
(if (= \newline char)
(update scanner ::line inc)
;;(if (s/starts-with? comm "&&&")
;;(add-token (update scanner ::line inc) ::token/docstring)
;;(add-token (update scanner ::line inc) ::token/comment))
(recur (advance scanner) (str comm char))))))
(defn- scan-token [scanner]
(let [char (current-char scanner)
scanner (advance scanner)
next (current-char scanner)]
(case char
;; one-character tokens
\( (add-token scanner ::token/lparen)
\) (add-token scanner ::token/rparen)
\{ (add-token scanner ::token/lbrace)
\} (add-token scanner ::token/rbrace)
\[ (add-token scanner ::token/lbracket)
\] (add-token scanner ::token/rbracket)
\; (add-token scanner ::token/semicolon)
\, (add-token scanner ::token/comma)
\newline (add-token (update scanner ::line inc) ::token/newline)
\\ (add-token scanner ::token/backslash)
\= (add-token scanner ::token/equals)
;; two-character tokens
;; ->
\- (cond
(= next \>) (add-token (advance scanner) ::token/rarrow)
(digit? next) (add-number char scanner)
:else (add-error scanner (str "Expected -> or negative number. Got " char next)))
;; at current we're not using this
;; <-
\< (if (= next \-)
(add-token (advance scanner) ::token/larrow)
(add-error scanner (str "Expected <-. Got " char next)))
;; |>
;; Consider => , with =>> for bind
\| (if (= next \>)
(add-token (advance scanner) ::token/pipeline)
(add-error scanner (str "Expected |>. Got " char next)))
;; possible additional operator: bind/result
;; possible additional operator: bind/some
;; oh god, monads
;; additional arrow possibilities: >> ||> ~> => !>
;; hashmap #{
\# (if (= next \{)
(add-token (advance scanner) ::token/starthash)
(add-error scanner (str "Expected beginning of hash: #{. Got " char next)))
;; set ${
\$ (if (= next \{)
(add-token (advance scanner) ::token/startset)
(add-error scanner (str "Expected beginning of set: ${. Got " char next)))
;; placeholders
;; there's a flat _, and then ignored words
\_ (cond
(terminates? next) (add-token scanner ::token/placeholder)
(alpha? next) (add-ignored scanner)
:else (add-error scanner (str "Expected placeholder: _. Got " char next)))
;; comments
;; & starts an inline comment
;; TODO: include comments in scanned file
;; TODO: add doc comments: &&&
\& (add-comment char scanner)
;; keywords
;; TODO: instead of a separate token, scan a whole type keyword
;; e.g. ::string, ::number
\: (cond
;;(= \: next) (add-token (advance scanner) ::token/doublecolon))
(alpha? next) (add-keyword scanner)
:else (add-error scanner (str "Expected keyword. Got " char next)))
;; splats
\. (let [after_next (current-char (advance scanner))]
(if (= ".." (str next after_next))
(add-token (advance (advance scanner)) ::token/splat)
(add-error scanner (str "Expected splat: ... . Got " (str "." next after_next)))))
;; strings
\" (add-string scanner)
;; word matches
(cond
(whitespace? char) scanner ;; for now just skip whitespace characters
(digit? char) (add-number char scanner)
(alpha? char) (add-word char scanner)
:else (add-error scanner (str "Unexpected character: " char))))))
(defn- next-token [scanner]
(assoc scanner ::start (::current scanner)))
(defn scan [source]
(loop [scanner (new-scanner source)]
(if (at-end? scanner)
(let [scanner (add-token scanner ::token/eof)]
{:tokens (::tokens scanner)
:errors (::errors scanner)})
(recur (-> scanner (scan-token) (next-token))))))
(do
(def source "abc nil")
(pp/pprint (scan source)))

11
src/ludus/token.clj Normal file
View File

@ -0,0 +1,11 @@
(ns ludus.token)
(defn token
([type text]
(token type text nil 1))
([type text literal line start]
{::type type
::lexeme text
::literal literal
::line line
::start start}))

1181
src/parser.janet
View File

File diff suppressed because it is too large Load Diff

42
src/prelude.janet
View File

@ -1,42 +0,0 @@
(import /src/base :as b)
(import /src/scanner :as s)
(import /src/parser :as p)
(import /src/validate :as v)
(import /src/interpreter :as i)
(import /src/errors :as e)
(def pkg (do
(def pre-ctx @{:^parent {"base" b/base}})
(def pre-src (slurp "prelude.ld"))
(def pre-scanned (s/scan pre-src :prelude))
(def pre-parsed (p/parse pre-scanned))
(def parse-errors (pre-parsed :errors))
(when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
(def pre-validated (v/valid pre-parsed pre-ctx))
(def validation-errors (pre-validated :errors))
(when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
(try
(i/interpret (pre-parsed :ast) pre-ctx)
([err] (e/runtime-error err) :error))))
(def ctx (do
(def ctx @{})
(each [k v] (pairs pkg)
(set (ctx (string k)) v))
(set (ctx "^name") nil)
(set (ctx "^type") nil)
ctx))
(def post/src (slurp "postlude.ld"))
(def post/ast (do
(def post-ctx @{:^parent ctx})
(def post-scanned (s/scan post/src :postlude))
(def post-parsed (p/parse post-scanned))
(def parse-errors (post-parsed :errors))
(when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
(def post-validated (v/valid post-parsed post-ctx))
(def validation-errors (post-validated :errors))
(when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
(post-parsed :ast)))

9
src/project.janet
View File

@ -1,9 +0,0 @@
(declare-project
:dependencies [
{:url "https://github.com/ianthehenry/judge.git"
:tag "v2.8.1"}
{:url "https://github.com/janet-lang/spork"}
])
(declare-source
:source ["ludus.janet"])

355
src/scanner.janet
View File

@ -1,355 +0,0 @@
(def reserved-words
"List of Ludus reserved words."
## see ludus-spec repo for more info
{
"as" :as ## impl
"box" :box
"do" :do ## impl
"else" :else ## impl
"false" :false ## impl -> literal word
"fn" :fn ## impl
"if" :if ## impl
"import" :import ## impl
"let" :let ## impl
"loop" :loop ## impl
"match" :match ## impl
"nil" :nil ## impl -> literal word
"ns" :ns ## impl
"panic!" :panic ## impl (should _not_ be a function)
"pkg" :pkg
"recur" :recur ## impl
"repeat" :repeat ## impl
"test" :test
"then" :then ## impl
"true" :true ## impl -> literal word
"use" :use ## wip
"when" :when ## impl, replaces cond
"with" :with ## impl
})
(def literal-words {"true" true
"false" false
"nil" nil
})
(defn- new-scanner
"Creates a new scanner."
[source input]
@{:source source
:input input
:length (length source)
:errors @[]
:start 0
:current 0
:line 1
:tokens @[]})
(defn- at-end?
"Tests if a scanner is at end of input."
[scanner]
(>= (get scanner :current) (get scanner :length)))
(defn- current-char
"Gets the current character of the scanner."
[scanner]
(let [source (get scanner :source)
current (get scanner :current)
length (length source)]
(if (>= current length)
nil
(string/from-bytes (get source current)))))
(defn- advance
"Advances the scanner by a single character."
[scanner]
(update scanner :current inc))
(defn- next-char
"Gets the next character from the scanner."
[scanner]
(let [source (get scanner :source)
current (get scanner :current)
next (inc current)
length (length source)]
(if (>= next length)
nil
(string/from-bytes (get source next)))))
(defn- current-lexeme
[scanner]
(slice (get scanner :source) (get scanner :start) (get scanner :current)))
(defn- char-code [char] (get char 0))
(defn- char-in-range? [start end char]
(and char
(>= (char-code char) (char-code start))
(<= (char-code char) (char-code end))))
(defn- digit? [c]
(char-in-range? "0" "9" c))
(defn- nonzero-digit? [c]
(char-in-range? "1" "9" c))
## for now, use very basic ASCII charset in words
## TODO: research the implications of using the whole
## (defn- alpha? [c] (boolean (re-find #"\p{L}" (string c))))
(defn- alpha? [c]
(or (char-in-range? "a" "z" c) (char-in-range? "A" "Z" c)))
(defn- lower? [c] (char-in-range? "a" "z" c))
(defn- upper? [c] (char-in-range? "A" "Z" c))
## legal characters in words
(def word-chars {"_" true "?" true "!" true "*" true "/" true})
(defn- word-char? [c]
(or (alpha? c) (digit? c) (get word-chars c)))
(defn- whitespace? [c]
(or (= c " ") (= c "\t")))
(def terminators {
":" true
";" true
"\n" true
"{" true
"}" true
"(" true
")" true
"[" true
"]" true
"$" true
"#" true
"-" true
"=" true
"&" true
"," true
">" true
"\"" true})
(defn- terminates? [c]
(or (nil? c) (whitespace? c) (get terminators c)))
(defn- add-token
[scanner token-type &opt literal]
(update scanner :tokens array/push
{:type token-type
:lexeme (current-lexeme scanner)
:literal literal
:line (get scanner :line)
:start (get scanner :start)
:source (get scanner :source)
:input (get scanner :input)}))
## TODO: errors should also be in the vector of tokens
## The goal is to be able to be able to hand this to an LSP?
## Do we need a different structure
(defn- add-error [scanner msg]
(let [token {:type :error
:lexeme (current-lexeme scanner)
:literal nil
:line (get scanner :line)
:start (get scanner :start)
:source (get scanner :source)
:input (get scanner :input)
:msg msg}]
(-> scanner
(update :errors array/push token)
(update :tokens array/push token))))
(defn- add-keyword
[scanner]
(defn recur [scanner key]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :keyword (keyword key))
(word-char? char) (recur (advance scanner) (string key char))
:else (add-error scanner (string "Unexpected " char "after keyword :" key)))))
(recur scanner ""))
(defn- add-pkg-kw [scanner]
(defn recur [scanner key]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :pkg-kw (keyword key))
(word-char? char) (recur (advance scanner) (string key char))
:else (add-error scanner (string "Unexpected " char " after pkg keyword :" key)))))
(recur scanner ""))
(defn- read-literal [lit] (-> lit parse-all first))
### TODO: consider whether Janet's number rules are right for Ludus
(defn- add-number [char scanner]
(defn recur [scanner num float?]
(let [curr (current-char scanner)]
(cond
(= curr "_") (recur (advance scanner) num float?) ## consume underscores unharmed
(= curr ".") (if float?
(add-error scanner (string "Unexpected second decimal point after " num "."))
(recur (advance scanner) (buffer/push num curr) true))
(terminates? curr) (add-token scanner :number (read-literal num))
(digit? curr) (recur (advance scanner) (buffer/push num curr) float?)
:else (add-error scanner (string "Unexpected " curr " after number " num ".")))))
(recur scanner (buffer char) false))
(def escape {
"\"" "\""
"n" "\n"
"{" "{"
"t" "\t"
"r" "\r"
"\\" "\\"
})
(defn- add-string
[scanner]
(defn recur [scanner buff interpolate?]
(let [char (current-char scanner)]
(case char
"{" (recur (advance scanner) (buffer/push buff char) true)
# allow multiline strings
"\n" (recur (update (advance scanner) :line inc) (buffer/push buff char) interpolate?)
"\"" (add-token (advance scanner) (if interpolate? :interpolated :string) (string buff))
"\\" (let [next (next-char scanner)]
(recur
(advance (advance scanner))
(buffer/push buff (get escape next next))
interpolate?))
(if (at-end? scanner)
(add-error scanner "Unterminated string.")
(recur (advance scanner) (buffer/push buff char) interpolate?)))))
(recur scanner @"" false))
(defn- add-word
[char scanner]
(defn recur [scanner word]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner
(get reserved-words (string word) :word)
(get literal-words (string word) :none))
(word-char? curr) (recur (advance scanner) (buffer/push word curr))
:else (add-error scanner (string "Unexpected " curr " after word " word ".")))))
(recur scanner (buffer char)))
(defn- add-pkg
[char scanner]
(defn recur [scanner pkg]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner :pkg-name :none)
(word-char? curr) (recur (advance scanner) (buffer/push pkg curr))
:else (add-error scanner (string "unexpected " curr " after pkg name " pkg)))))
(recur scanner (buffer char)))
(defn- add-ignored
[scanner]
(defn recur [scanner ignored]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :ignored)
(word-char? char) (recur (advance scanner) (buffer/push ignored char))
:else (add-error scanner (string "Unexpected " char " after word " ignored ".")))))
(recur scanner @"_"))
(defn- add-comment [char scanner]
(defn recur [scanner comm]
(let [char (current-char scanner)]
(if (or (= "\n" char) (at-end? scanner))
scanner # for now, we don't do anything with comments; can be added later
(recur (advance scanner) (buffer/push comm char)))))
(recur scanner (buffer char)))
(defn- scan-token [scanner]
(let [char (current-char scanner)
scanner (advance scanner)
next (current-char scanner)]
(case char
## one-character tokens
## :break is a special zero-char token before closing braces
## it makes parsing much simpler
"(" (add-token scanner :lparen)
")" (add-token (add-token scanner :break) :rparen)
"{" (add-token scanner :lbrace)
"}" (add-token (add-token scanner :break) :rbrace)
"[" (add-token scanner :lbracket)
"]" (add-token (add-token scanner :break) :rbracket)
";" (add-token scanner :semicolon)
"," (add-token scanner :comma)
"\n" (add-token (update scanner :line inc) :newline)
"\\" (add-token scanner :backslash)
"=" (add-token scanner :equals)
">" (add-token scanner :pipeline)
## two-character tokens
## ->
"-" (cond
(= next ">") (add-token (advance scanner) :arrow)
(digit? next) (add-number char scanner)
:else (add-error scanner (string "Expected > or negative number after `-`. Got `" char next "`")))
## dict #{
"#" (if (= next "{")
(add-token (advance scanner) :startdict)
(add-error scanner (string "Expected beginning of dict: #{. Got " char next)))
## set ${
"$" (if (= next "{")
(add-token (advance scanner) :startset)
(add-error scanner (string "Expected beginning of set: ${. Got " char next)))
## placeholders
## there's a flat _, and then ignored words
"_" (cond
(terminates? next) (add-token scanner :placeholder)
(alpha? next) (add-ignored scanner)
:else (add-error scanner (string "Expected placeholder: _. Got " char next)))
## comments
## & starts an inline comment
"&" (add-comment char scanner)
## keywords
# XXX: make sure we want only lower-only keywords
":" (cond
(lower? next) (add-keyword scanner)
(upper? next) (add-pkg-kw scanner)
:else (add-error scanner (string "Expected keyword or pkg keyword. Got " char next)))
## splats
"." (let [after_next (current-char (advance scanner))]
(if (= ".." (string next after_next))
(add-token (advance scanner) :splat)
(add-error scanner (string "Expected splat: ... . Got " (string "." next after_next)))))
## strings
"\"" (add-string scanner)
## word matches
(cond
(whitespace? char) scanner ## for now just skip whitespace characters
(digit? char) (add-number char scanner)
(upper? char) (add-pkg char scanner)
(lower? char) (add-word char scanner)
:else (add-error scanner (string "Unexpected character: " char))))))
(defn- next-token [scanner]
(put scanner :start (get scanner :current)))
(defn scan [source &opt input]
(default input :input)
(defn recur [scanner]
(if (at-end? scanner)
(let [scanner (add-token (add-token scanner :break) :eof)]
{:tokens (get scanner :tokens)
:errors (get scanner :errors [])})
(recur (-> scanner (scan-token) (next-token)))))
(recur (new-scanner source input)))
# (comment
(do
(def source " -123 ")
(length ((scan source) :tokens)))

793
src/validate.janet
View File

@ -1,793 +0,0 @@
### A validator for a Ludus AST
(comment
Tracking here, before I start writing this code, the kinds of validation we're hoping to accomplish:
* [x] ensure called keywords are only called w/ one arg
* [x] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
- [x] accept pkg-kws
* [x] validate dict patterns
* [x] compile string-patterns
* [x] `loop` form arity checking
* [x] arity checking of explicit named function calls
* [x] flag tail calls
* [x] no re-bound names
* [x] no unbound names
* [x] no unbound names with `use` forms
* [x] recur in tail position in `loop` forms
* [x] recur not called outside of `loop` forms
* [x] splats come at the end of list, tuple, and dict patterns
Deferred until a later iteration of Ludus:
* [ ] no circular imports DEFERRED
* [ ] correct imports DEFERRED
* [ ] validate `with` forms
)
(def- package-registry @{})
# (try (os/cd "janet") ([_] nil))
(import ./scanner :as s)
(import ./parser :as p)
(defn- new-validator [parser]
(def ast (parser :ast))
@{:ast ast
:errors @[]
:ctx @{}
:status @{}}
)
(var validate nil)
(def terminals [:number :string :bool :nil :placeholder])
(def simple-colls [:list :tuple :set :args])
(defn- simple-coll [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- iff [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- script [validator]
(def ast (validator :ast))
(def data (ast :data))
(def status (validator :status))
(set (status :toplevel) true)
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- block [validator]
(def ast (validator :ast))
(def data (ast :data))
(when (= 0 (length data))
(array/push (validator :errors)
{:node ast :msg "blocks may not be empty"})
(break validator))
(def status (validator :status))
(set (status :toplevel) nil)
(def tail? (status :tail))
(set (status :tail) false)
(def parent (validator :ctx))
(def ctx @{:^parent parent})
(set (validator :ctx) ctx)
(for i 0 (-> data length dec)
(set (validator :ast) (data i))
(validate validator))
(set (status :tail) tail?)
(set (validator :ast) (last data))
(validate validator)
(set (validator :ctx) parent)
validator)
(defn- resolve-local [ctx name]
(get ctx name))
(defn- resolve-name [ctx name]
(when (nil? ctx) (break nil))
(def node (get ctx name))
(if node node (resolve-name (get ctx :^parent) name)))
(defn- resolve-name-in-script [ctx name]
(when (ctx :^toplevel) (break nil))
(def node (ctx name))
(if node node (resolve-name-in-script (ctx :^parent) name)))
(defn- word [validator]
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
(def resolved (resolve-name ctx name))
(when (not resolved)
(array/push (validator :errors)
{:node ast :msg "unbound name"}))
validator)
### patterns
(var pattern nil)
(defn- lett [validator]
(def ast (validator :ast))
(def [lhs rhs] (ast :data))
# evaluate the expression first
# otherwise lhs names will appear bound
(set (validator :ast) rhs)
(validate validator)
(set (validator :ast) lhs)
(pattern validator)
validator)
(defn- splattern [validator]
(def ast (validator :ast))
(def status (validator :status))
(when (not (status :last))
(array/push (validator :errors)
{:node ast :msg "splats may only come last in collection patterns"}))
(def data (ast :data))
(when data
(set (validator :ast) data)
(pattern validator))
validator)
(defn- simple-coll-pattern [validator]
(def ast (validator :ast))
(def data (ast :data))
(when (empty? data) (break validator))
(def status (validator :status))
(for i 0 (-> data length dec)
(set (validator :ast) (get data i))
(pattern validator))
(set (status :last) true)
(set (validator :ast) (last data))
(pattern validator)
(set (status :last) nil)
validator)
(defn- word-pattern [validator]
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
### XXX TODO: this resolution should ONLY be for userspace, NOT prelude
(def resolved (resolve-name-in-script ctx name))
(when resolved
(def {:line line :input input} resolved)
(array/push (validator :errors)
{:node ast :msg (string "name " name " is already bound on line "
line " of " input)}))
(set (ctx name) ast)
# (pp ctx)
validator)
(def types [
:nil
:bool
:number
:keyword
:string
:set
:tuple
:dict
:list
:fn
:box
:pkg
])
(defn typed [validator]
(def ast (validator :ast))
(def [kw-type word] (ast :data))
(def type (kw-type :data))
(when (not (has-value? types type))
(array/push (validator :errors)
{:node kw-type :msg "unknown type"}))
(set (validator :ast) word)
(pattern validator))
(defn- str-pattern [validator]
(def ast (validator :ast))
(def data (ast :data))
(def last-term (-> data array/pop string))
(def grammar @{})
(def bindings @[])
(var current 0)
(each node data
(when (not (buffer? node))
(set (validator :ast) node)
(pattern validator))
(if (buffer? node)
(set (grammar (keyword current)) (string node))
(do
(set (grammar (keyword current))
~(<- (to ,(keyword (inc current)))))
(array/push bindings (node :data))))
(set current (inc current)))
(set (grammar (keyword current)) ~(* ,last-term -1))
(def rules (map keyword (range (length grammar))))
(set (grammar :main) ~(* ,;rules))
(set (ast :grammar) grammar)
(set (ast :compiled) (peg/compile grammar))
(set (ast :bindings) bindings))
(defn- pair [validator]
(def ast (validator :ast))
(def [_ patt] (ast :data))
(set (validator :ast) patt)
(pattern validator))
(defn- pattern* [validator]
# (print "PATTERN*")
(def ast (validator :ast))
(def type (ast :type))
# (print "validating pattern " type)
(cond
(has-value? terminals type) validator
(case type
:word (word-pattern validator)
:placeholder validator
:ignored validator
:word (word-pattern validator)
:list (simple-coll-pattern validator)
:tuple (simple-coll-pattern validator)
:dict (simple-coll-pattern validator)
:splat (splattern validator)
:typed (typed validator)
:interpolated (str-pattern validator)
:pair (pair validator)
)))
(set pattern pattern*)
# XXX: ensure guard includes only allowable names
# XXX: what to include here? (cf Elixir)
(defn- guard [validator])
(defn- match-clauses [validator clauses]
# (print "validating clauses in match-clauses")
(each clause clauses
(def parent (validator :ctx))
(def ctx @{:^parent parent})
(set (validator :ctx) ctx)
(def [lhs guard rhs] clause)
(set (validator :ast) lhs)
(pattern validator)
# (pp (validator :ctx))
# (pp (validator :ctx))
(when guard
(set (validator :ast) guard)
(validate validator))
(set (validator :ast) rhs)
(validate validator)
(set (validator :ctx) parent)))
(defn- matchh [validator]
# (print "validating in matchh")
(def ast (validator :ast))
(def [to-match clauses] (ast :data))
# (print "validating expression:")
# (pp to-match)
(set (validator :ast) to-match)
(validate validator)
# (print "validating clauses")
(match-clauses validator clauses)
validator)
(defn- declare [validator fnn]
(def status (validator :status))
(def declared (get status :declared @{}))
(set (declared fnn) true)
(set (status :declared) declared)
# (print "declared function " (fnn :name))
# (pp declared)
validator)
(defn- define [validator fnn]
(def status (validator :status))
(def declared (get status :declared @{}))
(set (declared fnn) nil)
(set (status :declared) declared)
# (print "defined function " (fnn :name))
# (pp declared)
validator)
(defn- fnn [validator]
(def ast (validator :ast))
(def name (ast :name))
# (print "function name: " name)
(def status (validator :status))
(def tail? (status :tail))
(set (status :tail) true)
(when name
(def ctx (validator :ctx))
(def resolved (ctx name))
(when (and resolved (not= :nothing (resolved :data)))
(def {:line line :input input} (get-in ctx [name :token]))
(array/push (validator :errors)
{:node ast :msg (string "name is already bound on line " line " of " input)}))
(when (and resolved (= :nothing (resolved :data)))
(define validator resolved))
(set (ctx name) ast))
(def data (ast :data))
(when (= data :nothing)
(break (declare validator ast)))
(match-clauses validator data)
(set (status :tail) tail?)
(def rest-arities @{})
(def arities @{:rest rest-arities})
(each clause data
# (print "CLAUSE:")
# (pp clause)
(def patt (first clause))
(def params (patt :data))
(def arity (length params))
# (print "checking clause with arity " arity)
(def rest-param? (and (> arity 0) (= :splat ((last params) :type))))
(if rest-param?
(set (rest-arities arity) true)
(set (arities arity) true)))
# (pp arities)
(set (ast :arities) arities)
validator)
(defn- box [validator]
(def ast (validator :ast))
(def ctx (validator :ctx))
(def expr (ast :data))
(set (validator :ast) expr)
(validate validator)
(def name (ast :name))
(def resolved (ctx name))
(when resolved
(def {:line line :input input} (get-in ctx [name :token]))
(array/push (validator :errors)
{:node ast :msg (string "name is already bound on line " line " of " input)}))
(set (ctx name) ast)
validator)
(defn- interpolated [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(when (not (buffer? node))
(set (validator :ast) node)
(validate validator))))
### TODO:
# * [ ] ensure properties are on pkgs (if *only* pkgs from root)
(defn- pkg-root [validator]
# (print "validating pkg-root access")
(def ast (validator :ast))
(def ctx (validator :ctx))
(def terms (ast :data))
(def pkg-name ((first terms) :data))
(def the-pkg (resolve-name ctx pkg-name))
(when (not the-pkg)
(array/push (validator :errors)
{:node ast :msg "unbound pkg name"})
(break validator))
(def member (get terms 1))
(def accessed (case (member :type)
:keyword (get-in the-pkg [:pkg (member :data)])
:pkg-kw (get-in the-pkg [:pkg (member :data)])
:args (do
(array/push (validator :errors)
{:node member :msg "cannot call a pkg"}
(break validator)))))
(when (not accessed)
# (print "no member " (member :data) " on " pkg-name)
(array/push (validator :errors)
{:node member :msg "invalid pkg access"})
(break validator))
# TODO: validate nested pkg access
)
# (defn- tail-call [validator]
# (def ast (validator :ast))
# (when (ast :partial) (break validator))
# (def status (validator :status))
# (when (not (status :tail)) (break validator))
# (def data (ast :data))
# (def args (last data))
# (set (args :tail-call) true))
(defn- check-arity [validator]
# (print "CHECKING ARITY")
(def ast (validator :ast))
# (when (ast :partial) (break validator))
(def ctx (validator :ctx))
(def data (ast :data))
(def fn-word (first data))
# (pp fn-word)
(def the-fn (resolve-name ctx (fn-word :data)))
# (print "the called function: " the-fn)
# (pp the-fn)
(when (not the-fn) (break validator))
# (print "the function is not nil")
# (print "the function type is " (type the-fn))
(when (= :function (type the-fn)) (break validator))
(when (= :cfunction (type the-fn)) (break validator))
# (print "the function is not a janet fn")
# (print "fn type: " (the-fn :type))
(when (not= :fn (the-fn :type)) (break validator))
# (print "fn name: " (the-fn :name))
(def arities (the-fn :arities))
# when there aren't arities yet, break, since that means we're making a recursive function call
# TODO: enahnce this so that we can determine arities *before* all function bodies; this ensures arity-checking for self-recursive calls
(when (not arities) (break validator))
# (print "arities: ")
# (pp arities)
(def args (get data 1))
(def num-args (length (args :data)))
# (print "called with #args " num-args)
# (pp (get (validator :ctx) "bar"))
(when (has-key? arities num-args) (break validator))
# (print "arities: ")
# (pp arities)
(when (not arities) (break validator))
(def rest-arities (keys (arities :rest)))
(when (empty? rest-arities)
(array/push (validator :errors)
{:node ast :msg "wrong number of arguments"})
(break validator))
(def rest-min (min ;rest-arities))
(when (< num-args rest-min)
(array/push (validator :errors)
{:node ast :msg "wrong number of arguments"}))
validator)
(defn- kw-root [validator]
(def ast (validator :ast))
(def data (ast :data))
(def [_ args] data)
(when (not= :args (args :type))
(break (array/push (validator :errors)
{:node args :msg "called keyword expects an argument"})))
(when (not= 1 (length (args :data)))
(array/push (validator :errors)
{:node args :msg "called keywords take one argument"})))
(defn- synthetic [validator]
(def ast (validator :ast))
(def data (ast :data))
(def status (validator :status))
(def ftype ((first data) :type))
(def stype ((get data 1) :type))
(def ltype ((last data) :type))
(set (status :pkg-access?) nil)
(when (= ftype :pkg-name)
(set (status :pkg-access?) true))
(each node data
(set (validator :ast) node)
(validate validator))
(set (validator :ast) ast)
# (print "ftype " ftype)
# (print "stype " stype)
# (print "ltype " ltype)
(when (= ftype :pkg-name) (pkg-root validator))
(when (= ftype :keyword) (kw-root validator))
# (when (= ltype :args) (tail-call validator))
(when (and (= ftype :word) (= stype :args))
(check-arity validator))
validator)
(defn- pair [validator]
(def ast (validator :ast))
(def [k v] (ast :data))
(set (validator :ast) k)
(validate validator)
(set (validator :ast) v)
(validate validator))
(defn- splat [validator]
(def ast (validator :ast))
(when (get-in validator [:status :pkg])
(array/push (validator :errors)
{:node ast :msg "splats are not allowed in pkgs"})
(break validator))
(def data (ast :data))
(when data
(set (validator :ast) data)
(validate validator))
validator)
(defn- dict [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- whenn [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(def [lhs rhs] node)
(set (validator :ast) lhs)
(validate validator)
(set (validator :ast) rhs)
(validate validator))
validator)
# XXX: do this!
(defn- withh [validator])
# XXX: tail calls in last position
(defn- doo [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- usee [validator]
(def ast (validator :ast))
(def data (ast :data))
(set (validator :ast) data)
(validate validator)
(def name (data :data))
(def ctx (validator :ctx))
(def pkg (get-in ctx [name :pkg] @{}))
(loop [[k v] :pairs pkg]
(set (ctx (string k)) v))
validator)
(defn- pkg-entry [validator pkg]
(def ast (validator :ast))
(def status (validator :status))
(when (= :pkg-pair (ast :type))
(set (status :pkg-access?) true))
(def data (ast :data))
(def [key value] (ast :data))
# (print "PKG ENTRY***")
# (pp key)
# (pp value)
(set (validator :ast) key)
(validate validator)
(set (validator :ast) value)
(validate validator)
(def entry (if (= :pkg-name (value :type))
(resolve-name (validator :ctx) (string (value :data)))
value))
# (print "entry at " (key :data))
# (pp entry)
(set (status :pkg-access?) nil)
(def kw (key :data))
# (pp kw)
(set (pkg kw) entry)
# (pp pkg)
validator)
(defn- pkg [validator]
(def ast (validator :ast))
(def data (ast :data))
(def name (ast :name))
(def pkg @{})
(each node data
(set (validator :ast) node)
(pkg-entry validator pkg))
(set (ast :pkg) pkg)
# (print "THE PACKAGE")
# (pp pkg)
(def ctx (validator :ctx))
(set (ctx name) ast)
validator)
(defn- ns [validator]
(def ast (validator :ast))
(def data (ast :data))
(def name (ast :name))
(def parent (validator :ctx))
(def ctx @{:^parent parent})
(def block (data :data))
(each node block
(set (validator :ast) node)
(validate validator))
(set (ast :pkg) ctx)
(set (parent name) ast)
validator)
(defn- loopp [validator]
(def ast (validator :ast))
(def status (validator :status))
(def data (ast :data))
(def input (first data))
# (print "LOOP INPUT")
# (pp input)
(def clauses (get data 1))
(def input-arity (length (input :data)))
(set (ast :arity) input-arity)
# (print "input arity to loop " input-arity)
(set (validator :ast) input)
(validate validator)
# harmonize arities
(def rest-arities @{})
(each clause clauses
# (print "CLAUSE:")
# (pp clause)
(def patt (first clause))
(def params (patt :data))
(def clause-arity (length params))
# (print "checking clause with arity " clause-arity)
(def rest-param? (= :splat (get (last params) :type)))
(when (and
(not rest-param?) (not= clause-arity input-arity))
(array/push (validator :errors)
{:node patt :msg "arity mismatch"}))
(when rest-param?
(set (rest-arities clause-arity) patt)))
# (pp rest-arities)
(loop [[arity patt] :pairs rest-arities]
(when (< input-arity arity)
(array/push (validator :errors)
{:node patt :msg "arity mismatch"})))
(def loop? (status :loop))
(set (status :loop) input-arity)
(def tail? (status :tail))
(set (status :tail) true)
(match-clauses validator clauses)
(set (status :loop) loop?)
(set (status :tail) tail?)
validator)
(defn- recur [validator]
(def ast (validator :ast))
(def status (validator :status))
(def loop-arity (status :loop))
(when (not loop-arity)
(array/push (validator :errors)
{:node ast :msg "recur may only be used inside a loop"})
(break validator))
(def called-with (get-in ast [:data :data]))
(def recur-arity (length called-with))
# (print "loop arity " loop-arity)
# (print "recur arity" recur-arity)
(when (not= recur-arity loop-arity)
(array/push (validator :errors)
{:node ast :msg "recur must have the same number of args as its loop"}))
(when (not (status :tail))
(array/push (validator :errors)
{:node ast :msg "recur must be in tail position"}))
(set (validator :ast) (ast :data))
(validate validator))
(defn- repeatt [validator]
(def ast (validator :ast))
(def [times body] (ast :data))
(set (validator :ast) times)
(validate validator)
(set (validator :ast) body)
(validate validator))
(defn- panic [validator]
(def ast (validator :ast))
(def data (ast :data))
(set (validator :ast) data)
(validate validator))
(defn- testt [validator]
(def ast (validator :ast))
(def [_ body] (ast :data))
(set (validator :ast) body)
(validate validator))
(defn- pkg-name [validator]
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
(def pkg (resolve-name ctx name))
(when (not pkg)
(array/push (validator :errors)
{:node ast :msg "unbound name"}))
validator)
(defn- pkg-kw [validator]
# (print "validating pkg-kw")
(def ast (validator :ast))
(def pkg-access? (get-in validator [:status :pkg-access?]))
# (print "pkg-access? " pkg-access?)
(when (not pkg-access?)
(array/push (validator :errors)
{:node ast :msg "cannot use pkg-kw here"}))
validator)
(defn- pkg-pair [validator]
# (print "validating pkg-pair")
(def ast (validator :ast))
(def status (validator :status))
(def [_ pkg] (ast :data))
(set (status :pkg-access?) true)
(set (validator :ast) pkg)
(validate validator)
(set (status :pkg-access?) nil)
validator)
(defn- kw [validator]
(def status (validator :status))
(set (status :pkg-access?) nil)
validator)
(defn- validate* [validator]
(def ast (validator :ast))
(def type (ast :type))
# (print "validating node " type)
(cond
(has-value? terminals type) validator
(has-value? simple-colls type) (simple-coll validator)
(case type
:keyword (kw validator)
:if (iff validator)
:let (lett validator)
:script (script validator)
:block (block validator)
:word (word validator)
:fn (fnn validator)
:match (matchh validator)
:interpolated (interpolated validator)
:synthetic (synthetic validator)
:do (doo validator)
:dict (dict validator)
:test (testt validator)
:panic (panic validator)
:repeat (repeatt validator)
:when (whenn validator)
:splat (splat validator)
:pair (pair validator)
:pkg-pair (pkg-pair validator)
:ns (ns validator)
:pkg (pkg validator)
:pkg-name (pkg-name validator)
:pkg-kw (pkg-kw validator)
:use (usee validator)
:loop (loopp validator)
:recur (recur validator)
:box (box validator)
(error (string "unknown node type " type)))))
(set validate validate*)
(defn- cleanup [validator]
(def declared (get-in validator [:status :declared] {}))
(when (any? declared)
(each declaration (keys declared)
(array/push (validator :errors) {:node declaration :msg "declared fn, but not defined"})))
validator)
(defn valid [ast &opt ctx]
(default ctx @{})
(set (ctx :^toplevel) true)
(def validator (new-validator ast))
(def base-ctx @{:^parent ctx})
(set (validator :ctx) base-ctx)
(validate validator)
(cleanup validator))
(import ./base :as b)
# (do
(comment
(def source `
dec (12)
`)
(def scanned (s/scan source))
(def parsed (p/parse scanned))
(def validated (valid parsed b/ctx))
# (get-in validated [:status :declared])
# (validated :ctx)
)

7
test/cludus/core_test.clj Normal file
View File

@ -0,0 +1,7 @@
(ns cludus.core-test
(:require [clojure.test :refer :all]
[cludus.core :refer :all]))
(deftest a-test
(testing "FIXME, I fail."
(is (= 0 1))))

9
test/judgy.fish
View File

@ -1,9 +0,0 @@
#!/opt/homebrew/bin/fish
set FILE $argv[1]
set TESTFILE (string join "" $FILE ".tested")
judge $FILE
if test -e $TESTFILE
cp $TESTFILE $FILE
rm $TESTFILE
end

371
test/language.test.janet
View File

@ -1,371 +0,0 @@
# testing Ludus langauge constructs
(try (os/cd "janet") ([_] nil)) # for REPL
(import /scanner :as s)
(import /parser :as p)
(import /validate :as v)
(import /interpreter :as i)
(import /errors :as e)
(import /base :as b)
(use judge)
(defn run [source]
(def ctx @{})
(def scanned (s/scan source :test))
(when (any? (scanned :errors))
(e/scan-error (scanned :errors)) (error "scanning errors"))
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(e/parse-error (parsed :errors)) (error "parsing errors"))
(def valid (v/valid parsed ctx))
(when (any? (valid :errors)) (each err (valid :errors)
(e/validation-error err)) (error "validation errors"))
(i/interpret (parsed :ast) ctx))
(deftest "returns bare values from single-line scripts"
(test (run "true") true)
(test (run "false") false)
(test (run "nil") :^nil)
(test (run "12.34") 12.34)
(test (run "-32") -32)
(test (run "0") 0)
(test (run ":foo") :foo)
(test (run ":bar") :bar)
(test (run `"a string, a text, a language"`) "a string, a text, a language"))
(deftest "returns empty collections from single-line scripts"
(test (run "()") [])
(test (run "#{}") @{})
(test (run "${}") @{:^type :set})
(test (run "[]") @[]))
(deftest "returns populated collections from single-line scripts"
(test (run "(1, 2, 3)") [1 2 3])
(test (run "[:a, :b, :c]") @[:a :b :c])
(test (run "${1, 2, 3, 3}") @{1 true 2 true 3 true :^type :set})
(test (run "#{:a 1, :b 2}") @{:a 1 :b 2}))
(deftest "returns nested collections from single-line scripts"
(test (run "((), (1, 2), [:a, (:b)], #{:foo true, :bar false})")
[[]
[1 2]
@[:a [:b]]
@{:bar false :foo true}])
(test (run `#{:foo #{:bar "thing", :baz (1, :foo, nil)}}`) @{:foo @{:bar "thing" :baz [1 :foo :^nil]}}))
(deftest "binds names in let bindings with various patterns"
(test (run `let foo = :bar; foo`) :bar)
(test (run `let 42 = 42`) 42)
(test (run `let foo = :bar; let quux = 42; (foo, quux)`) [:bar 42])
(test (run `let (:ok, value) = (:ok, 42); value`) 42)
(test (run `let #{:a x, ...} = #{:a 1, :b 2}; x`) 1))
(deftest "executes if/then/else properly"
(test (run `if nil then :foo else :bar`) :bar)
(test (run `if false then :foo else :bar`) :bar)
(test (run `if true then :foo else :bar`) :foo)
(test (run `if 42 then :foo else panic! "oops"`) :foo))
(deftest "panics"
(test-error (run `panic! "oops"`)
{:msg "oops"
:node {:data {:data "oops"
:token {:input :test
:lexeme "\"oops\""
:line 1
:literal "oops"
:source "panic! \"oops\""
:start 7
:type :string}
:type :string}
:token {:input :test
:lexeme "panic!"
:line 1
:literal :none
:source "panic! \"oops\""
:start 0
:type :panic}
:type :panic}})
)
(deftest "no match in let panics"
(test-error (run "let :foo = :bar")
{:msg "no match: let binding"
:node {:data @[{:data :foo
:token {:input :test
:lexeme ":foo"
:line 1
:literal :foo
:source "let :foo = :bar"
:start 4
:type :keyword}
:type :keyword}
{:data :bar
:token {:input :test
:lexeme ":bar"
:line 1
:literal :bar
:source "let :foo = :bar"
:start 11
:type :keyword}
:type :keyword}]
:token {:input :test
:lexeme "let"
:line 1
:literal :none
:source "let :foo = :bar"
:start 0
:type :let}
:type :let}
:value :bar})
)
(deftest "blocks execute code and work"
(test (run `
let bar = 12
let foo = {
let bar = 42
let baz = :quux
:foo
}
(foo, bar)
`)
[:foo 12])
(test (run `
let foo = {
let bar = 12
{
let bar = 15
bar
}
}
`)
15))
(deftest "unbound name panics"
(test-error (run `foo`) "validation errors"))
(deftest "rebinding name panics"
(test-error (run `let foo = 42; let foo = 23`) "validation errors"))
(deftest "when forms work as expected"
(test (run `
when {
false -> :nope
nil -> :nope
12 -> :yes
}
`)
:yes)
(test-error (run `
when {
false -> :nope
nil -> :nope
}
`)
{:msg "no match: when form"
:node {:data @[[{:data false
:token {:input :test
:lexeme "false"
:line 2
:literal false
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 12
:type :false}
:type :bool}
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 2
:literal :nope
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 21
:type :keyword}
:type :keyword}]
[{:token {:input :test
:lexeme "nil"
:line 3
:literal :none
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 30
:type :nil}
:type :nil}
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 3
:literal :nope
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 37
:type :keyword}
:type :keyword}]]
:token {:input :test
:lexeme "when"
:line 1
:literal :none
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
:start 2
:type :when}
:type :when}})
)
(deftest "match forms work as expected"
(test (run `
match :foo with {
:bar -> :nope
:baz -> :nope
x -> x
}
`)
:foo)
(test (run `
let foo = 42
match (:ok, foo) with {
(:err, _) -> :nope
(:ok, :foo) -> :nope
(:ok, _) -> :yes
}
`)
:yes)
(test-error (run `
let foo = "foo"
match foo with {
"bar" -> :nope
"baz" -> :nope
12.34 -> :nope
}
`)
{:msg "no match: match form"
:node @{:data [{:data "foo"
:token {:input :test
:lexeme "foo"
:line 2
:literal :none
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 26
:type :word}
:type :word}
@[[{:data "bar"
:token {:input :test
:lexeme "\"bar\""
:line 3
:literal "bar"
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 40
:type :string}
:type :string}
nil
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 3
:literal :nope
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 49
:type :keyword}
:type :keyword}]
[{:data "baz"
:token {:input :test
:lexeme "\"baz\""
:line 4
:literal "baz"
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 58
:type :string}
:type :string}
nil
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 4
:literal :nope
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 67
:type :keyword}
:type :keyword}]
[{:data 12.34
:token {:input :test
:lexeme "12.34"
:line 5
:literal 12.34
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 76
:type :number}
:type :number}
nil
{:data :nope
:token {:input :test
:lexeme ":nope"
:line 5
:literal :nope
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 85
:type :keyword}
:type :keyword}]]]
:match @match-fn
:token {:input :test
:lexeme "match"
:line 2
:literal :none
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
:start 20
:type :match}
:type :match}
:value "foo"})
)
(deftest "string patterns work as expected"
(test (run `let "I {verb} the {noun}" = "I am the walrus"; (verb, noun)`) ["am" "walrus"])
(test (run `let "a {b} c {d}" = "a because I love you c yourself out the door"; (b, d)`)
["because I love you"
"yourself out the door"])
)
(deftest "lambdas may be defined and called"
(test (run `
let foo = fn () -> :foo
foo ()
`)
:foo)
(test (run `
let pair = fn (x, y) -> (x, y)
pair (:foo, :bar)
`)
[:foo :bar])
(test-error (run `
let foo = fn () -> :foo
foo (:bar)
`)
{:called @{:^type :fn
:body [[{:data @[]
:token {:input :test
:lexeme "("
:line 1
:source " let foo = fn () -> :foo\n foo (:bar)\n "
:start 15
:type :lparen}
:type :tuple}
nil
{:data :foo
:token {:input :test
:lexeme ":foo"
:line 1
:literal :foo
:source " let foo = fn () -> :foo\n foo (:bar)\n "
:start 21
:type :keyword}
:type :keyword}]]
:ctx @{}
:match @match-fn}
:msg "no match: function call"
:node {:data "foo"
:token {:input :test
:lexeme "foo"
:line 2
:literal :none
:source " let foo = fn () -> :foo\n foo (:bar)\n "
:start 28
:type :word}
:type :word}
:value [:bar]})
)

34
test/prelude.test.janet
View File

@ -1,34 +0,0 @@
# testing the prelude
(try (os/cd "janet") ([_] nil))
(import /scanner :as s)
(import /parser :as p)
(import /validate :as v)
(import /interpreter :as i)
(import /errors :as e)
(import /base :as b)
(import /load-prelude :as pre)
(use judge)
(defn run [source]
(when (= :error pre/pkg) (error "could not load prelude"))
(def ctx @{:^parent pre/ctx})
(def scanned (s/scan source :test))
(when (any? (scanned :errors))
(e/scan-error (scanned :errors)) (error "scanning errors"))
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(e/parse-error (parsed :errors)) (error "parsing errors"))
(def valid (v/valid parsed ctx))
(when (any? (valid :errors)) (each err (valid :errors)
(e/validation-error err)) (error "validation errors"))
(i/interpret (parsed :ast) ctx))
(deftest "debug add_msg"
(test (run `
let msgs = [1, :foo, nil]
let msg = do msgs > map (string, _)
msg
`)
@["1" ":foo" ":^nil"])
# (test (run `print! ("foo", "bar")`) :ok)
)

5
test/watchy.fish
View File

@ -1,5 +0,0 @@
#!/opt/homebrew/bin/fish
set FILE $argv[1]
fd $FILE | entr ./judgy.fish /_

92
turtle-graphics.md
View File

@ -1,92 +0,0 @@
# Turtle Graphics protocol
name: "turtle-graphics"
version: 0.1.0
### Description
Turtle graphics describe the movements and drawing behaviours of screen, robot, and print "turtles."
* `proto`: `["turtle-graphics", "{version number}"]`
* `data`: an array of arrays; each array represents a turtle command; the first element of a command array is the verb; any subsequent items are the arguments to the verbs.
* Valid arguments are numbers, strings, and booleans.
* Depending on what we end up doing, we may add arrays of these, representing tuples or lists, and/or objects with string keys whose text are well-formed keywords in Ludus. For now, however, arguments must be atomic values.
* E.g., `["forward", 100]`
* Each turtle has its own stream.
* At current, this protocol describes the behaviour of turtle-like objects, all of which "live" in the same "world"; there is not yet a provision for multiple canvases/worlds. That said, an additional field for "world" in at the top level may well be added in the future to allow for multiple worlds to unfold at the same time.
### Verbs and arguments
* `forward`, steps: number
- Moves the turtle forward by the number of steps/pixels.
* `back`, steps: number
- Moves the turtle backwards by the number of steps/pixels.
* `right`, turns: number
- Turns the turtle right by the number of turns. (1 turn = 360 degrees.)
* `left`, turns: number
- Turns the turtle to the left by the number of turns. (1 turn = 360 degrees.)
* `penup`, no arguments
- "Lifts" the turtle's pen, keeping it from drawing.
* `pendown`, no arguments
- "Lowers" the turtle's pen, starting it drawing a path.
* `pencolor`, red: number, green: number, blue: number, alpha: number, OR: color: string
- Sets the turtle's pen's color to the specified RGBA color.
* `penwidth`, width: number
- Sets the width of the turtle's pen, in pixels (or some other metric).
* `home`, no arguments
- Sends the turtle back to its starting point, with a heading of 0.
* `goto`, x: number, y: number
- Sends the turtle to the specified Cartesian coordinates, where the origin is the turtle's starting position.
* `setheading`, heading: number
- Sets the turtle's heading. 0 is the turtle's starting heading, with increasing numbers turning to the right.
* `show`, no arguments
- Shows the turtle.
* `hide`, no arguments
- Hides the turtle.
* `loadstate`, x: number, y: number, heading: number, visible: boolean, pendown: boolean, width: number, color: string OR r: number, g: number, b: number, a: number
- Loads a turtle state.
* `clear`, no arguments
- Erases any paths drawn and sets the background color to the default.
* `background`, red: number, green: number, blue: number, alpha: number
- Sets the background color to the specified RGBA color, OR: color: string
These last two feel a little weird to me, since the background color is more the property of the **world** the turtle is in, not the turtle itself. Worlds with multiple turtles will be set up so that _any_ turtle will be able to change the background, and erase all paths.
That said, since we don't yet have a world abstraction/entity, then there's no other place to put them. This will likely be shifted around in later versions of the protocol.
### Other considerations
**Not all turtles will know how to do all these things.**
The idea is that this single abstraction will talk to all the turtle-like things we eventually use.
That means that some turtles won't be able to do all the things; that's fine!
They just won't do things they can't do; but warnings should go to `stderr`.
**Errors are not passed back to Ludus.**
These are fire-off commands.
Errors should be _reported_ to `stderr` or equivalent.
But Ludus sending things to its output streams should only cause Ludus panics when there's an issue in Ludus.
**Colors aren't always RGBA.**
For pen-and-paper turtles, we don't have RGBA colors.
Colors should also be specifiable with strings corresponding to CSS basic colors: black, silver, gray, white, maroon, red, purple, fuchsia, green, lime, olive, yellow, navy, blue, teal, and aqua.
**Turtles should communicate states.**
Ludus should have access to turtle states.
This is important for push/pop situations that we use for L-systems.
There are two ways to do this: Ludus does its own bookkeeping for turtle states, or it has a way to get the state from a turtle.
The latter has the value of being instantaneous, and gives us an _expected_ state of the turtle after the commands are all processed.
In particular, this will be necessary for the recursive L-systems that require pushing and popping turtle state.
The latter has the drawback of potentially allowing the turtle state and expected turtle state to fall out of synch.
The former has the value of always giving us the correct, actual state of the turtle.
It has the drawback of requiring such state reporting to be asynchronous, and perhaps wildly asynchronous, as things like moving robots and plotters will take quite some time to actually draw what Ludus tells it to.
(Being able to wait until `eq? (expected, actual)` to do anything else may well be extremely useful.)
That suggests, then, that both forms of turtle state are desirable and necessary.
Thus: turtles should communicate states (and thus there ought to be a protocol for communicating state back to Ludus) and Ludus should always do the bookkeeping of calculating the expected state.
**Turtles use Cartesian, rather than screen, coordinates.**
The starting position of the turtle is `(0, 0)`, which is the origin, and _centred_ in the field of view.
Increasing the x-coordinate moves the turtle to the right; increasing the y-coordinate moves the turtle _up_.
**Turtles use compass headings, not mathematical angles.**
Turtles start pointing vertially, at heading `0`.
Turning right _increases_ the heading; pointing due "east" is `0.25`; south `0.5`, and west, `0.75`.